File indexing completed on 2020-07-29 05:11:13 UTC
view on githubraw file Latest commit b9dadda2 on 2020-07-28 16:49:33 UTC
017b6b2289 Jean*0001 #include "CPP_EEOPTIONS.h"
0002 #include "W2_OPTIONS.h"
0003
d6ea3164dc Jean*0004
0005
0006
0007
0008
017b6b2289 Jean*0009
0010
0011
0012
0013
0014 SUBROUTINE W2_SET_MAP_TILES( myThid )
0015
0016
0017
0018
0019
0020 IMPLICIT NONE
0021
d6ea3164dc Jean*0022
017b6b2289 Jean*0023 #include "SIZE.h"
0024 #include "EEPARAMS.h"
0025 #include "W2_EXCH2_SIZE.h"
0026 #include "W2_EXCH2_PARAMS.h"
0027 #include "W2_EXCH2_TOPOLOGY.h"
0028
0029
0030
0031
0032 INTEGER myThid
0033
0034
0035 INTEGER FIND_GCD_N
0036 EXTERNAL FIND_GCD_N
0037
0038
0039
d6ea3164dc Jean*0040
017b6b2289 Jean*0041 CHARACTER*(MAX_LEN_MBUF) msgBuf
1dea4b2a51 Oliv*0042 INTEGER tNx, tNy, fNx, fNy, nbPts, fBaseX, fBaseY
017b6b2289 Jean*0043 INTEGER nbTx, nbTy
0044 INTEGER j, ii, k, tId, tx, ty
d6ea3164dc Jean*0045 INTEGER divide, nnx(W2_maxNbFacets)
017b6b2289 Jean*0046 INTEGER errCnt, tCnt
c5952dcb3d Jean*0047 LOGICAL tileIsActive, prtFlag
017b6b2289 Jean*0048
0049
0050
0051 WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:',
0052 & ' tile mapping within facet and global Map:'
0053 CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
0054 prtFlag = ABS(W2_printMsg).GE.2
0055 & .OR. ( W2_printMsg .NE.0 .AND. myProcId.EQ.0 )
0056
0057 tNx = sNx
0058 tNy = sNy
d6ea3164dc Jean*0059
017b6b2289 Jean*0060 errCnt = 0
0061 tCnt = 0
0062 nbPts = 0
0063 DO j=1,nFacets
0064 fNx = facet_dims(2*j-1)
0065 fNy = facet_dims( 2*j )
0066 nbTx = fNx/tNx
0067 nbTy = fNy/tNy
0068 IF ( nbTx*tNx .NE. fNx ) THEN
0069 WRITE(msgBuf,'(A,I3,2(A,I7))') 'Facet',j,
0070 & ' : X-size=', fNx, ' not multiple of sNx=', tNx
0071 CALL PRINT_ERROR( msgBuf, myThid )
0072 errCnt = errCnt + 1
0073 ENDIF
0074 IF ( nbTy*tNy .NE. fNy ) THEN
0075 WRITE(msgBuf,'(A,I3,2(A,I7))') 'Facet',j,
0076 & ' : Y-size=', fNy, ' not multiple of sNy=', tNy
0077 CALL PRINT_ERROR( msgBuf, myThid )
0078 errCnt = errCnt + 1
0079 ENDIF
0080 facet_owns(1,j) = tCnt+1
0081 tCnt = tCnt + nbTx*nbTy
0082 facet_owns(2,j) = tCnt
0083 nbPts = nbPts + fNx*fNy
0084 ENDDO
0085 IF ( errCnt.GT.0 ) THEN
0086 WRITE(msgBuf,'(A,I3,A)')
0087 & ' W2_SET_MAP_TILES: found', errCnt, ' Fatal errors'
0088 CALL PRINT_ERROR( msgBuf, myThid )
0089 STOP 'ABNORMAL END: S/R W2_SET_MAP_TILES'
0090 ENDIF
0091
71f938ee99 Jean*0092 IF ( tCnt.NE.exch2_nTiles ) THEN
b9dadda204 Mart*0093 WRITE(msgBuf,'(A,I8,A)')
017b6b2289 Jean*0094 & 'W2_SET_MAP_TILES: Domain Total # of tiles =', tCnt, ' does'
0095 CALL PRINT_ERROR( msgBuf, myThid )
b9dadda204 Mart*0096 WRITE(msgBuf,'(A,I8)')
71f938ee99 Jean*0097 & 'W2_SET_MAP_TILES: not match (SIZE.h+blankList)=',exch2_nTiles
017b6b2289 Jean*0098 CALL PRINT_ERROR( msgBuf, myThid )
0099 STOP 'ABNORMAL END: S/R W2_SET_MAP_TILES'
0100 ENDIF
0101
0102 IF ( W2_mapIO.EQ.1 ) THEN
0103
0104
4ea36d6fa6 Jean*0105 k = 0
0106 nnx(1) = 0
017b6b2289 Jean*0107 DO j=1,nFacets
4ea36d6fa6 Jean*0108
0109 IF ( facet_dims(2*j-1).GT.0 ) THEN
0110 k = k + 1
0111 nnx(k) = facet_dims(2*j-1)/tNx
0112 ENDIF
017b6b2289 Jean*0113 ENDDO
4ea36d6fa6 Jean*0114 divide = FIND_GCD_N( nnx, k )
d6ea3164dc Jean*0115 W2_mapIO = divide*tNx
017b6b2289 Jean*0116 WRITE(msgBuf,'(A,2(I5,A))') ' W2_mapIO =', W2_mapIO,
d6ea3164dc Jean*0117 & ' (=', divide, '*sNx)'
017b6b2289 Jean*0118 CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
0119 ENDIF
0120
0121
1dea4b2a51 Oliv*0122
0123 exch2_xStack_Nx = 0
0124 exch2_xStack_Ny = 0
0125 DO j=1,nFacets
0126 exch2_xStack_Nx = exch2_xStack_Nx + facet_dims(2*j-1)
0127 exch2_xStack_Ny = MAX( exch2_xStack_Ny, facet_dims(2*j) )
0128 ENDDO
0129
0130 exch2_yStack_Nx = 0
0131 exch2_yStack_Ny = 0
0132 DO j=1,nFacets
0133 exch2_yStack_Nx = MAX( exch2_yStack_Nx, facet_dims(2*j-1) )
0134 exch2_yStack_Ny = exch2_yStack_Ny + facet_dims(2*j)
0135 ENDDO
017b6b2289 Jean*0136 IF ( W2_mapIO.EQ.-1 ) THEN
1dea4b2a51 Oliv*0137 exch2_global_Nx = exch2_xStack_Nx
0138 exch2_global_Ny = exch2_xStack_Ny
017b6b2289 Jean*0139 ELSEIF ( W2_mapIO.EQ.0 ) THEN
0140 exch2_global_Nx = nbPts
0141 exch2_global_Ny = 1
0142 ELSE
0143 exch2_global_Nx = W2_mapIO
0144 exch2_global_Ny = nbPts/W2_mapIO
0145 ENDIF
0146 WRITE(msgBuf,'(A,2(A,I8))') ' Global Map (IO):',
0147 & ' X-size=', exch2_global_Nx, ' , Y-size=', exch2_global_Ny
0148 CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
0149
0150
0151 WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:',
0152 & ' tile offset within facet and global Map:'
0153 CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
0154 tId = 0
0155 nbPts = 0
0156 fBaseX = 0
1dea4b2a51 Oliv*0157 fBaseY = 0
017b6b2289 Jean*0158 DO j=1,nFacets
0159 fNx = facet_dims(2*j-1)
0160 fNy = facet_dims( 2*j )
0161 nbTx = fNx/tNx
0162 nbTy = fNy/tNy
b9dadda204 Mart*0163 WRITE(W2_oUnit,'(A,I3,2(A,I6),A,I8,2(A,I4),A)')
017b6b2289 Jean*0164 & '- facet', j, ' : X-size=', fNx, ' , Y-size=', fNy,
0165 & ' ;', nbTx*nbTy, ' tiles (Tx,Ty=', nbTx,',',nbTy,')'
0166
0167 DO ty=1,nbTy
0168 DO tx=1,nbTx
0169 tId = tId + 1
0170
0171 tileIsActive = .TRUE.
0172 DO k=1,nBlankTiles
0173 IF ( blankList(k).EQ.tId ) tileIsActive = .FALSE.
0174 ENDDO
0175 IF ( tileIsActive ) exch2_myFace(tId) = j
0176 exch2_mydNx ( tId ) = fNx
0177 exch2_mydNy ( tId ) = fNy
0178 exch2_tNx ( tId ) = tNx
0179 exch2_tNy ( tId ) = tNy
0180 exch2_tBasex( tId ) = (tx-1)*tNx
0181 exch2_tBasey( tId ) = (ty-1)*tNy
1dea4b2a51 Oliv*0182
0183
0184 exch2_txXStackLo( tId ) = 1 + exch2_tBasex(tId) + fBaseX
0185 exch2_tyXStackLo( tId ) = 1 + exch2_tBasey(tId)
0186 exch2_txYStackLo( tId ) = 1 + exch2_tBasex(tId)
0187 exch2_tyYStackLo( tId ) = 1 + exch2_tBasey(tId) + fBaseY
0188
017b6b2289 Jean*0189 IF ( W2_mapIO.EQ.-1 ) THEN
0190
0191 exch2_txGlobalo( tId ) = 1 + exch2_tBasex(tId) + fBaseX
0192 exch2_tyGlobalo( tId ) = 1 + exch2_tBasey(tId)
0193 ELSEIF ( W2_mapIO.EQ.0 ) THEN
0194
0195 ii = nbPts + exch2_tBasex(tId) + exch2_tBasey(tId)*fNx
0196 exch2_txGlobalo( tId ) = 1 + ii
0197 exch2_tyGlobalo( tId ) = 1
0198 ELSE
0199
0200 ii = nbPts + exch2_tBasex(tId) + exch2_tBasey(tId)*fNx
0201 exch2_txGlobalo( tId ) = 1 + MOD(ii,W2_mapIO)
0202 exch2_tyGlobalo( tId ) = 1 + ii/W2_mapIO
0203 ENDIF
0204 IF ( prtFlag )
b9dadda204 Mart*0205 & WRITE(W2_oUnit,'(A,I8,3(A,I3),2A,2I5,2A,2I8)') ' tile',tId,
017b6b2289 Jean*0206 & ' on facet', exch2_myFace(tId),' (',tx,',',ty,'):',
0207 & ' offset=', exch2_tBasex(tId), exch2_tBasey(tId),' ;',
0208 & ' on Glob.Map=', exch2_txGlobalo(tId),exch2_tyGlobalo(tId)
0209 ENDDO
0210 ENDDO
0211 fBaseX = fBaseX + fNx
1dea4b2a51 Oliv*0212 fBaseY = fBaseY + fNy
017b6b2289 Jean*0213 nbPts = nbPts + fNx*fNy
0214 ENDDO
0215
0216 RETURN
0217 END
0218
0219
0220
0221
0222
0223
0224 INTEGER FUNCTION FIND_GCD_N( fldList, nFld )
0225
0226
0227
0228
0229
0230
0231
0232
0233 IMPLICIT NONE
0234
0235
0236
0237
0238 INTEGER nFLd
0239 INTEGER fldList(nFld)
0240
0241
d6ea3164dc Jean*0242 INTEGER mnFld, divide
017b6b2289 Jean*0243 INTEGER j, ii
0244 LOGICAL flag
0245 LOGICAL localDBg
0246
0247 PARAMETER ( localDBg = .FALSE. )
0248
0249
0250 mnFld = fldList(1)
0251 DO j=1,nFld
0252 mnFld = MIN( mnFld, fldList(j) )
0253 ENDDO
0254 IF (localDBg) WRITE(0,'(A,I8)') 'FIND_GCD_N: mnFld=',mnFld
0255
0256 IF (mnFld.GT.1 ) THEN
d6ea3164dc Jean*0257 divide = 1
017b6b2289 Jean*0258 ii = 2
0259 DO WHILE ( ii.LE.mnFld )
0260 IF (localDBg) WRITE(0,'(A,I8)') ' GCD : try',ii
0261 flag = .TRUE.
0262 DO j=1,nFld
0263 flag = flag.AND.(MOD(fldList(j),ii).EQ.0 )
0264 ENDDO
0265 IF ( flag ) THEN
d6ea3164dc Jean*0266 divide = divide*ii
017b6b2289 Jean*0267 DO j=1,nFld
0268 fldList(j) = fldList(j)/ii
0269 ENDDO
0270 IF (localDBg) WRITE(0,'(A,I8)')
0271 & 'FIND_GCD_N: com.fact=',ii
0272 mnFld = mnFld/ii
0273 ELSE
0274 ii = ii+2
0275 IF (ii.EQ.4) ii=3
0276 ENDIF
0277 ENDDO
d6ea3164dc Jean*0278
017b6b2289 Jean*0279 IF (localDBg) WRITE(0,'(10I8)') (fldList(j),j=1,nFld)
0280 DO j=1,nFld
d6ea3164dc Jean*0281 fldList(j) = fldList(j)*divide
017b6b2289 Jean*0282 ENDDO
0283 ELSE
d6ea3164dc Jean*0284 divide = MAX( 0, mnFld )
017b6b2289 Jean*0285 ENDIF
0286
d6ea3164dc Jean*0287 FIND_GCD_N = divide
017b6b2289 Jean*0288
0289 RETURN
0290 END