Warning, /eesupp/src/exch0_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
6979a1789e Jean*0001 #include "CPP_EEOPTIONS.h"
0002
0003 C-- File exch0_rx.template: to replace EXCH routines when using disconnected tiles
0004 C-- Contents
0005 C-- o EXCH0_RX
0006 C-- o FILL_HALO_LOCAL_RX
0007
0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0009
0010 CBOP
0011
0012 C !ROUTINE: EXCH0_RX
0013
0014 C !INTERFACE:
0015 SUBROUTINE EXCH0_RX(
0016 U array,
0017 I myOLw, myOLe, myOLs, myOLn, myNr,
0018 I exchWidthX, exchWidthY,
0019 I cornerMode, myThid )
0020
0021 C !DESCRIPTION:
0022 C *==========================================================*
0023 C | SUBROUTINE EXCH0_RX
0024 C | o Replace Exchange routines for the special case
0025 C | where tiles are disconnected (no exchange between tiles,
0026 C | just fill in edges of an array assuming locally periodic
0027 C | subdomain)
0028 C *==========================================================*
0029 C | RX arrays are used to generate code for all 4 types
0030 C | of arrays (R4, R8, RS and RL)
0031 C *==========================================================*
0032
0033 C !USES:
0034 IMPLICIT NONE
0035
0036 C == Global data ==
0037 #include "SIZE.h"
0038 #include "EEPARAMS.h"
0039
0040 C !INPUT/OUTPUT PARAMETERS:
0041 C == Routine arguments ==
0042 C array :: Array with edges to exchange.
0043 C myOLw,myOLe :: West and East overlap region sizes.
0044 C myOLs,myOLn :: South and North overlap region sizes.
0045 C myNr :: array 3rd dimension
0046 C exchWidthX :: Width of data region exchanged in X.
0047 C exchWidthY :: Width of data region exchanged in Y.
0048 C cornerMode :: Flag indicating whether corner updates are needed.
0049 C myThid :: my Thread Id number
0050
0051 INTEGER myOLw, myOLe, myOLs, myOLn, myNr
0052 _RX array( 1-myOLw:sNx+myOLe, 1-myOLs:sNy+myOLn,
0053 & myNr, nSx, nSy )
0054 INTEGER exchWidthX
0055 INTEGER exchWidthY
0056 INTEGER cornerMode
0057 INTEGER myThid
0058
0059 #ifdef DISCONNECTED_TILES
0060 C !LOCAL VARIABLES:
0061 C == Local variables ==
0062 C bi, bj :: tile indices
0063 INTEGER bi, bj
0064 CEOP
0065
0066 C-- Error checks
0067 IF ( exchWidthX .GT. myOLw )
0068 & STOP ' S/R EXCH0_RX: exchWidthX .GT. myOLw'
0069 IF ( exchWidthX .GT. myOLe )
0070 & STOP ' S/R EXCH0_RX: exchWidthX .GT. myOLe'
0071 IF ( exchWidthY .GT. myOLs )
0072 & STOP ' S/R EXCH0_RX: exchWidthY .GT. myOLs'
0073 IF ( exchWidthY .GT. myOLn )
0074 & STOP ' S/R EXCH0_RX: exchWidthY .GT. myOLn'
0075 IF ( cornerMode .NE. EXCH_IGNORE_CORNERS
0076 & .AND. cornerMode .NE. EXCH_UPDATE_CORNERS )
0077 & STOP ' S/R EXCH0_RX: Unrecognised cornerMode '
0078
0079 C-- Over all tiles
0080 DO bj = myByLo(myThid), myByHi(myThid)
0081 DO bi = myBxLo(myThid), myBxHi(myThid)
0082 CALL FILL_HALO_LOCAL_RX(
0083 U array(1-myOLw,1-myOLs,1,bi,bj),
0084 I myOLw, myOLe, myOLs, myOLn, myNr,
0085 I cornerMode, bi, bj, myThid )
0086 ENDDO
0087 ENDDO
0088
0089 #else /* DISCONNECTED_TILES */
0090 STOP 'ABNORMAL END: S/R EXCH0_RX is empty'
0091 #endif /* DISCONNECTED_TILES */
0092
0093 RETURN
0094 END
0095
0096 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0097 CBOP
0098 C !ROUTINE: FILL_HALO_LOCAL_RX
0099
0100 C !INTERFACE:
0101 SUBROUTINE FILL_HALO_LOCAL_RX(
0102 U locFld,
0103 I myOLw, myOLe, myOLs, myOLn, myNr,
0104 c I exchWidthX, exchWidthY,
0105 I cornerMode, bi, bj, myThid )
0106
0107 C !DESCRIPTION:
0108 C *==========================================================*
0109 C | SUBROUTINE FILL_HALO_LOCAL_RX
0110 C | o Fill the halo region of a tile-local array assuming
0111 C | disconnected tiles with locally periodic subdomain
0112 C *==========================================================*
0113
0114 C !USES:
0115 IMPLICIT NONE
0116
0117 C == Global variables ==
0118 #include "SIZE.h"
0119 #include "EEPARAMS.h"
0120
0121 C !INPUT/OUTPUT PARAMETERS:
0122 C == Routine arguments ==
0123 C locFld :: field local-array with edges to fill.
0124 C myOLw,myOLe :: West and East overlap region sizes.
0125 C myOLs,myOLn :: South and North overlap region sizes.
0126 C myNr :: field local-array 3rd dimension
0127 C exchWidthX :: Width of data region exchanged in X.
0128 C exchWidthY :: Width of data region exchanged in Y.
0129 C cornerMode :: Flag indicating whether corner updates are needed.
0130 C myThid :: my Thread Id number
0131 C bi, bj :: tile indices
0132 C myThid :: thread number
0133 INTEGER myOLw, myOLe, myOLs, myOLn, myNr
0134 _RX locFld( 1-myOLw:sNx+myOLe, 1-myOLs:sNy+myOLn, myNr )
0135 c INTEGER exchWidthX, exchWidthY
0136 INTEGER cornerMode
0137 INTEGER bi, bj
0138 INTEGER myThid
0139
0140 #ifdef DISCONNECTED_TILES
0141 C !LOCAL VARIABLES:
0142 C == Local variables ==
0143 C i,j,k :: loop indices
0144 INTEGER i,j,k
0145 INTEGER iMin,iMax,jMin,jMax
0146 CEOP
0147
0148 IF ( cornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0149 iMin = 1 - myOLw
0150 iMax = sNx + myOLe
0151 jMin = 1 - myOLs
0152 jMax = sNy + myOLn
0153 ELSE
0154 iMin = 1
0155 iMax = sNx
0156 jMin = 1
0157 jMax = sNy
0158 ENDIF
0159
0160 C-- Fill Edges in X direction :
0161 IF ( sNx.EQ.1 ) THEN
0162 C- Special case for Y-slice domain i.e. case where sNx=1 (faster than below)
0163 DO k = 1,myNr
0164 DO j = jMin,jMax
0165 DO i = 1-myOLw,sNx+myOLe
0166 locFld(i,j,k) = locFld(1,j,k)
0167 ENDDO
0168 ENDDO
0169 ENDDO
0170 ELSEIF ( sNx.LT.myOLw ) THEN
0171 C- Special case if sNx<myOLw, e.g., for Y-slice domain case where sNx = 1
0172 DO k = 1,myNr
0173 DO j = jMin,jMax
0174 C reverse loop index increment to stay valid even if sNx<myOLw;
0175 C note: cannot vectorize both i loops
0176 DO i = 0,1-myOLw,-1
0177 locFld(i,j,k) = locFld(i+sNx,j,k)
0178 ENDDO
0179 DO i = 1,myOLe
0180 locFld(i+sNx,j,k) = locFld(i,j,k)
0181 ENDDO
0182 ENDDO
0183 ENDDO
0184 ELSE
0185 DO k = 1,myNr
0186 DO j = jMin,jMax
0187 DO i = 1-myOLw,0
0188 locFld(i,j,k) = locFld(i+sNx,j,k)
0189 ENDDO
0190 DO i = 1,myOLe
0191 locFld(i+sNx,j,k) = locFld(i,j,k)
0192 ENDDO
0193 ENDDO
0194 ENDDO
0195 ENDIF
0196
0197 C-- Fill Edges in Y direction :
0198 IF ( sNy.EQ.1 ) THEN
0199 C- Special case for X-slice domain i.e. case where sNy=1 (faster than below)
0200 DO k = 1,myNr
0201 DO j = 1-myOLs,sNy+myOLn
0202 DO i = iMin,iMax
0203 locFld(i,j,k) = locFld(i,1,k)
0204 ENDDO
0205 ENDDO
0206 ENDDO
0207 ELSEIF ( sNy.LT.myOLs ) THEN
0208 C- Special case if sNy<myOLs, e.g., for X-slice domain case where sNy = 1
0209 DO k = 1,myNr
0210 C reverse loop index increment to stay valid even if sNy<myOLs;
0211 C note: cannot vectorize both j loops
0212 DO j = 0,1-myOLs,-1
0213 DO i = iMin,iMax
0214 locFld(i,j,k) = locFld(i,j+sNy,k)
0215 ENDDO
0216 ENDDO
0217 DO j = 1,myOLn
0218 DO i = iMin,iMax
0219 locFld(i,j+sNy,k) = locFld(i,j,k)
0220 ENDDO
0221 ENDDO
0222 ENDDO
0223 ELSE
0224 DO k = 1,myNr
0225 DO j = 1-myOLs,0
0226 DO i = iMin,iMax
0227 locFld(i,j,k) = locFld(i,j+sNy,k)
0228 ENDDO
0229 ENDDO
0230 DO j = 1,myOLn
0231 DO i = iMin,iMax
0232 locFld(i,j+sNy,k) = locFld(i,j,k)
0233 ENDDO
0234 ENDDO
0235 ENDDO
0236 ENDIF
0237
0238 #else /* DISCONNECTED_TILES */
0239 STOP 'ABNORMAL END: S/R FILL_HALO_LOCAL_RX is empty'
0240 #endif /* DISCONNECTED_TILES */
0241
0242 RETURN
0243 END
