C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_set_map_tiles.F,v 1.6 2012/07/16 20:25:10 jmc Exp $ C $Name: $ #include "CPP_EEOPTIONS.h" #include "W2_OPTIONS.h" C-- File w2_set_map_tiles.F: C-- Contents C-- o W2_SET_MAP_TILES :: Set tiles and IO mapping C-- o FIND_GCD_N :: Returns the Greatest Common Divisor C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 0 C !ROUTINE: W2_SET_MAP_TILES C !INTERFACE: SUBROUTINE W2_SET_MAP_TILES( myThid ) C !DESCRIPTION: C Set-up tiles mapping and IO global mapping C !USES: IMPLICIT NONE C Tile topology settings data structures #include "SIZE.h" #include "EEPARAMS.h" #include "W2_EXCH2_SIZE.h" #include "W2_EXCH2_PARAMS.h" #include "W2_EXCH2_TOPOLOGY.h" C !INPUT PARAMETERS: C myThid :: my Thread Id number C (Note: not relevant since threading has not yet started) INTEGER myThid C !FUNCTIONS: INTEGER FIND_GCD_N EXTERNAL C !LOCAL VARIABLES: C === Local variables === C msgBuf :: Informational/error message buffer CHARACTER*(MAX_LEN_MBUF) msgBuf INTEGER tNx, tNy, fNx, fNy, nbPts, fBaseX, fBaseY INTEGER nbTx, nbTy INTEGER j, ii, k, tId, tx, ty INTEGER divide, nnx(W2_maxNbFacets) INTEGER errCnt, tCnt LOGICAL tileIsActive, prtFlag CEOP C Set-up tiles mapping and IO global mapping WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:', & ' tile mapping within facet and global Map:' CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid ) prtFlag = ABS(W2_printMsg).GE.2 & .OR. ( W2_printMsg .NE.0 .AND. myProcId.EQ.0 ) tNx = sNx tNy = sNy C-- Check that tile dims divide facet dims errCnt = 0 tCnt = 0 nbPts = 0 DO j=1,nFacets fNx = facet_dims(2*j-1) fNy = facet_dims( 2*j ) nbTx = fNx/tNx nbTy = fNy/tNy IF ( nbTx*tNx .NE. fNx ) THEN WRITE(msgBuf,'(A,I3,2(A,I7))') 'Facet',j, & ' : X-size=', fNx, ' not multiple of sNx=', tNx CALL PRINT_ERROR( msgBuf, myThid ) errCnt = errCnt + 1 ENDIF IF ( nbTy*tNy .NE. fNy ) THEN WRITE(msgBuf,'(A,I3,2(A,I7))') 'Facet',j, & ' : Y-size=', fNy, ' not multiple of sNy=', tNy CALL PRINT_ERROR( msgBuf, myThid ) errCnt = errCnt + 1 ENDIF facet_owns(1,j) = tCnt+1 tCnt = tCnt + nbTx*nbTy facet_owns(2,j) = tCnt nbPts = nbPts + fNx*fNy ENDDO IF ( errCnt.GT.0 ) THEN WRITE(msgBuf,'(A,I3,A)') & ' W2_SET_MAP_TILES: found', errCnt, ' Fatal errors' CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R W2_SET_MAP_TILES' ENDIF C-- Check that domain size and (SIZE.h + blankList) match: IF ( tCnt.NE.exch2_nTiles ) THEN WRITE(msgBuf,'(A,I6,A)') & 'W2_SET_MAP_TILES: Domain Total # of tiles =', tCnt, ' does' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(A,I6)') & 'W2_SET_MAP_TILES: not match (SIZE.h+blankList)=',exch2_nTiles CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R W2_SET_MAP_TILES' ENDIF IF ( W2_mapIO.EQ.1 ) THEN C-- Compact IO map (mostly in Y dir): search for Greatest Common Divisor C of all x-size (faster to apply GCD to Nb of Tiles in X): k = 0 nnx(1) = 0 DO j=1,nFacets C skip empty facet IF ( facet_dims(2*j-1).GT.0 ) THEN k = k + 1 nnx(k) = facet_dims(2*j-1)/tNx ENDIF ENDDO divide = FIND_GCD_N( nnx, k ) W2_mapIO = divide*tNx WRITE(msgBuf,'(A,2(I5,A))') ' W2_mapIO =', W2_mapIO, & ' (=', divide, '*sNx)' CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid ) ENDIF C-- Global Map size: C facets stacked in x direction exch2_xStack_Nx = 0 exch2_xStack_Ny = 0 DO j=1,nFacets exch2_xStack_Nx = exch2_xStack_Nx + facet_dims(2*j-1) exch2_xStack_Ny = MAX( exch2_xStack_Ny, facet_dims(2*j) ) ENDDO C facets stacked in y direction exch2_yStack_Nx = 0 exch2_yStack_Ny = 0 DO j=1,nFacets exch2_yStack_Nx = MAX( exch2_yStack_Nx, facet_dims(2*j-1) ) exch2_yStack_Ny = exch2_yStack_Ny + facet_dims(2*j) ENDDO IF ( W2_mapIO.EQ.-1 ) THEN exch2_global_Nx = exch2_xStack_Nx exch2_global_Ny = exch2_xStack_Ny ELSEIF ( W2_mapIO.EQ.0 ) THEN exch2_global_Nx = nbPts exch2_global_Ny = 1 ELSE exch2_global_Nx = W2_mapIO exch2_global_Ny = nbPts/W2_mapIO ENDIF WRITE(msgBuf,'(A,2(A,I8))') ' Global Map (IO):', & ' X-size=', exch2_global_Nx, ' , Y-size=', exch2_global_Ny CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid ) C-- Set tiles mapping within facet (sub-domain) and within Global Map WRITE(msgBuf,'(2A)') 'W2_SET_MAP_TILES:', & ' tile offset within facet and global Map:' CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid ) tId = 0 nbPts = 0 fBaseX = 0 fBaseY = 0 DO j=1,nFacets fNx = facet_dims(2*j-1) fNy = facet_dims( 2*j ) nbTx = fNx/tNx nbTy = fNy/tNy WRITE(W2_oUnit,'(A,I3,2(A,I6),A,I5,2(A,I4),A)') & '- facet', j, ' : X-size=', fNx, ' , Y-size=', fNy, & ' ;', nbTx*nbTy, ' tiles (Tx,Ty=', nbTx,',',nbTy,')' c CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid ) DO ty=1,nbTy DO tx=1,nbTx tId = tId + 1 C-- Tags blank tile by removing facet # (exch2_myFace) but keeps its location tileIsActive = .TRUE. DO k=1,nBlankTiles IF ( blankList(k).EQ.tId ) tileIsActive = .FALSE. ENDDO IF ( tileIsActive ) exch2_myFace(tId) = j exch2_mydNx ( tId ) = fNx exch2_mydNy ( tId ) = fNy exch2_tNx ( tId ) = tNx exch2_tNy ( tId ) = tNy exch2_tBasex( tId ) = (tx-1)*tNx exch2_tBasey( tId ) = (ty-1)*tNy C-- Global IO Mappings C these are for OBCS (vertical slices) exch2_txXStackLo( tId ) = 1 + exch2_tBasex(tId) + fBaseX exch2_tyXStackLo( tId ) = 1 + exch2_tBasey(tId) exch2_txYStackLo( tId ) = 1 + exch2_tBasex(tId) exch2_tyYStackLo( tId ) = 1 + exch2_tBasey(tId) + fBaseY C and these for global files (3d files/horizontal 2d files) IF ( W2_mapIO.EQ.-1 ) THEN C- Old format exch2_txGlobalo( tId ) = 1 + exch2_tBasex(tId) + fBaseX exch2_tyGlobalo( tId ) = 1 + exch2_tBasey(tId) ELSEIF ( W2_mapIO.EQ.0 ) THEN C- Compact format = 1 long line ii = nbPts + exch2_tBasex(tId) + exch2_tBasey(tId)*fNx exch2_txGlobalo( tId ) = 1 + ii exch2_tyGlobalo( tId ) = 1 ELSE C Compact format: piled in the Y direction ii = nbPts + exch2_tBasex(tId) + exch2_tBasey(tId)*fNx exch2_txGlobalo( tId ) = 1 + MOD(ii,W2_mapIO) exch2_tyGlobalo( tId ) = 1 + ii/W2_mapIO ENDIF IF ( prtFlag ) & WRITE(W2_oUnit,'(A,I5,3(A,I3),2A,2I5,2A,2I8)') ' tile',tId, & ' on facet', exch2_myFace(tId),' (',tx,',',ty,'):', & ' offset=', exch2_tBasex(tId), exch2_tBasey(tId),' ;', & ' on Glob.Map=', exch2_txGlobalo(tId),exch2_tyGlobalo(tId) ENDDO ENDDO fBaseX = fBaseX + fNx fBaseY = fBaseY + fNy nbPts = nbPts + fNx*fNy ENDDO RETURN END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: FIND_GCD_N C !INTERFACE: INTEGER FUNCTION FIND_GCD_N( fldList, nFld ) C !DESCRIPTION: C *==========================================================* C | FUNCTION FIND_GCD_N C | o Find the Greatest Common Divisor of N integers C *==========================================================* C !USES: IMPLICIT NONE C !INPUT PARAMETERS: C fldList :: list of integers to search for GCD C nFLd :: length of the input integer list. INTEGER nFLd INTEGER fldList(nFld) C !LOCAL VARIABLES: INTEGER mnFld, divide INTEGER j, ii LOGICAL flag LOGICAL localDBg CEOP PARAMETER ( localDBg = .FALSE. ) c PARAMETER ( localDBg = .TRUE. ) mnFld = fldList(1) DO j=1,nFld mnFld = MIN( mnFld, fldList(j) ) ENDDO IF (localDBg) WRITE(0,'(A,I8)') 'FIND_GCD_N: mnFld=',mnFld IF (mnFld.GT.1 ) THEN divide = 1 ii = 2 DO WHILE ( ii.LE.mnFld ) IF (localDBg) WRITE(0,'(A,I8)') ' GCD : try',ii flag = .TRUE. DO j=1,nFld flag = flag.AND.(MOD(fldList(j),ii).EQ.0 ) ENDDO IF ( flag ) THEN divide = divide*ii DO j=1,nFld fldList(j) = fldList(j)/ii ENDDO IF (localDBg) WRITE(0,'(A,I8)') & 'FIND_GCD_N: com.fact=',ii mnFld = mnFld/ii ELSE ii = ii+2 IF (ii.EQ.4) ii=3 ENDIF ENDDO C- Put back the original Nb: IF (localDBg) WRITE(0,'(10I8)') (fldList(j),j=1,nFld) DO j=1,nFld fldList(j) = fldList(j)*divide ENDDO ELSE divide = MAX( 0, mnFld ) ENDIF FIND_GCD_N = divide RETURN END