File indexing completed on 2020-07-29 05:11:12 UTC
view on githubraw file Latest commit b9dadda2 on 2020-07-28 16:49:33 UTC
017b6b2289 Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003 #include "W2_OPTIONS.h"
ef53b829d7 Jean*0004
017b6b2289 Jean*0005
0006
0007
046fd16d1c Andr*0008
017b6b2289 Jean*0009
0010 SUBROUTINE W2_E2SETUP( myThid )
046fd16d1c Andr*0011
017b6b2289 Jean*0012
0013
046fd16d1c Andr*0014
017b6b2289 Jean*0015
0016 IMPLICIT NONE
ef53b829d7 Jean*0017
d6ea3164dc Jean*0018
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
0028
0029
0030 INTEGER myThid
0031
0032 #ifdef ALLOW_EXCH2
0033
0034
0035
d6ea3164dc Jean*0036
017b6b2289 Jean*0037
0038 CHARACTER*(MAX_LEN_MBUF) msgBuf
c5952dcb3d Jean*0039 INTEGER stdUnit
017b6b2289 Jean*0040 INTEGER i, j, k
0041 LOGICAL addBlank
0042
0043
0044 stdUnit = standardMessageUnit
0045
0046
0047
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
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
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
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
0135 CALL W2_SET_F2F_INDEX( myThid )
0136
0137
0138 CALL W2_SET_MAP_TILES( myThid )
0139
71f938ee99 Jean*0140
0141 CALL W2_SET_MAP_CUMSUM( myThid )
0142
017b6b2289 Jean*0143
0144 CALL W2_SET_TILE2TILES( myThid )
0145
0146 #endif /* ALLOW_EXCH2 */
0147
0148 RETURN
0149 END