File indexing completed on 2018-03-02 18:36:46 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
11d11fd6da Jean*0001 #include "PACKAGES_CONFIG.h"
1dbaea09ee Chri*0002 #include "CPP_OPTIONS.h"
924557e60a Chri*0003
9366854e02 Chri*0004
0005
b6356366ca Ed H*0006
9366854e02 Chri*0007
924557e60a Chri*0008 SUBROUTINE INI_CORI( myThid )
b6356366ca Ed H*0009
dfef4f457e Jean*0010
924557e60a Chri*0011
9366854e02 Chri*0012
0013 IMPLICIT NONE
924557e60a Chri*0014 #include "SIZE.h"
0015 #include "EEPARAMS.h"
0016 #include "PARAMS.h"
dfef4f457e Jean*0017 #include "GRID.h"
33a3e71e59 Jean*0018 #ifdef ALLOW_EXCH2
1cc6effca6 Jean*0019 # include "W2_EXCH2_SIZE.h"
33a3e71e59 Jean*0020 # include "W2_EXCH2_TOPOLOGY.h"
0021 #endif
f31930e56f Ed H*0022 #ifdef ALLOW_MNC
33a3e71e59 Jean*0023 # include "MNC_PARAMS.h"
f31930e56f Ed H*0024 #endif
b6356366ca Ed H*0025 #ifdef ALLOW_MONITOR
33a3e71e59 Jean*0026 # include "MONITOR.h"
b6356366ca Ed H*0027 #endif
924557e60a Chri*0028
9366854e02 Chri*0029
c07cd3bfa8 Jean*0030
924557e60a Chri*0031 INTEGER myThid
b6356366ca Ed H*0032
924557e60a Chri*0033
49aab2cab9 Jean*0034
0035 LOGICAL MASTER_CPU_IO
0036 EXTERNAL MASTER_CPU_IO
0037
9366854e02 Chri*0038
dfef4f457e Jean*0039
0040
0041
0042 INTEGER bi,bj
0043 INTEGER i, j
924557e60a Chri*0044 _RL facGrid
33a3e71e59 Jean*0045 #ifndef OLD_GRID_IO
0046 INTEGER myTile, iG, iLen
0047 CHARACTER*(MAX_LEN_FNAM) fName
0048 CHARACTER*(MAX_LEN_MBUF) msgBuf
0049 INTEGER ILNBLNK
0050 EXTERNAL ILNBLNK
0051 #endif
0052
924557e60a Chri*0053
b6356366ca Ed H*0054
c07cd3bfa8 Jean*0055 IF ( selectCoriMap.EQ.0 ) THEN
b6356366ca Ed H*0056
0057 DO bj = myByLo(myThid), myByHi(myThid)
0058 DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0059 DO j=1-Oly,sNy+Oly
0060 DO i=1-Olx,sNx+Olx
0061 fCori(i,j,bi,bj) = f0
0062 fCoriG(i,j,bi,bj) = f0
c07cd3bfa8 Jean*0063 fCoriCos(i,j,bi,bj)=fPrime
b6356366ca Ed H*0064 ENDDO
dfef4f457e Jean*0065 ENDDO
924557e60a Chri*0066 ENDDO
0067 ENDDO
c07cd3bfa8 Jean*0068 ELSEIF ( selectCoriMap.EQ.1 ) THEN
b6356366ca Ed H*0069
0070 facGrid = 1. _d 0
dfef4f457e Jean*0071 IF ( usingSphericalPolarGrid
0072 & .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
b6356366ca Ed H*0073 DO bj = myByLo(myThid), myByHi(myThid)
0074 DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0075 DO j=1-Oly,sNy+Oly
0076 DO i=1-Olx,sNx+Olx
0077 fCori(i,j,bi,bj) = f0+beta*_yC(i,j,bi,bj)*facGrid
0078 fCoriG(i,j,bi,bj) = f0+beta* yG(i,j,bi,bj)*facGrid
c07cd3bfa8 Jean*0079 fCoriCos(i,j,bi,bj)=fPrime
b6356366ca Ed H*0080 ENDDO
dfef4f457e Jean*0081 ENDDO
b05b067368 Chri*0082 ENDDO
0083 ENDDO
c07cd3bfa8 Jean*0084 ELSEIF ( selectCoriMap.EQ.2 ) THEN
b6356366ca Ed H*0085
0086
0087 DO bj = myByLo(myThid), myByHi(myThid)
0088 DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0089 DO j=1-Oly,sNy+Oly
0090 DO i=1-Olx,sNx+Olx
0091 fCori(i,j,bi,bj) =
b6356366ca Ed H*0092 & 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
dfef4f457e Jean*0093 fCoriG(i,j,bi,bj) =
b6356366ca Ed H*0094 & 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
dfef4f457e Jean*0095 fCoriCos(i,j,bi,bj)=
b6356366ca Ed H*0096 & 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
0097 ENDDO
dfef4f457e Jean*0098 ENDDO
b05b067368 Chri*0099 ENDDO
0100 ENDDO
738f74f342 Jean*0101
0102
0103
b05b067368 Chri*0104 ELSE
c07cd3bfa8 Jean*0105
b6356366ca Ed H*0106 DO bj = myByLo(myThid), myByHi(myThid)
0107 DO bi = myBxLo(myThid), myBxHi(myThid)
dfef4f457e Jean*0108 DO j=1-Oly,sNy+Oly
0109 DO i=1-Olx,sNx+Olx
0110 fCori(i,j,bi,bj) = 0. _d 0
0111 fCoriG(i,j,bi,bj) = 0. _d 0
0112 fCoriCos(i,j,bi,bj)=0. _d 0
b6356366ca Ed H*0113 ENDDO
dfef4f457e Jean*0114 ENDDO
b05b067368 Chri*0115 ENDDO
0116 ENDDO
c07cd3bfa8 Jean*0117 ENDIF
0118
0119 IF ( selectCoriMap.EQ.3 ) THEN
0120
738f74f342 Jean*0121 CALL READ_REC_XY_RS( 'fCoriC.bin', fCori, 1, 0, myThid )
0122 CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
33a3e71e59 Jean*0123 IF ( .NOT.useCubedSphereExchange ) THEN
0124 CALL READ_REC_XY_RS('fCoriG.bin', fCoriG, 1, 0, myThid )
0125 ELSE
0126 #ifdef OLD_GRID_IO
0127 CALL READ_REC_XY_RS('fCoriG.bin', fCoriG, 1, 0, myThid )
738f74f342 Jean*0128
0129 DO bj = myByLo(myThid), myByHi(myThid)
0130 DO bi = myBxLo(myThid), myBxHi(myThid)
0131
0132
0133 IF (bi.LE.3 .OR. bi.GE.5) THEN
0134 fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
0135 ELSE
0136 fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
0137 ENDIF
0138 IF (bi.GE.3) THEN
0139 fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
0140 fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
0141 ELSE
0142 fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
0143 fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
0144 ENDIF
0145 ENDDO
0146 ENDDO
33a3e71e59 Jean*0147 #else /* OLD_GRID_IO */
0148 _BEGIN_MASTER(myThid)
0149 DO bj = 1,nSy
0150 DO bi = 1,nSx
0151 iG = bi+(myXGlobalLo-1)/sNx
0152 myTile = iG
0153 #ifdef ALLOW_EXCH2
8adbfea2f8 Jean*0154 myTile = W2_myTileList(bi,bj)
33a3e71e59 Jean*0155 iG = exch2_myface(myTile)
0156 #endif
0157 WRITE(fName,'(2A,I3.3,A)') 'fCoriG','.face',iG,'.bin'
0158 iLen = ILNBLNK(fName)
0159 WRITE(msgBuf,'(A,I6,2A)')
0160 & ' Reading tile:', myTile, ' from file ', fName(1:iLen)
0161 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0162 & SQUEEZE_RIGHT , myThid )
0163 #ifdef ALLOW_MDSIO
0164 CALL MDS_FACEF_READ_RS( fName, readBinaryPrec, 1,
0165 & fCoriG, bi, bj, myThid )
0166 #else /* ALLOW_MDSIO */
0167 WRITE(msgBuf,'(A)') 'INI_CORI: Needs to compile MDSIO pkg'
0168 CALL PRINT_ERROR( msgBuf, myThid )
0169 STOP 'ABNORMAL END: S/R INI_CORI'
0170 #endif /* ALLOW_MDSIO */
0171
0172 ENDDO
0173 ENDDO
0174 _END_MASTER(myThid)
0175 #endif /* OLD_GRID_IO */
738f74f342 Jean*0176 ENDIF
0177
a8d7de28cd Jean*0178 CALL EXCH_XY_RS( fCori, myThid )
0179 CALL EXCH_XY_RS( fCoriCos, myThid )
0180 CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
b05b067368 Chri*0181 ENDIF
924557e60a Chri*0182
ffced37781 Ed H*0183 #ifdef ALLOW_MONITOR
49aab2cab9 Jean*0184 IF ( MASTER_CPU_IO(myThid) ) THEN
dfef4f457e Jean*0185
ff02675122 Jean*0186
dfef4f457e Jean*0187
0188 IF (monitor_stdio) THEN
0189 mon_write_stdout = .TRUE.
0190 ELSE
0191 mon_write_stdout = .FALSE.
0192 ENDIF
0193 mon_write_mnc = .FALSE.
b6356366ca Ed H*0194 #ifdef ALLOW_MNC
dfef4f457e Jean*0195 IF (useMNC .AND. monitor_mnc) THEN
0196 DO i = 1,MAX_LEN_MBUF
0197 mon_fname(i:i) = ' '
0198 ENDDO
0199 mon_fname(1:12) = 'monitor_grid'
0200 CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
0201 mon_write_mnc = .TRUE.
0202 ENDIF
b6356366ca Ed H*0203 #endif /* ALLOW_MNC */
dfef4f457e Jean*0204
0205 ENDIF
0206
d3653d5831 Jean*0207 CALL MON_SET_PREF( mon_string_none, myThid )
c10dd767c9 Alis*0208 CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
0209 CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
e08dd1974e Alis*0210 CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
b6356366ca Ed H*0211
49aab2cab9 Jean*0212 IF ( MASTER_CPU_IO(myThid) ) THEN
dfef4f457e Jean*0213 mon_write_stdout = .FALSE.
0214 mon_write_mnc = .FALSE.
0215 ENDIF
0216 #endif /* ALLOW_MONITOR */
c10dd767c9 Alis*0217
924557e60a Chri*0218 RETURN
0219 END