eesupp/src/scatter_vec_rx.template

583565da79 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: SCATTER_VEC_RX
                0005 C !INTERFACE:
                0006       SUBROUTINE SCATTER_VEC_RX(
                0007      I                  gloBuff,
                0008      O                  myField,
                0009      I                  length,
                0010      I                  myThid )
                0011 C !DESCRIPTION:
                0012 C     Scatter elements of a global 1-D array from mpi process 0 to all processes.
                0013 C     Note: done by Master-Thread ; might need barrier calls before and after
                0014 C           this S/R call.
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "EESUPPORT.h"
                0021
                0022 C     !INPUT/OUTPUT PARAMETERS:
                0023 C gloBuff   ( _RX ) :: full-domain IO-buffer array      (Input)
                0024 C myField   ( _RX ) :: local (i.e. my Proc.) 1D array  (Output)
                0025 C length   (integer):: size of local 1D array
                0026 C myThid   (integer):: my Thread Id number
                0027
                0028       INTEGER length
                0029       _RX     gloBuff(length*nPx*nPy)
                0030       _RX     myField(length)
                0031       INTEGER myThid
                0032 CEOP
                0033
                0034 C !LOCAL VARIABLES:
                0035       INTEGER j
                0036 #ifdef ALLOW_USE_MPI
d951206572 Jean*0037       INTEGER jG
583565da79 Jean*0038       INTEGER np, pId
                0039       INTEGER istatus(MPI_STATUS_SIZE), ierr
                0040       INTEGER lbuff, isource, itag
                0041 #endif /* ALLOW_USE_MPI */
                0042
                0043       _BEGIN_MASTER( myThid )
                0044
                0045 #ifdef ALLOW_USE_MPI
                0046       IF ( usingMPI ) THEN
                0047
                0048        lbuff = length
                0049        isource = 0
                0050        itag  = 0
                0051
                0052        IF ( mpiMyId .EQ. 0 ) THEN
                0053
d951206572 Jean*0054 C--   Process 0 sends pieces of global array to all other processes
583565da79 Jean*0055         DO np = 2, nPx*nPy
                0056
                0057           pId = np - 1
d951206572 Jean*0058           jG = 1 + ( np - 1 )*length
                0059           CALL MPI_SEND ( gloBuff(jG), lbuff, _MPI_TYPE_RX,
583565da79 Jean*0060      &                    pId, itag, MPI_COMM_MODEL, ierr )
                0061
                0062 C-      end loop on np
                0063         ENDDO
                0064
                0065        ELSE
                0066
                0067 C--   All proceses except 0 receive local array from process 0
                0068          CALL MPI_RECV ( myField, lbuff, _MPI_TYPE_RX,
                0069      &        isource, itag, MPI_COMM_MODEL, istatus, ierr )
                0070
                0071        ENDIF
                0072
                0073       ENDIF
                0074 #endif /* ALLOW_USE_MPI */
                0075
                0076       IF ( myProcId .EQ. 0 ) THEN
                0077 C--   Process 0 fills-in its local data
                0078
                0079         DO j=1,length
                0080           myField(j) = gloBuff(j)
                0081         ENDDO
                0082
                0083 C-    end if myProcId = 0
                0084       ENDIF
                0085
                0086       _END_MASTER( myThid )
                0087
                0088       RETURN
                0089       END