pkg/exch2/w2_e2setup.F

017b6b2289 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_EEOPTIONS.h"
                0003 #include "W2_OPTIONS.h"
ef53b829d7 Jean*0004
017b6b2289 Jean*0005 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0006 CBOP 0
                0007 C !ROUTINE: W2_E2SETUP
046fd16d1c Andr*0008
017b6b2289 Jean*0009 C !INTERFACE:
                0010       SUBROUTINE W2_E2SETUP( myThid )
046fd16d1c Andr*0011
017b6b2289 Jean*0012 C     !DESCRIPTION:
                0013 C     Set-up W2_EXCH2 tile topology structures
046fd16d1c Andr*0014
017b6b2289 Jean*0015 C     !USES:
                0016       IMPLICIT NONE
ef53b829d7 Jean*0017
d6ea3164dc Jean*0018 C      Tile topology settings data structures
017b6b2289 Jean*0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #ifdef ALLOW_EXCH2
                0022 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0023 #include "W2_EXCH2_TOPOLOGY.h"
017b6b2289 Jean*0024 #include "W2_EXCH2_PARAMS.h"
                0025 #endif
                0026
                0027 C     !INPUT PARAMETERS:
                0028 C     myThid  :: my Thread Id number
                0029 C               (Note: not relevant since threading has not yet started)
                0030       INTEGER myThid
                0031
                0032 #ifdef ALLOW_EXCH2
                0033
                0034 C     !LOCAL VARIABLES:
                0035 C     === Local variables ===
d6ea3164dc Jean*0036 C     msgBuf     :: Informational/error message buffer
017b6b2289 Jean*0037 C     stdUnit    :: Standard-Output IO unit number
                0038       CHARACTER*(MAX_LEN_MBUF) msgBuf
c5952dcb3d Jean*0039       INTEGER stdUnit
017b6b2289 Jean*0040       INTEGER i, j, k
                0041       LOGICAL addBlank
                0042 CEOP
                0043
                0044       stdUnit = standardMessageUnit
                0045
                0046 C--   Initialise parameters from EXCH2_PARAMS common blocks
                0047 C     (except params from namelist which are set in W2_READPARMS)
                0048       DO j=1,W2_maxNbFacets
                0049         facet_owns(1,j) = 0
                0050         facet_owns(2,j) = 0
                0051         DO i=1,4
                0052          DO k=1,4
                0053           facet_pij(k,i,j) = 0
                0054          ENDDO
                0055           facet_oi(i,j) = 0
                0056           facet_oj(i,j) = 0
                0057         ENDDO
                0058       ENDDO
                0059
                0060 C--   Count Nb of Blank-Tiles and set Number of tiles:
                0061       nBlankTiles = 0
                0062       DO i=1,W2_maxNbTiles
                0063        IF (blankList(i).NE.0 ) THEN
                0064          addBlank = .TRUE.
                0065          DO j=1,nBlankTiles
                0066           IF ( blankList(i).EQ.blankList(j) ) THEN
                0067            addBlank = .FALSE.
b9dadda204 Mart*0068            WRITE(msgBuf,'(A,I8,A,2I8,A)')
017b6b2289 Jean*0069      &     '** WARNING ** W2_E2SETUP: #', blankList(i),
                0070      &     ' appears several times in blankList (',j,i,')'
                0071            CALL PRINT_MESSAGE( msgBuf, W2_oUnit,SQUEEZE_RIGHT,myThid )
                0072            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0073      &                         SQUEEZE_RIGHT, myThid )
                0074           ENDIF
                0075          ENDDO
                0076          IF ( addBlank ) THEN
                0077            nBlankTiles = nBlankTiles + 1
                0078            blankList(nBlankTiles) = blankList(i)
                0079          ENDIF
                0080        ENDIF
                0081       ENDDO
