Warning, /eesupp/src/exch1_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
b56f9aa5e6 Jean*0001 #include "CPP_EEOPTIONS.h"
0002
0003 CBOP
0004
0005 C !ROUTINE: EXCH1_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH1_RX(
0009 U array,
0010 I myOLw, myOLe, myOLs, myOLn, myNz,
0011 I exchWidthX, exchWidthY,
0012 I cornerMode, myThid )
0013
0014 C !DESCRIPTION:
0015 C *==========================================================*
0016 C | SUBROUTINE EXCH1_RX
0017 C | o Control forward-mode edge exchanges for RX array.
0018 C *==========================================================*
0019 C | Controlling routine for exchange of XY edges of an array
0020 C | distributed in X and Y. The routine interfaces to
0021 C | communication routines that can use messages passing
0022 C | exchanges, put type exchanges or get type exchanges.
0023 C | This allows anything from MPI to raw memory channel to
0024 C | memmap segments to be used as a inter-process and/or
0025 C | inter-thread communiation and synchronisation
0026 C | mechanism.
0027 C | Notes --
0028 C | 1. Some low-level mechanisms such as raw memory-channel
0029 C | or SGI/CRAY shmem put do not have direct Fortran bindings
0030 C | and are invoked through C stub routines.
0031 C | 2. Although this routine is fairly general but it does
0032 C | require nSx and nSy are the same for all innvocations.
0033 C | There are many common data structures ( myByLo,
0034 C | westCommunicationMode, mpiIdW etc... ) tied in with
0035 C | (nSx,nSy). To support arbitray nSx and nSy would require
0036 C | general forms of these.
0037 C | 3. RX arrays are used to generate code for both _RL and
0038 C | _RS forms.
0039 C *==========================================================*
0040
0041 C !USES:
0042 IMPLICIT NONE
0043
0044 C == Global data ==
0045 #include "SIZE.h"
0046 #include "EEPARAMS.h"
0047 #include "EXCH.h"
0048
0049 C !INPUT/OUTPUT PARAMETERS:
0050 C == Routine arguments ==
0051 C array :: Array with edges to exchange.
0052 C myOLw,myOLe :: West and East overlap region sizes.
0053 C myOLs,myOLn :: South and North overlap region sizes.
0054 C exchWidthX :: Width of data region exchanged in X.
0055 C exchWidthY :: Width of data region exchanged in Y.
0056 C Note --
0057 C 1. In theory one could have a send width and
0058 C a receive width for each face of each tile. The only
0059 C restriction would be that the send width of one
0060 C face should equal the receive width of the sent to
0061 C tile face. Dont know if this would be useful. I
0062 C have left it out for now as it requires additional
0063 C bookeeping.
0064 C cornerMode :: Flag indicating whether corner updates are needed.
0065 C myThid :: my Thread Id number
0066
0067 INTEGER myOLw, myOLe, myOLs, myOLn, myNz
0068 _RX array( 1-myOLw:sNx+myOLe,
0069 & 1-myOLs:sNy+myOLn,
0070 & myNz, nSx, nSy )
0071 INTEGER exchWidthX
0072 INTEGER exchWidthY
0073 INTEGER cornerMode
0074 INTEGER myThid
0075
0076 C !LOCAL VARIABLES:
0077 C == Local variables ==
0078 C theSimulationMode :: Holds working copy of simulation mode
0079 C theCornerMode :: Holds working copy of corner mode
0080 C i,j,k,bi,bj :: Loop counters
0081 INTEGER theSimulationMode
0082 INTEGER theCornerMode
0083 INTEGER i,j,k,bi,bj
0084 CEOP
0085
0086 theSimulationMode = FORWARD_SIMULATION
0087 theCornerMode = cornerMode
0088
0089 C-- Error checks
0090 IF ( exchWidthX .GT. myOLw )
0091 & STOP ' S/R EXCH1_RX: exchWidthX .GT. myOLw'
0092 IF ( exchWidthX .GT. myOLe )
0093 & STOP ' S/R EXCH1_RX: exchWidthX .GT. myOLe'
0094 IF ( exchWidthY .GT. myOLs )
0095 & STOP ' S/R EXCH1_RX: exchWidthY .GT. myOLs'
0096 IF ( exchWidthY .GT. myOLn )
0097 & STOP ' S/R EXCH1_RX: exchWidthY .GT. myOLn'
0098 IF ( myOLw .GT. MAX_OLX_EXCH )
0099 & STOP ' S/R EXCH1_RX: myOLw .GT. MAX_OLX_EXCH'
0100 IF ( myOLe .GT. MAX_OLX_EXCH )
0101 & STOP ' S/R EXCH1_RX: myOLe .GT. MAX_OLX_EXCH'
f603e2d124 Jean*0102 IF ( myOLn .GT. MAX_OLY_EXCH )
b56f9aa5e6 Jean*0103 & STOP ' S/R EXCH1_RX: myOLn .GT. MAX_OLY_EXCH'
0104 IF ( myOLs .GT. MAX_OLY_EXCH )
0105 & STOP ' S/R EXCH1_RX: myOLs .GT. MAX_OLY_EXCH'
0106 IF ( myNz .GT. MAX_NR_EXCH )
0107 & STOP ' S/R EXCH1_RX: myNz .GT. MAX_NR_EXCH '
0108 IF ( theCornerMode .NE. EXCH_IGNORE_CORNERS
0109 & .AND. theCornerMode .NE. EXCH_UPDATE_CORNERS
0110 & ) STOP ' S/R EXCH1_RX: Unrecognised cornerMode '
0111
0112 C-- Cycle edge buffer level
0113 CALL EXCH_CYCLE_EBL( myThid )
0114
0115 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0116
0117 IF ( Nx .EQ. 1 ) THEN
0118 C Special case for zonal average model i.e. case where Nx == 1
0119 C In this case a reverse mode exchange simply add values from all i <> 1
0120 C to i=1 element and reset to zero.
0121 DO bj=myByLo(myThid),myByHi(myThid)
0122 DO bi=myBxLo(myThid),myBxHi(myThid)
0123 DO k = 1,myNz
0124 DO j = 1-myOLs,sNy+myOLn
0125 DO i = 1-myOLw,0
0126 array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
0127 & + array(i,j,k,bi,bj)
0128 array(i,j,k,bi,bj) = 0.
0129 ENDDO
0130 DO i = sNx+1,sNx+myOLe
0131 array(1,j,k,bi,bj) = array(1,j,k,bi,bj)
0132 & + array(i,j,k,bi,bj)
0133 array(i,j,k,bi,bj) = 0.
0134 ENDDO
0135 ENDDO
0136 ENDDO
0137 ENDDO
0138 ENDDO
0139 ENDIF
0140
0141 IF ( Ny .EQ. 1 ) THEN
0142 C Special case for X-slice domain i.e. case where Ny == 1
0143 C In this case a reverse mode exchange simply add values from all j <> 1
0144 C to j=1 element and reset to zero.
0145 DO bj=myByLo(myThid),myByHi(myThid)
0146 DO bi=myBxLo(myThid),myBxHi(myThid)
0147 DO k = 1,myNz
0148 DO j = 1-myOLs,0
0149 DO i = 1-myOLw,sNx+myOLe
0150 array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
0151 & + array(i,j,k,bi,bj)
0152 array(i,j,k,bi,bj) = 0.
0153 ENDDO
0154 ENDDO
0155 DO j = sNy+1,sNy+myOLn
0156 DO i = 1-myOLw,sNx+myOLe
0157 array(i,1,k,bi,bj) = array(i,1,k,bi,bj)
0158 & + array(i,j,k,bi,bj)
0159 array(i,j,k,bi,bj) = 0.
0160 ENDDO
0161 ENDDO
0162 ENDDO
0163 ENDDO
0164 ENDDO
0165 ENDIF
0166
0167 C-- end of special cases of forward exch
0168 ENDIF
0169
0170 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0171 C-- "Put" east and west edges.
0172 CALL EXCH_RX_SEND_PUT_X( array,
0173 I myOLw, myOLe, myOLs, myOLn, myNz,
0174 I exchWidthX, exchWidthY,
0175 I theSimulationMode, theCornerMode, myThid )
0176 C-- If corners are important then sync and update east and west edges
0177 C-- before doing north and south exchanges.
0178 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0179 CALL EXCH_RX_RECV_GET_X( array,
0180 I myOLw, myOLe, myOLs, myOLn, myNz,
0181 I exchWidthX, exchWidthY,
0182 I theSimulationMode, theCornerMode, myThid )
0183 ENDIF
0184 C "Put" north and south edges.
0185 CALL EXCH_RX_SEND_PUT_Y( array,
0186 I myOLw, myOLe, myOLs, myOLn, myNz,
0187 I exchWidthX, exchWidthY,
0188 I theSimulationMode, theCornerMode, myThid )
0189 C-- Sync and update north, south (and east, west if corner updating
0190 C-- not active).
0191 IF ( theCornerMode .NE. EXCH_UPDATE_CORNERS ) THEN
0192 CALL EXCH_RX_RECV_GET_X( array,
0193 I myOLw, myOLe, myOLs, myOLn, myNz,
0194 I exchWidthX, exchWidthY,
0195 I theSimulationMode, theCornerMode, myThid )
0196 ENDIF
0197 CALL EXCH_RX_RECV_GET_Y( array,
0198 I myOLw, myOLe, myOLs, myOLn, myNz,
0199 I exchWidthX, exchWidthY,
0200 I theSimulationMode, theCornerMode, myThid )
0201 ENDIF
0202
0203 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0204 C "Put" north and south edges.
0205 CALL EXCH_RX_SEND_PUT_Y( array,
0206 I myOLw, myOLe, myOLs, myOLn, myNz,
0207 I exchWidthX, exchWidthY,
0208 I theSimulationMode, theCornerMode, myThid )
0209 C-- If corners are important then sync and update east and west edges
0210 C-- before doing north and south exchanges.
0211 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0212 CALL EXCH_RX_RECV_GET_Y( array,
0213 I myOLw, myOLe, myOLs, myOLn, myNz,
0214 I exchWidthX, exchWidthY,
0215 I theSimulationMode, theCornerMode, myThid )
0216 ENDIF
0217 C-- "Put" east and west edges.
0218 CALL EXCH_RX_SEND_PUT_X( array,
0219 I myOLw, myOLe, myOLs, myOLn, myNz,
0220 I exchWidthX, exchWidthY,
0221 I theSimulationMode, theCornerMode, myThid )
0222 C-- Sync and update east, west (and north, south if corner updating
0223 C-- not active).
0224 IF ( theCornerMode .NE. EXCH_UPDATE_CORNERS ) THEN
0225 CALL EXCH_RX_RECV_GET_Y( array,
0226 I myOLw, myOLe, myOLs, myOLn, myNz,
0227 I exchWidthX, exchWidthY,
0228 I theSimulationMode, theCornerMode, myThid )
0229 ENDIF
0230 CALL EXCH_RX_RECV_GET_X( array,
0231 I myOLw, myOLe, myOLs, myOLn, myNz,
0232 I exchWidthX, exchWidthY,
0233 I theSimulationMode, theCornerMode, myThid )
0234 ENDIF
0235
0236 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0237
0238 IF ( Nx .EQ. 1 ) THEN
0239 C Special case for zonal average model i.e. case where Nx == 1
0240 C In this case a forward mode exchange simply sets array to
0241 C the i=1 value for all i.
0242 DO bj=myByLo(myThid),myByHi(myThid)
0243 DO bi=myBxLo(myThid),myBxHi(myThid)
0244 DO k = 1,myNz
0245 DO j = 1-myOLs,sNy+myOLn
0246 DO i = 1-myOLw,sNx+myOLe
0247 array(i,j,k,bi,bj) = array(1,j,k,bi,bj)
0248 ENDDO
0249 ENDDO
0250 ENDDO
0251 ENDDO
0252 ENDDO
0253 ENDIF
0254
0255 IF ( Ny .EQ. 1 ) THEN
0256 C Special case for X-slice domain i.e. case where Ny == 1
0257 C In this case a forward mode exchange simply sets array to
0258 C the j=1 value for all j.
0259 DO bj=myByLo(myThid),myByHi(myThid)
0260 DO bi=myBxLo(myThid),myBxHi(myThid)
0261 DO k = 1,myNz
0262 DO j = 1-myOLs,sNy+myOLn
0263 DO i = 1-myOLw,sNx+myOLe
0264 array(i,j,k,bi,bj) = array(i,1,k,bi,bj)
0265 ENDDO
0266 ENDDO
0267 ENDDO
0268 ENDDO
0269 ENDDO
0270 ENDIF
0271
0272 C-- end of special cases of forward exch
0273 ENDIF
0274
0275 RETURN
0276 END
