Warning, /eesupp/src/gather_2d_wh_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
d7fbd5d0c9 Gael*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: GATHER_2D_WH_RX
0006 C !INTERFACE:
0007 SUBROUTINE GATHER_2D_WH_RX(
0008 O gloBuff,
0009 I procBuff,
0010 I myThid )
0011 C !DESCRIPTION:
0012 C Gather elements, including halos, of a global 2-D array from all mpi processes to process 0.
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 2D IO-buffer array (Output)
0024 C procBuff ( _RX ) :: proc-domain 2D IO-buffer array (Input)
0025 C myThid (integer):: my Thread Id number
0026
0027 C sNxWh :: x tile size with halo included
0028 C sNyWh :: y tile size with halo included
0029 C pocNyWh :: processor sum of sNyWh
0030 C gloNyWh :: global sum of sNyWh
0031 INTEGER sNxWh
0032 INTEGER sNyWh
0033 INTEGER procNyWh
0034 INTEGER gloNyWh
0035 PARAMETER ( sNxWh = sNx+2*Olx )
0036 PARAMETER ( sNyWh = sNy+2*Oly )
0037 PARAMETER ( procNyWh = sNyWh*nSy*nSx )
0038 PARAMETER ( gloNyWh = procNyWh*nPy*nPx )
0039
0040 _RX gloBuff(sNxWh,gloNyWh)
0041 _RX procBuff(sNxWh,procNyWh)
0042 INTEGER myThid
0043 CEOP
0044
0045 C !LOCAL VARIABLES:
0046 INTEGER i,j
0047 #ifdef ALLOW_USE_MPI
0048 INTEGER jj, np, np0
0049 _RX temp(sNxWh,gloNyWh)
0050 INTEGER istatus(MPI_STATUS_SIZE), ierr
0051 INTEGER lbuff, idest, itag, ready_to_receive
0052 #endif /* ALLOW_USE_MPI */
0053
0054 _BEGIN_MASTER( myThid )
0055
0056 IF( myProcId .EQ. 0 ) THEN
0057 C-- Process 0 fills-in its local data
0058
0059 c DO j=1,gloNyWh
0060 c DO i=1,sNxWh
0061 c gloBuff(i,j) = 0.
0062 c ENDDO
0063 c ENDDO
0064
0065 DO j=1,procNyWh
0066 DO i=1,sNxWh
0067 gloBuff(i,j) = procBuff(i,j)
0068 ENDDO
0069 ENDDO
0070
0071 C- end if myProcId = 0
0072 ENDIF
0073
0074 #ifdef ALLOW_USE_MPI
0075
0076 lbuff = sNxWh*procNyWh
0077 idest = 0
0078 itag = 0
0079 ready_to_receive = 0
0080
0081 IF( mpiMyId .EQ. 0 ) THEN
0082
0083 C-- Process 0 polls and receives data from each process in turn
0084 DO np = 2, numberOfProcs
0085 np0 = np - 1
0086 #ifndef DISABLE_MPI_READY_TO_RECEIVE
0087 CALL MPI_SEND (ready_to_receive, 1, MPI_INTEGER,
0088 & np0, itag, MPI_COMM_MODEL, ierr)
0089 #endif
0090 CALL MPI_RECV (temp, lbuff, _MPI_TYPE_RX,
0091 & np0, itag, MPI_COMM_MODEL, istatus, ierr)
0092
0093 DO j=1,procNyWh
0094 DO i=1,sNxWh
0095 jj=j+procNyWh*(np-1)
0096 gloBuff(i,jj) = temp(i,j)
0097 ENDDO
0098 ENDDO
0099 C- end loop on np
0100 ENDDO
0101
0102 ELSE
0103
0104 C-- All proceses except 0 wait to be polled then send local array
0105 #ifndef DISABLE_MPI_READY_TO_RECEIVE
0106 CALL MPI_RECV (ready_to_receive, 1, MPI_INTEGER,
0107 & idest, itag, MPI_COMM_MODEL, istatus, ierr)
0108 #endif
0109 CALL MPI_SEND (procBuff, lbuff, _MPI_TYPE_RX,
0110 & idest, itag, MPI_COMM_MODEL, ierr)
0111
0112 ENDIF
0113
0114 #endif /* ALLOW_USE_MPI */
0115
0116 _END_MASTER( myThid )
0117
0118 RETURN
0119 END
0120