71f938ee99 Jean*0082       exch2_nTiles = nBlankTiles + (nSx*nSy*nPx*nPy)
017b6b2289 Jean*0083
                0084       WRITE(msgBuf,'(A,I8)')
                0085      &    'W2_E2SETUP: number of Active Tiles =', nSx*nSy*nPx*nPy
                0086       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0087       WRITE(msgBuf,'(A,I8)')
                0088      &    'W2_E2SETUP: number of Blank Tiles  =', nBlankTiles
                0089       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0090       WRITE(msgBuf,'(A,I8)')
71f938ee99 Jean*0091      &    'W2_E2SETUP: Total number of Tiles  =', exch2_nTiles
017b6b2289 Jean*0092       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0093
71f938ee99 Jean*0094       IF ( exch2_nTiles.GT.W2_maxNbTiles ) THEN
b9dadda204 Mart*0095         WRITE(msgBuf,'(3(A,I8))') 'W2_E2SETUP: Number of Tiles=',
71f938ee99 Jean*0096      &             exch2_nTiles, ' >', W2_maxNbTiles, ' =W2_maxNbTiles'
017b6b2289 Jean*0097         CALL PRINT_ERROR( msgBuf, myThid )
                0098         WRITE(msgBuf,'(2A)') 'Must increase "W2_maxNbTiles"',
                0099      &                       ' in "W2_EXCH2_SIZE.h" + recompile'
                0100         CALL PRINT_ERROR( msgBuf, myThid )
                0101         STOP 'ABNORMAL END: S/R W2_E2SETUP (nTiles>maxNbTiles)'
                0102       ENDIF
                0103
                0104 C--   Check blankList:
                0105       DO i=1,nBlankTiles
71f938ee99 Jean*0106        IF ( blankList(i).LT.1 .OR. blankList(i).GT.exch2_nTiles ) THEN
b9dadda204 Mart*0107          WRITE(msgBuf,'(A,I8,A,I8)')
017b6b2289 Jean*0108      &     'W2_E2SETUP: Invalid blankTile number (i=', i,
                0109      &     ' )=', blankList(i)
b9dadda204 Mart*0110          WRITE(msgBuf,'(A,I8,A,I8,A)') 'W2_E2SETUP:', blankList(i),
017b6b2289 Jean*0111      &                    ' = Invalid blankTile number (i=', i, ')'
                0112          CALL PRINT_ERROR( msgBuf, myThid )
                0113          STOP 'ABNORMAL END: S/R W2_E2SETUP (blankList error)'
                0114        ENDIF
                0115       ENDDO
                0116
                0117 C--   Define Facet (sub-domain) Topology: Size and Connections
                0118       IF     ( preDefTopol.EQ.0 ) THEN
                0119         CALL W2_SET_GEN_FACETS( myThid )
                0120       ELSEIF ( preDefTopol.EQ.1 ) THEN
                0121         CALL W2_SET_SINGLE_FACET( myThid )
                0122       ELSEIF ( preDefTopol.EQ.2 ) THEN
                0123         CALL W2_SET_MYOWN_FACETS( myThid )
                0124       ELSEIF ( preDefTopol.EQ.3 ) THEN
                0125         CALL W2_SET_CS6_FACETS( myThid )
                0126       ELSE
                0127         STOP 'ABNORMAL END: S/R W2_E2SETUP (invalid preDefTopol)'
                0128       ENDIF
                0129
                0130       WRITE(msgBuf,'(A,I8)')
                0131      &    'W2_E2SETUP: Total number of Facets =', nFacets
                0132       CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_RIGHT, myThid )
                0133
                0134 C--   Check Topology; setup correspondence matrix for connected Facet-Edges
                0135       CALL W2_SET_F2F_INDEX( myThid )
                0136
                0137 C--   Define Tile Mapping (+ IO global mapping)
                0138       CALL W2_SET_MAP_TILES( myThid )
                0139
71f938ee99 Jean*0140 C--   Define Tile Mapping (for Cumulated Sum)
                0141       CALL W2_SET_MAP_CUMSUM( myThid )
                0142
017b6b2289 Jean*0143 C--   Set-up tile neighbours and index relations for EXCH2
                0144       CALL W2_SET_TILE2TILES( myThid )
                0145
                0146 #endif /* ALLOW_EXCH2 */
                0147
                0148       RETURN
                0149       END