spmd_i7curvsz.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_i7curvsz (nrtm, irect, numnod, iad_elem, fr_elem, isdsiz, ircsiz, itag, lenr, lent, maxcc)

Function/Subroutine Documentation

spmd_i7curvsz()

subroutine spmd_i7curvsz	(	integer	nrtm,
		integer, dimension(4,nrtm)	irect,
		integer	numnod,
		integer, dimension(2,*)	iad_elem,
		integer, dimension(*)	fr_elem,
		integer, dimension(*)	isdsiz,
		integer, dimension(*)	ircsiz,
		integer, dimension(*)	itag,
		integer	lenr,
		integer	lent,
		integer	maxcc )

Definition at line 31 of file spmd_i7curvsz.F.

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 NRTM,NUMNOD,LENR,LENT,MAXCC,
     .        IRECT(4,NRTM),ITAG(*),
     .        IAD_ELEM(2,*), FR_ELEM(*), ISDSIZ(*), IRCSIZ(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
#ifdef MPI
      INTEGER I ,J ,N1, N2, N3, N4, IERROR, IAD, SIZ, NB,
     .        MSGTYP, LOC_PROC, MSGOFF,
     .        IBUFS(LENR), IBUFR(LENR),
     .        STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD)
      DATA msgoff/193/
 
C-----------------------------------------------
C
      loc_proc = ispmd+1
C
      iad = 1
      DO i=1,nspmd
        ircsiz(i) = 0
        siz = iad_elem(1,i+1)-iad_elem(1,i)
        IF(siz>0)THEN
          msgtyp = msgoff
          CALL mpi_irecv(
     s      ibufr(iad),siz,mpi_integer,it_spmd(i),msgtyp,
     g      spmd_comm_world,req_r(i),ierror)
            iad = iad + siz
        ENDIF
      END DO
      DO n1=1,numnod
        itag(n1) = 0
      END DO
 
      DO i=1,nrtm
        n1 = irect(1,i)
        n2 = irect(2,i)
        n3 = irect(3,i)
        n4 = irect(4,i)
        itag(n1) = itag(n1) + 1
        itag(n2) = itag(n2) + 1
        itag(n3) = itag(n3) + 1
        itag(n4) = itag(n4) + 1
      END DO
      DO i=1,nspmd
        isdsiz(i) = 0
        siz = iad_elem(1,i+1)-iad_elem(1,i)
        IF(siz>0)THEN
          iad = 1
#include      "vectorize.inc"
          DO j=iad_elem(1,i),iad_elem(1,i+1)-1
            n1 = fr_elem(j)
            isdsiz(i) = isdsiz(i) + itag(n1)
            ibufs(iad) = itag(n1)
            iad = iad + 1
          END DO
          msgtyp = msgoff
          CALL mpi_send(
     s      ibufs,siz,mpi_integer,it_spmd(i),msgtyp,
     g      spmd_comm_world,ierror)
        END IF
      END DO
C
      isdsiz(nspmd+1) = 0
      ircsiz(nspmd+1) = 0
      iad = 0
      DO i = 1, nspmd
        siz = iad_elem(1,i+1)-iad_elem(1,i)
        IF(siz>0)THEN
          CALL mpi_wait(req_r(i),status,ierror)
          DO j=iad_elem(1,i),iad_elem(1,i+1)-1
            n1 = fr_elem(j)
            iad = iad + 1
            nb = ibufr(iad)
            ircsiz(i) = ircsiz(i) + nb
            itag(n1) = itag(n1) + nb
          END DO
          isdsiz(nspmd+1) = isdsiz(nspmd+1) + isdsiz(i)
          ircsiz(nspmd+1) = ircsiz(nspmd+1) + ircsiz(i)
        END IF
      END DO
C
      lent = 0
      maxcc = 0
      DO n1=1,numnod
        lent = lent + itag(n1)
        maxcc = max(maxcc,itag(n1))
      END DO
C
#endif
      RETURN