pkg/exch2/w2_set_map_tiles.F

017b6b2289 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002 #include "W2_OPTIONS.h"
                0003
d6ea3164dc Jean*0004 C--  File w2_set_map_tiles.F:
                0005 C--   Contents
                0006 C--   o W2_SET_MAP_TILES :: Set tiles and IO mapping
                0007 C--   o FIND_GCD_N       :: Returns the Greatest Common Divisor
                0008
017b6b2289 Jean*0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0010 CBOP 0
                0011 C !ROUTINE: W2_SET_MAP_TILES
                0012
                0013 C !INTERFACE:
                0014       SUBROUTINE W2_SET_MAP_TILES( myThid )
                0015
                0016 C     !DESCRIPTION:
                0017 C     Set-up tiles mapping and IO global mapping
                0018
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021
d6ea3164dc Jean*0022 C      Tile topology settings data structures
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 C     !INPUT PARAMETERS:
                0030 C     myThid  :: my Thread Id number
                0031 C               (Note: not relevant since threading has not yet started)
                0032       INTEGER myThid
                0033
                0034 C     !FUNCTIONS:
                0035       INTEGER  FIND_GCD_N
                0036       EXTERNAL FIND_GCD_N
                0037
                0038 C     !LOCAL VARIABLES:
                0039 C     === Local variables ===
d6ea3164dc Jean*0040 C     msgBuf     :: Informational/error message buffer
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 CEOP
                0049
                0050 C     Set-up tiles mapping and IO global mapping
                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 C--   Check that tile dims divide facet dims
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 C--   Check that domain size and (SIZE.h + blankList) match:
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 C--   Compact IO map (mostly in Y dir): search for Greatest Common Divisor
                0104 C     of all x-size (faster to apply GCD to Nb of Tiles in X):
4ea36d6fa6 Jean*0105         k = 0
                0106         nnx(1) = 0
017b6b2289 Jean*0107         DO j=1,nFacets
4ea36d6fa6 Jean*0108 C     skip empty facet
                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 C--   Global Map size:
1dea4b2a51 Oliv*0122 C     facets stacked in x direction
                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 C     facets stacked in y direction
                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 C--   Set tiles mapping within facet (sub-domain) and within Global Map
                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 c       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0167         DO ty=1,nbTy
                0168          DO tx=1,nbTx
                0169           tId = tId + 1
                0170 C--   Tags blank tile by removing facet # (exch2_myFace) but keeps its location
                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 C--   Global IO Mappings
                0183 C       these are for OBCS (vertical slices)
                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 C       and these for global files (3d files/horizontal 2d files)
017b6b2289 Jean*0189           IF ( W2_mapIO.EQ.-1 ) THEN
                0190 C-        Old format
                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 C-        Compact format = 1 long line
                0195             ii = nbPts + exch2_tBasex(tId) + exch2_tBasey(tId)*fNx
                0196             exch2_txGlobalo( tId ) = 1 + ii
                0197             exch2_tyGlobalo( tId ) = 1
                0198           ELSE
                0199 C         Compact format: piled in the Y direction
                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 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0220 CBOP
                0221 C     !ROUTINE: FIND_GCD_N
                0222
                0223 C     !INTERFACE:
                0224       INTEGER FUNCTION FIND_GCD_N( fldList, nFld )
                0225
                0226 C     !DESCRIPTION:
                0227 C     *==========================================================*
                0228 C     | FUNCTION FIND_GCD_N
                0229 C     | o Find the Greatest Common Divisor of N integers
                0230 C     *==========================================================*
                0231
                0232 C     !USES:
                0233       IMPLICIT NONE
                0234
                0235 C     !INPUT PARAMETERS:
                0236 C     fldList :: list of integers to search for GCD
                0237 C     nFLd    :: length of the input integer list.
                0238       INTEGER nFLd
                0239       INTEGER fldList(nFld)
                0240
                0241 C     !LOCAL VARIABLES:
d6ea3164dc Jean*0242       INTEGER mnFld, divide
017b6b2289 Jean*0243       INTEGER j, ii
                0244       LOGICAL flag
                0245       LOGICAL localDBg
                0246 CEOP
                0247       PARAMETER ( localDBg = .FALSE. )
                0248 c     PARAMETER ( localDBg = .TRUE. )
                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 C-    Put back the original Nb:
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