spmd_collect_nlocal.F File Reference

#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"
#include "chara_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spmd_collect_nlocal (a, sizea, numnod_local, posi, nloc_dmg, sizp0, nodglob, itab)

Function/Subroutine Documentation

spmd_collect_nlocal()

subroutine spmd_collect_nlocal	(		a,
		integer	sizea,
		integer	numnod_local,
		integer, dimension(*)	posi,
		type(nlocal_str_), target	nloc_dmg,
		integer	sizp0,
		integer, dimension(*)	nodglob,
		integer, dimension(*)	itab )

Definition at line 34 of file spmd_collect_nlocal.F.

 
      USE inoutfile_mod
      USE debug_mod
      USE nlocal_reg_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"
#include      "spmd_c.inc"
#include      "chara_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITAB(*),NUMNOD_LOCAL,NODGLOB(*)
      INTEGER NPOS,SIZP0
      INTEGER MSGOFF,MSGOFF0,MSGTYP,INFO,I,K,NG,N,
     .        EMPL,SDNODG(NUMNODM),FILEN 
      double precision
     .        aglob(2,numnodm),recglob(2,sizp0) 
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER POSI(*)
      INTEGER SIZEA
      my_real 
     .   a(sizea)
      TYPE(NLOCAL_STR_), TARGET                  :: NLOC_DMG 
      CHARACTER FILNAM*100,CYCLENUM*7
 
      INTEGER :: LEN_TMP_NAME
      CHARACTER(len=2148) :: TMP_NAME
 
#ifdef MPI 
      INTEGER STATUS(MPI_STATUS_SIZE),IERROR
 
      DATA msgoff0/176/
      DATA msgoff/177/
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      recglob(1:2,1:sizp0) = -1
      IF (ispmd/=0) THEN
      n=0
      DO i = 1,numnod_local
        npos = posi(i)                              ! Position of its first d.o.f in A
        
        n=n+1
        sdnodg(n) = nodglob(nloc_dmg%INDX(i))
        aglob(1,n) = itab( nloc_dmg%INDX(i) )
        aglob(2,n) = a(npos)
      ENDDO
 
 
        msgtyp=msgoff0
        CALL mpi_send(sdnodg,n,mpi_integer,
     .                it_spmd(1),msgtyp,
     .                spmd_comm_world,ierror)
        msgtyp=msgoff
        CALL mpi_send(aglob,2*n,mpi_double_precision,
     .                it_spmd(1),msgtyp,
     .                spmd_comm_world,ierror)
      ELSE
 
        DO k=2,nspmd
            msgtyp=msgoff0
            CALL mpi_recv(sdnodg,numnodm,mpi_integer,
     .                    it_spmd(k),msgtyp,
     .                    spmd_comm_world,status,ierror)
 
            CALL mpi_get_count(status,mpi_integer,n,ierror)
 
            msgtyp=msgoff
            CALL mpi_recv(aglob,2*n,mpi_double_precision,
     .                    it_spmd(k),msgtyp,
     .                    spmd_comm_world,status,ierror)
 
 
            DO i=1,n
                empl = sdnodg(i)
                recglob(1,empl) = aglob(1,i)
                recglob(2,empl) = aglob(2,i)
            ENDDO
        END DO
      ENDIF
#endif
C
 
        IF(ispmd==0) THEN
            WRITE(cyclenum,'(I7.7)')ncycle
            filnam=rootnam(1:rootlen)//'_NLOCAL_'//chrun//'_'//cyclenum//'.adb'
 
            len_tmp_name = outfile_name_len + len_trim(filnam)
            tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam)) 
       
            OPEN(unit=idbg5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',
     .                  form='FORMATTED',status='UNKNOWN')
 
            filen = rootlen+17
 
            DO i=1,numnod_local
                npos = posi(i)                              ! Position of its first d.o.f in A
                n =  nodglob(nloc_dmg%INDX(i))
                recglob(1,n) = itab( nloc_dmg%INDX(i) )
                recglob(2,n) = a(npos)
            ENDDO
 
        
            DO i = 1, numnodg
                IF(nint(recglob(1,i))/=-1) THEN
                    WRITE(idbg5,'(A,I10,I10,Z20)' ) '>',ncycle,nint(recglob(1,i)),recglob(2,i)
                ENDIF
            END DO
            WRITE (iout,1300)  filnam(1:filen)
            WRITE (istdo,1300) filnam(1:filen)
            CLOSE(unit=idbg5)
 
      END IF
C
 1300   FORMAT (4x,' DEBUG ANALYSIS NLOCAL FILE :',1x,a,' WRITTEN')
      RETURN