i25_prepare.F File Reference

#include "implicit_f.inc"
#include "assert.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_i25_prepare (mode, ipari, intbuf_tab, iad_elem, fr_elem, intlist, nbintc, iad_i25, sfr_i25, fr_i25)

Function/Subroutine Documentation

spmd_i25_prepare()

subroutine spmd_i25_prepare	(	integer	mode,
		integer, dimension(npari,*)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
		integer, dimension(*)	intlist,
		integer	nbintc,
		integer, dimension(nbintc+1,nspmd)	iad_i25,
		integer	sfr_i25,
		integer, dimension(*)	fr_i25 )

Definition at line 32 of file i25_prepare.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE message_mod
      USE intbufdef_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "assert.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com04_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MODE
      INTEGER IPARI(NPARI,*),IAD_ELEM(2,*),FR_ELEM(*),
     *        INTLIST(*),NBINTC,IAD_I25(NBINTC+1,NSPMD), SFR_I25,
     *        FR_I25(*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER SZFRI25,IAFR25
      INTEGER P,I,J,NI,NIN,NOD,NTY,NSN,SN
      INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
C-----------------------------------------------
C Partie 1, calcul des tailles de FR_I25
C-----------------------------------------------
      ALLOCATE(itag(numnod))
      itag(1:numnod)=0
      IF (mode==1)THEN
 
        szfri25 = 0
      
        DO p = 1, nspmd
          IF(iad_elem(1,p+1)-iad_elem(1,p)>0) THEN
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=1
            ENDDO
            DO ni=1,nbintc
                nin = intlist(ni)
              nty   = ipari(7,nin)
              nsn   = ipari(5,nin)
 
              IF(nty==25) THEN
                DO i=1,nsn
                  sn = intbuf_tab(nin)%NSV(i)
                  IF(itag(sn)==1)THEN
                    szfri25 = szfri25+1
                  ENDIF
                ENDDO
              ENDIF
            ENDDO          
C Flush ITAG to zero again for next CPU
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=0
            ENDDO
          ENDIF
        ENDDO
        sfr_i25=szfri25
      
C-----------------------------------------------
C Partie 2, on remplis FR_I25 et IAD_I25
C-----------------------------------------------
      ELSEIF(mode==2)THEN
        iad_i25(1,1)=1
        iafr25=0
        DO p = 1, nspmd
          IF(iad_elem(1,p+1)-iad_elem(1,p)>0) THEN
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=1
            ENDDO
 
            DO ni=1,nbintc
                iad_i25(ni+1,p)=iad_i25(ni,p)
                nin = intlist(ni)
              nty   = ipari(7,nin)
              nsn   = ipari(5,nin)
 
              IF(nty==25) THEN
                DO i=1,nsn
                  sn = intbuf_tab(nin)%NSV(i)
                  assert(sn > 0)
                  assert(sn <= numnod)
                  IF(itag(sn)==1)THEN     
                    iad_i25(ni+1,p)=iad_i25(ni+1,p)+1
              iafr25 = iafr25 + 1
                    fr_i25(iafr25)=i
                  ENDIF
                ENDDO
              ENDIF
            ENDDO
C Flush ITAG to zero again for next CPU
            DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              itag(nod)=0
            ENDDO
            ELSE
            DO i=2,nbintc+1
                iad_i25(i,p)=iad_i25(1,p)
              ENDDO    
          ENDIF    ! IF(IAD_ELEM(1,P+1)-IAD_ELEM(1,P)>0)
            IF(p<nspmd)iad_i25(1,p+1)=iad_i25(nbintc+1,p)
        ENDDO
      ENDIF
      
 
      DEALLOCATE(itag)
      RETURN
C-----------------------------------------------