Warning, /eesupp/src/exch1_bg_rx_cube.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
ba0dad37f4 Jean*0001 #include "CPP_EEOPTIONS.h"
0002
0003 CBOP
0004
0005 C !ROUTINE: EXCH1_BG_RX_CUBE
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH1_BG_RX_CUBE(
0009 U uField, vField,
0010 I withSigns,
0011 I myOLw, myOLe, myOLs, myOLn, myNz,
0012 I exchWidthX, exchWidthY,
0013 I cornerMode, myThid )
0014
0015 C !DESCRIPTION:
0016 C *==========================================================*
0017 C | SUBROUTINE EXCH1_BG_RX_CUBE
0018 C | o Forward-mode edge exchanges for RX vector on CS config:
0019 C | Fill overlap region through tile exchanges,
0020 C | according to CS topology,
0021 C | for a 2-Components B-Grid vector field RX arrays.
0022 C *==========================================================*
0023 C | Proceeds in 2 steps :
0024 C | 1) fill the edges to get valid fields over (1:sNx+1,1:sNy+1)
0025 C | 2) fill in overlap region:
0026 C | (1-Olx:0 & sNx+2:sNx+Olx) x (1-Oly:0 & sNy+2:sNy+Oly)
0027 C | Only works: a) with exactly 6 tiles (1 per face)
0028 C | b) no MPI
0029 C | c) thread shared arrays (in common block)
0030 C *==========================================================*
0031
0032 C !USES:
0033 IMPLICIT NONE
0034
0035 C == Global data ==
0036 #include "SIZE.h"
0037 #include "EEPARAMS.h"
0038
0039 C !INPUT/OUTPUT PARAMETERS:
0040 C == Routine arguments ==
0041 C uField :: 1rst component array with overlap to exchange.
0042 C vField :: 2nd component array with overlap to exchange.
0043 C withSigns :: sign of uField,vField depends on orientation.
0044 C myOLw,myOLe :: West and East overlap region sizes.
0045 C myOLs,myOLn :: South and North overlap region sizes.
0046 C exchWidthX :: Width of data region exchanged in X.
0047 C exchWidthY :: Width of data region exchanged in Y.
0048 C Note --
0049 C 1. In theory one could have a send width and
0050 C a receive width for each face of each tile. The only
0051 C restriction would be that the send width of one
0052 C face should equal the receive width of the sent to
0053 C tile face. Dont know if this would be useful. I
0054 C have left it out for now as it requires additional
0055 C bookeeping.
0056 C cornerMode :: Flag indicating whether corner updates are needed.
0057 C myThid :: my Thread Id number
0058
0059 INTEGER myOLw, myOLe, myOLs, myOLn, myNz
0060 _RX uField( 1-myOLw:sNx+myOLe, 1-myOLs:sNy+myOLn,
0061 & myNz, nSx, nSy )
0062 _RX vField( 1-myOLw:sNx+myOLe, 1-myOLs:sNy+myOLn,
0063 & myNz, nSx, nSy )
0064 LOGICAL withSigns
0065 INTEGER exchWidthX
0066 INTEGER exchWidthY
0067 INTEGER cornerMode
0068 INTEGER myThid
0069
0070 C !LOCAL VARIABLES:
0071 C == Local variables ==
0072 C theSimulationMode :: Holds working copy of simulation mode
0073 C theCornerMode :: Holds working copy of corner mode
0074 C i,j,k,repeat :: Loop counters and index
0075 C bt,bn,bs,be,bw
0076 c INTEGER theSimulationMode
0077 c INTEGER theCornerMode
0078 INTEGER i,j,k
0079 INTEGER updateEdges, j1, j2, j3
0080 INTEGER bt,bn,bs,be,bw
0081 CHARACTER*(MAX_LEN_MBUF) msgBuf
0082 _RX negOne
0083
0084 C == Statement function ==
0085 INTEGER tilemod
0086 tilemod(i)=1+mod(i-1+6,6)
0087 CEOP
0088
0089 c theSimulationMode = FORWARD_SIMULATION
0090 c theCornerMode = cornerMode
0091
0092 c IF ( simulationMode.EQ.REVERSE_SIMULATION ) THEN
0093 c WRITE(msgBuf,'(A)')'EXCH1_BG_RX_CUBE: AD mode not implemented'
0094 c CALL PRINT_ERROR( msgBuf, myThid )
0095 c STOP 'ABNORMAL END: EXCH1_BG_RX_CUBE: no AD code'
0096 c ENDIF
0097 IF ( sNx.NE.sNy .OR.
0098 & nSx.NE.6 .OR. nSy.NE.1 .OR.
0099 & nPx.NE.1 .OR. nPy.NE.1 ) THEN
0100 WRITE(msgBuf,'(2A)') 'EXCH1_BG_RX_CUBE: Wrong Tiling'
0101 CALL PRINT_ERROR( msgBuf, myThid )
0102 WRITE(msgBuf,'(2A)') 'EXCH1_BG_RX_CUBE: ',
0103 & 'works only with sNx=sNy & nSx=6 & nSy=nPx=nPy=1'
0104 CALL PRINT_ERROR( msgBuf, myThid )
0105 STOP 'ABNORMAL END: EXCH1_BG_RX_CUBE: Wrong Tiling'
0106 ENDIF
0107
0108 C-- Could by-pass 1rst step (with updateEdges= 0) if vector field is
0109 C valid over (1:sNx+1,1:sNy+1); In general this should be the case
0110 C for correct computation domain; but some exceptions ? + I/O problems
0111 C-- Exch of 2-Components vector (assumed to be 90.deg apart) at corner
0112 C point is ill defined since we have 3 axes @ 120.deg apart.
0113 C go with 3 options :
0114 C updateEdges = 1 : do not touch corner values ;
0115 C updateEdges = 2 : copy from corresponding face S.W corner (<= clear owner)
0116 C and do nothing for missing corners ;
0117 C updateEdges = 3 : copy all corner values.
0118 C------
0119 updateEdges = 2
0120 IF ( withSigns ) updateEdges = MIN(1,updateEdges)
0121
0122 negOne = 1.
0123 IF (withSigns) negOne = -1.
0124
0125 C For now tile<->tile exchanges are sequentialised through
0126 C thread 1. This is a temporary feature for preliminary testing until
0127 C general tile decomposistion is in place (CNH April 11, 2001)
0128 CALL BAR2( myThid )
0129 _BEGIN_MASTER( myThid )
0130
0131 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0132
0133 IF ( updateEdges.GT.0 ) THEN
0134 C-- 1rst Step : Just fill-in North (j=sNy+1) & East (i=sNx+1) edges
0135
0136 j1 = 2
0137 j2 = 2
0138 j3 = sNy
0139 IF ( updateEdges.GE.2 ) THEN
0140 j1 = 1
0141 j3 = sNy+1
0142 ENDIF
0143 IF ( updateEdges.EQ.3 ) j2 = 1
0144
0145 DO bt = 1,nSx
0146 IF ( MOD(bt,2).EQ.1 ) THEN
0147 C Odd face Number:
0148
0149 bn=tilemod(bt+2)
0150 bs=tilemod(bt-1)
0151 be=tilemod(bt+1)
0152 bw=tilemod(bt-2)
0153
0154 i = 1
0155 DO k = 1, myNz
0156 C Tile Odd:Odd+2 [get] [North<-West]
0157 DO j = j2, j3
0158 uField(j,sNy+i,k,bt,1) = vField(i,sNy+2-j,k,bn,1)*negOne
0159 vField(j,sNy+i,k,bt,1) = uField(i,sNy+2-j,k,bn,1)
0160 ENDDO
0161 C Tile Odd:Odd+1 [get] [East<-West]
0162 DO j = j1, sNy
0163 uField(sNx+i,j,k,bt,1) = uField(i,j,k,be,1)
0164 vField(sNx+i,j,k,bt,1) = vField(i,j,k,be,1)
0165 ENDDO
0166 ENDDO
0167
0168 ELSE
0169 C Even face Number:
0170
0171 bn=tilemod(bt+1)
0172 bs=tilemod(bt-2)
0173 be=tilemod(bt+2)
0174 bw=tilemod(bt-1)
0175
0176 i = 1
0177 DO k = 1, myNz
0178 C Tile Even:Even+1 [get] [North<-South]
0179 DO j = j1, sNy
0180 uField(j,sNy+i,k,bt,1) = uField(j,i,k,bn,1)
0181 vField(j,sNy+i,k,bt,1) = vField(j,i,k,bn,1)
0182 ENDDO
0183 C Tile Even:Even+2 [get] [East<-South]
0184 DO j = j2, j3
0185 uField(sNx+i,j,k,bt,1) = vField(sNx+2-j,i,k,be,1)
0186 vField(sNx+i,j,k,bt,1) = uField(sNx+2-j,i,k,be,1)*negOne
0187 ENDDO
0188 ENDDO
0189
0190 C-- end odd/even face number
0191 ENDIF
0192 C-- end loop on tile index bt
0193 ENDDO
0194
0195 C-- End of 1rst Step
0196 ENDIF
0197
0198 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0199
0200 C-- 2nd Step: fill-in (true) overlap regions:
0201
0202 DO bt = 1,nSx
0203 IF ( MOD(bt,2).EQ.1 ) THEN
0204 C Odd face Number:
0205
0206 bn=tilemod(bt+2)
0207 bs=tilemod(bt-1)
0208 be=tilemod(bt+1)
0209 bw=tilemod(bt-2)
0210
0211 DO k = 1, myNz
0212 DO j = 1, sNy+1
0213 DO i = 2, exchWidthX
0214
0215 C Tile Odd:Odd+2 [get] [North<-West]
0216 uField(j,sNy+i,k,bt,1) = vField(i,sNy+2-j,k,bn,1)*negOne
0217 vField(j,sNy+i,k,bt,1) = uField(i,sNy+2-j,k,bn,1)
0218 C Tile Odd:Odd+1 [get] [East<-West]
0219 uField(sNx+i,j,k,bt,1) = uField(i,j,k,be,1)
0220 vField(sNx+i,j,k,bt,1) = vField(i,j,k,be,1)
0221
0222 ENDDO
0223 DO i = 1-exchWidthX, 0
0224
0225 C Tile Odd:Odd-1 [get] [South<-North]
0226 uField(j,i,k,bt,1) = uField(j,sNy+i,k,bs,1)
0227 vField(j,i,k,bt,1) = vField(j,sNy+i,k,bs,1)
0228 C Tile Odd:Odd-2 [get] [West<-North]
0229 uField(i,j,k,bt,1) = vField(sNx+2-j,sNy+i,k,bw,1)
0230 vField(i,j,k,bt,1) = uField(sNx+2-j,sNy+i,k,bw,1)*negOne
0231
0232 ENDDO
0233 ENDDO
0234 ENDDO
0235
0236 ELSE
0237 C Even face Number:
0238
0239 bn=tilemod(bt+1)
0240 bs=tilemod(bt-2)
0241 be=tilemod(bt+2)
0242 bw=tilemod(bt-1)
0243
0244 DO k = 1, myNz
0245 DO j = 1, sNy+1
0246 DO i = 2, exchWidthX
0247
0248 C Tile Even:Even+2 [get] [East<-South]
0249 uField(sNx+i,j,k,bt,1) = vField(sNx+2-j,i,k,be,1)
0250 vField(sNx+i,j,k,bt,1) = uField(sNx+2-j,i,k,be,1)*negOne
0251 C Tile Even:Even+1 [get] [North<-South]
0252 uField(j,sNy+i,k,bt,1) = uField(j,i,k,bn,1)
0253 vField(j,sNy+i,k,bt,1) = vField(j,i,k,bn,1)
0254
0255 ENDDO
0256 DO i = 1-exchWidthX, 0
0257
0258 C Tile Even:Even-2 [get] [South<-East]
0259 uField(j,i,k,bt,1) = vField(sNx+i,sNy+2-j,k,bs,1)*negOne
0260 vField(j,i,k,bt,1) = uField(sNx+i,sNy+2-j,k,bs,1)
0261 C Tile Even:Even-1 [get] [West<-East]
0262 uField(i,j,k,bt,1) = uField(sNx+i,j,k,bw,1)
0263 vField(i,j,k,bt,1) = vField(sNx+i,j,k,bw,1)
0264
0265 ENDDO
0266 ENDDO
0267 ENDDO
0268
0269 C-- end odd/even face number
0270 ENDIF
0271 C-- end loop on tile index bt
0272 ENDDO
0273
0274 _END_MASTER( myThid )
0275 CALL BAR2(myThid)
0276
0277 RETURN
0278 END
