spmd_i20normf.F File Reference

#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_i20normf (solidn_normal, solidn_normal_f, solidn_normal_fe, nin, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, nsv, nlg, islins)

Function/Subroutine Documentation

spmd_i20normf()

subroutine spmd_i20normf	(	integer, dimension(3,*)	solidn_normal,
		integer, dimension(3,*)	solidn_normal_f,
		integer, dimension(3,*)	solidn_normal_fe,
		integer	nin,
		integer	irlen20,
		integer	islen20,
		integer	irlen20t,
		integer	islen20t,
		integer	irlen20e,
		integer	islen20e,
		integer, dimension(*)	nsv,
		integer, dimension(*)	nlg,
		integer, dimension(2,*)	islins )

Definition at line 35 of file spmd_i20normf.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
#include      "implicit_f.inc"
C-----------------------------------------------
C   M e s s a g e   P a s s i n g
C-----------------------------------------------
#include "spmd.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,
     .        IRLEN20E,ISLEN20E,NIN,
     .        NSV(*), NLG(*), ISLINS(2,*)
      integer
     .        solidn_normal(3,*),
     .        solidn_normal_f(3,*), solidn_normal_fe(3,*)
 
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
#ifdef MPI
      INTEGER P, L, ADD, NB, SIZ, LOC_PROC, I, NOD, IL, IL1, IL2,
     .        IDEB, N, MSGTYP, IERROR, MSGOFF,
     .        N1, N2, IALLOCS, IALLOCR, LEN20, LEN20E,
     .        DEBUT, DEBUTE,
     .        STATUS(MPI_STATUS_SIZE),
     .        ADDS(NSPMD+1), ADDR(NSPMD+1),
     .        REQ_SI(NSPMD),REQ_RI(NSPMD),ISTOCOM
      INTEGER       ,DIMENSION(:), ALLOCATABLE :: BBUFS, BBUFR
      DATA msgoff/164/
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      loc_proc = ispmd + 1
      len20  = 3
      len20e = 6
      istocom=0
C
      iallocs = len20*islen20 + len20*islen20t + len20e*islen20e
      ierror=0
      IF(iallocs>0)
     +  ALLOCATE(bbufs(iallocs),stat=ierror)
      IF(ierror/=0) THEN
        CALL ancmsg(msgid=20,anmode=aninfo)
        CALL arret(2)
      END IF
C
      iallocr = len20*irlen20 + len20*irlen20t + len20e*irlen20e
      ierror=0
      IF(iallocr>0)
     +  ALLOCATE(bbufr(iallocr),stat=ierror)
      IF(ierror/=0) THEN
        CALL ancmsg(msgid=20,anmode=aninfo)
        CALL arret(2)
      END IF
C
C Receive
C
      l = 0
      DO p = 1, nspmd
        add = l+1
        addr(p) = add
        siz = 0
        IF(p/=loc_proc)THEN
          nb  = nsnfi(nin)%P(p)
          l = l + nb*len20
C ajout partie edge pour type 20
          nb = nsnfie(nin)%P(p)
          l = l + nb*len20e
          siz = l+1-add
          IF(siz>0)THEN
            msgtyp = msgoff
            CALL mpi_irecv(
     .          bbufr(add),siz,mpi_integer,it_spmd(p),msgtyp,
     .          spmd_comm_world,req_ri(p),ierror    )
          ENDIF
        ENDIF
      ENDDO
      addr(nspmd+1) = addr(nspmd)+siz
      IF(l>0) THEN
        istocom = 1
      ENDIF
C
C Send
C
      debut=0
      debute=0
      l = 0
      DO p = 1, nspmd
        add = l+1
        adds(p) = add
        siz = 0
        IF(p/=loc_proc)THEN
          ideb = debut
          nb = nsnsi(nin)%P(p)
          DO i = 1, nb
            n = nsvsi(nin)%P(ideb+i)
            il  = nsv(n)
            nod = nlg(il)
            bbufs(l+1) = solidn_normal(1,nod)
            bbufs(l+2) = solidn_normal(2,nod)
            bbufs(l+3) = solidn_normal(3,nod)
            l = l + len20
          ENDDO
          debut=debut+nb
C Extra Code for Type20 Edge
C
          nb = nsnsie(nin)%P(p)
          ideb = debute
          DO i = 1, nb
            n = nsvsie(nin)%P(ideb+i)
            il1 = islins(1,n)
            nod = nlg(il1)
            bbufs(l+1) = solidn_normal(1,nod)
            bbufs(l+2) = solidn_normal(2,nod)
            bbufs(l+3) = solidn_normal(3,nod)
            il2 = islins(2,n)
            nod = nlg(il2)
            bbufs(l+4) = solidn_normal(1,nod)
            bbufs(l+5) = solidn_normal(2,nod)
            bbufs(l+6) = solidn_normal(3,nod)
            l = l + len20e
          ENDDO
          debute=debute+nb
C end i20 edge
          siz = l+1-add
          IF(siz>0)THEN
            msgtyp = msgoff
C BUFR : reception partie force et envoi partie vitesse
            CALL mpi_isend(
     .        bbufs(add),siz,mpi_integer,it_spmd(p),msgtyp,
     .        spmd_comm_world,req_si(p),ierror    )
          ENDIF
        ENDIF
      ENDDO
      adds(nspmd+1)=adds(nspmd)+siz
C
C Attente reception buffer et decompactage
C
      IF(istocom==1)THEN
C
        debut = 0
        debute= 0
C
C Attente IRECV
C
        DO p = 1, nspmd
          IF(addr(p+1)-addr(p)>0) THEN
            CALL mpi_wait(req_ri(p),status,ierror)
            l = addr(p)-1
            nb = nsnfi(nin)%P(p)
            IF(nb>0)THEN
              ideb = debut
              DO i = 1, nb
                solidn_normal_f(1,i+ideb) = bbufr(l+1)
                solidn_normal_f(2,i+ideb) = bbufr(l+2)
                solidn_normal_f(3,i+ideb) = bbufr(l+3)
                l = l + len20
              ENDDO
              debut = debut + nb
            ENDIF
C
C Extra Code for Type20 Edge
C
            nb = nsnfie(nin)%P(p)
            IF(nb>0)THEN
              ideb = debute
              DO i = 1, nb
                n1 = 2*(i+ideb-1)+1
                n2 = 2*(i+ideb)
                solidn_normal_fe(1,n1) = bbufr(l+1)
                solidn_normal_fe(2,n1) = bbufr(l+2)
                solidn_normal_fe(3,n1) = bbufr(l+3)
                solidn_normal_fe(1,n2) = bbufr(l+4)
                solidn_normal_fe(2,n2) = bbufr(l+5)
                solidn_normal_fe(3,n2) = bbufr(l+6)
                l = l + len20e
              ENDDO
              debute = debute + nb
            ENDIF
C end extra for i20 edge
          END IF
        END DO
      END IF
C
      IF(iallocr>0)THEN
        DEALLOCATE(bbufr)
        iallocr=0
      END IF
C
C Attente ISEND
C
      DO p = 1, nspmd
        IF(adds(p+1)-adds(p)>0) THEN
          CALL mpi_wait(req_si(p),status,ierror)
        ENDIF
      ENDDO
C
      IF(iallocs>0)THEN
        DEALLOCATE(bbufs)
        iallocs=0
      END IF
C
#endif
      RETURN