nboxlist.F File Reference

Go to the source code of this file.

Functions/Subroutines
integer function	nboxlst (list, nlist, iboxtmp, nbbox, ix1, ix2, index, kk, id, titr)

Function/Subroutine Documentation

nboxlst()

integer function nboxlst	(	integer, dimension(nlist)	list,
		integer	nlist,
		integer, dimension(nbbox)	iboxtmp,
		integer	nbbox,
		integer, dimension(nbbox)	ix1,
		integer, dimension(nbbox)	ix2,
		integer, dimension(nbbox*3)	index,
		integer	kk,
		integer	id,
		character(len=nchartitle), intent(in)	titr )

Definition at line 32 of file nboxlist.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
C      FONCTION DONNE N0 SYSTEME D'UNE LISTE DE BOXES USER
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NLIST,KK,NBBOX,ID
      INTEGER LIST(NLIST),INDEX(NBBOX*3),IBOXTMP(NBBOX),IX1(NBBOX),IX2(NBBOX)
      CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NBOX,NOLD,K,K0,K1,KALL,ID0,
     .        IWORK(70000),ISIGN(NLIST),ISIGN1(NLIST),
     .        SIGNOLD,FAC(NLIST+1),INDXOLD,FAC1(NLIST+1),
     .        FACX,LIST1(NLIST),IDEL(NLIST),IDBL(NLIST)
      CHARACTER BOX*3
C-----------------------
C TRI DE LIST EN ORDRE CROISSANT
C-----------------------
        DO i=1,nlist
          isign(i) = sign(1,list(i))
          list(i) = abs(list(i))
        ENDDO
C---
        CALL my_orders(0,iwork,list,index,nlist,1)
        DO i=1,nlist
          index(nlist+i) = list(index(i))
          isign1(i)= isign(index(i))
        ENDDO
C---
        DO i=1,nlist
          list(i)  = index(nlist+i)
          isign(i) = isign1(i)
        ENDDO
C---
        nbox = nlist
C-----------------------
C TRI DE IBOX() EN ORDRE CROISSANT si KK = 0
C-----------------------
        IF (kk == 0) THEN
          DO i=1,nbbox
            ix2(i) = iboxtmp(i)
          ENDDO
          CALL my_orders(0,iwork,ix2,index,nbbox,1)
          DO i=1,nbbox
            ix1(i) = ix2(index(i))
          ENDDO
          DO i=1,nbbox
            ix2(i) = index(i)
          ENDDO
        ENDIF
C-----------------------
C RECHERCHE DES ELEMENTS DE LIST() DANS IBOX()
C  ALGO < NLIST+NBBOX
C-----------------------
        i=1
        j=1
        DO i=1,nbox
          DO WHILE(abs(list(i)) > ix1(j).AND. j < nbbox)
            j=j+1
          ENDDO
          IF (abs(list(i)) == ix1(j))THEN
            list(i) = ix2(j)*isign(i)
          ELSE
            CALL ancmsg(msgid=795,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  i1=id,
     .                  c1=titr,
     .                  i2=list(i))
            nboxlst=i-1
            RETURN
          ENDIF
        ENDDO
C---
        nboxlst = nbox
C---
        RETURN