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