Warning, /eesupp/src/gather_vec_rx.template is written in an unsupported language. File is not indexed.
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
583565da79 Jean*0001 #include "CPP_EEOPTIONS.h"
0002
0003 CBOP
0004 C !ROUTINE: GATHER_VEC_RX
0005 C !INTERFACE:
0006 SUBROUTINE GATHER_VEC_RX(
0007 O gloBuff,
0008 I myField,
0009 I length,
0010 I myThid )
0011 C !DESCRIPTION:
0012 C Gather 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 (Output)
0024 C myField ( _RX ) :: local (i.e. my Proc.) 1D array (Input)
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, idest, itag, ready_to_receive
0041 #endif /* ALLOW_USE_MPI */
0042
0043 _BEGIN_MASTER( myThid )
0044
0045 IF ( myProcId .EQ. 0 ) THEN
0046 C-- Process 0 fills-in its local data
0047
0048 DO j=1,length
0049 gloBuff(j) = myField(j)
0050 ENDDO
0051
0052 C- end if myProcId = 0
0053 ENDIF
0054
0055 #ifdef ALLOW_USE_MPI
0056 IF ( usingMPI ) THEN
0057
0058 lbuff = length
0059 idest = 0
0060 itag = 0
0061 ready_to_receive = 0
0062
0063 IF ( mpiMyId .EQ. 0 ) THEN
0064
0065 DO np = 2, nPx*nPy
0066
0067 C-- Process 0 polls and receives data from each process in turn
0068 pId = np - 1
d951206572 Jean*0069 jG = 1 + ( np - 1 )*length
583565da79 Jean*0070 #ifndef DISABLE_MPI_READY_TO_RECEIVE
0071 CALL MPI_SEND ( ready_to_receive, 1, MPI_INTEGER,
0072 & pId, itag, MPI_COMM_MODEL, ierr)
0073 #endif
d951206572 Jean*0074 CALL MPI_RECV ( gloBuff(jG), lbuff, _MPI_TYPE_RX,
583565da79 Jean*0075 & pId, itag, MPI_COMM_MODEL, istatus, ierr )
0076
0077 C- end loop on np
0078 ENDDO
0079
0080 ELSE
0081
0082 C-- All proceses except 0 wait to be polled then send local array
0083 #ifndef DISABLE_MPI_READY_TO_RECEIVE
0084 CALL MPI_RECV ( ready_to_receive, 1, MPI_INTEGER,
0085 & idest, itag, MPI_COMM_MODEL, istatus, ierr )
0086 #endif
0087 CALL MPI_SEND ( myField, lbuff, _MPI_TYPE_RX,
0088 & idest, itag, MPI_COMM_MODEL, ierr )
0089
0090 ENDIF
0091
0092 ENDIF
0093 #endif /* ALLOW_USE_MPI */
0094
0095 _END_MASTER( myThid )
0096
0097 RETURN
0098 END
