File indexing completed on 2024-02-29 06:10:25 UTC
view on githubraw file Latest commit a4576c7c on 2024-02-28 22:55:11 UTC
5a6ef5c2b4 Mich*0001 #include "GMREDI_OPTIONS.h"
0002
0003
0004
0005
0006
0007
0008 SUBROUTINE GMREDI_READ_PICKUP( myIter, myThid )
0009
0010
0011
0012
0013
0014 IMPLICIT NONE
0015 #include "SIZE.h"
0016 #include "EEPARAMS.h"
0017 #include "PARAMS.h"
0018 #include "GMREDI.h"
0019
0020
0021
0022
0023 INTEGER myIter
0024 INTEGER myThid
0025
a4576c7cde Juli*0026 #if ( defined GM_BATES_K3D || defined GM_GEOM_VARIABLE_K )
0027
0028 INTEGER ILNBLNK
0029 EXTERNAL ILNBLNK
5a6ef5c2b4 Mich*0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040
0041
0042
0043 INTEGER fp
0044 INTEGER filePrec, nbFields
0045 INTEGER missFldDim, nMissing
a4576c7cde Juli*0046 INTEGER j, nj, ioUnit, iL
0047 #ifdef GM_BATES_K3D
0048 INTEGER i, k, n, bi, bj
0049 _RL vec(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0050 # ifdef GM_GEOM_VARIABLE_K
0051 PARAMETER( missFldDim = 5+2*GM_Bates_NModes )
0052 # else
0053 PARAMETER( missFldDim = 2+2*GM_Bates_NModes )
0054 # endif
0055 #else /* GM_BATES_K3D */
0056 PARAMETER( missFldDim = 3 )
0057 #endif /* GM_BATES_K3D */
df5a9764ba Jean*0058 CHARACTER*(10) suff
a4576c7cde Juli*0059 CHARACTER*(MAX_LEN_FNAM) fn, tmpNam
5a6ef5c2b4 Mich*0060 CHARACTER*(8) missFldList(missFldDim)
0061 CHARACTER*(8) fieldname
a4576c7cde Juli*0062 CHARACTER*(MAX_LEN_MBUF) msgBuf
0063 LOGICAL useCurrentDir, fileExist, StopFlag
5a6ef5c2b4 Mich*0064
0065
a4576c7cde Juli*0066 IF ( GM_useBatesK3d .OR. GM_useGEOM ) THEN
0067 ioUnit = errorMessageUnit
0068
5a6ef5c2b4 Mich*0069
0070
0071 IF ( pickupSuff.EQ.' ' ) THEN
df5a9764ba Jean*0072 IF ( rwSuffixType.EQ.0 ) THEN
0073 WRITE(fn,'(A,I10.10)') 'pickup_gmredi.', myIter
0074 ELSE
0075 CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
0076 WRITE(fn,'(A,A)') 'pickup_gmredi.', suff
0077 ENDIF
5a6ef5c2b4 Mich*0078 ELSE
df5a9764ba Jean*0079 WRITE(fn,'(A,A10)') 'pickup_gmredi.', pickupSuff
5a6ef5c2b4 Mich*0080 ENDIF
0081 fp = precFloat64
0082
0083 CALL READ_MFLDS_SET(
0084 I fn,
0085 O nbFields, filePrec,
0086 I Nr, myIter, myThid )
0087 _BEGIN_MASTER( myThid )
0088
0089 IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
0090 WRITE(msgBuf,'(2A,I4)') 'GMREDI_READ_PICKUP: ',
0091 & 'pickup-file binary precision do not match !'
0092 CALL PRINT_ERROR( msgBuf, myThid )
0093 WRITE(msgBuf,'(A,2(A,I4))') 'GMREDI_READ_PICKUP: ',
0094 & 'file prec.=', filePrec, ' but expecting prec.=', fp
0095 CALL PRINT_ERROR( msgBuf, myThid )
0096 CALL ALL_PROC_DIE( 0 )
0097 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP (data-prec Pb)'
0098 ENDIF
0099 _END_MASTER( myThid )
0100
0101 IF ( nbFields.LE.0 ) THEN
0102
0103 IF ( pickupStrictlyMatch ) THEN
a4576c7cde Juli*0104 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
5a6ef5c2b4 Mich*0105 & 'no field-list found in meta-file',
0106 & ' => cannot check for strick-matching'
a4576c7cde Juli*0107 CALL PRINT_ERROR( msgBuf, myThid )
0108 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
5a6ef5c2b4 Mich*0109 & 'try with " pickupStrictlyMatch=.FALSE.,"',
0110 & ' in file: "data", NameList: "PARM03"'
a4576c7cde Juli*0111 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0112 CALL ALL_PROC_DIE( myThid )
0113 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP'
5a6ef5c2b4 Mich*0114 ELSE
0115 IF ( nbFields.EQ.-1 ) THEN
a4576c7cde Juli*0116
0117 #ifdef ALLOW_MDSIO
0118 useCurrentDir = .FALSE.
0119 CALL MDS_CHECK4FILE(
0120 I fn, '.data', 'GMREDI_READ_PICKUP',
0121 O tmpNam, fileExist,
0122 I useCurrentDir, myThid )
0123 #else
0124 STOP 'ABNORMAL END: S/R DIC_READ_PICKUP: Needs MDSIO pkg'
0125 #endif
0126 IF ( fileExist ) THEN
0127 WRITE(msgBuf,'(4A)') 'WARNING >> GMREDI_READ_PICKUP: ',
0128 & ' no field-list found'
0129 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0130 WRITE(msgBuf,'(4A)') 'WARNING >> ',
5a6ef5c2b4 Mich*0131 & ' try to read pickup as currently written'
a4576c7cde Juli*0132 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0133 ELSE
0134 iL = ILNBLNK(fn)
0135 WRITE(msgBuf,'(4A)') 'WARNING >> GMREDI_READ_PICKUP: ',
0136 & 'missing both "meta" & "data" files for "', fn(1:iL), '"'
0137 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0138 nbFields = -2
0139 #ifdef GM_GEOM_VARIABLE_K
0140 _BEGIN_MASTER( myThid )
0141 IF ( GM_useGEOM ) THEN
0142 GEOM_startAB = 0
0143 WRITE(msgBuf,'(4A)') 'WARNING >> GMREDI_READ_PICKUP: ',
0144 & 'restart with uniform GEOM_EKE = GEOM_ini_EKE'
0145 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0146 _END_MASTER( myThid )
0147 ENDIF
0148 #endif
0149 ENDIF
5a6ef5c2b4 Mich*0150 ELSE
0151
0152
0153
0154
0155
0156
0157
0158 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
0159 & 'no field-list found in meta-file'
0160 CALL PRINT_ERROR( msgBuf, myThid )
0161 CALL ALL_PROC_DIE( myThid )
0162 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP'
0163 ENDIF
0164 ENDIF
0165 ENDIF
0166
0167
0168
0169 IF ( nbFields.EQ.0 ) THEN
0170
0171
a4576c7cde Juli*0172
0173
0174
5a6ef5c2b4 Mich*0175
a4576c7cde Juli*0176 ELSEIF ( nbFields.NE.-2 ) THEN
5a6ef5c2b4 Mich*0177
a4576c7cde Juli*0178 nj = 0
0179
0180
0181 #ifdef GM_BATES_K3D
0182 IF ( GM_useBatesK3d ) THEN
0183
0184
0185 fieldname = 'mode01C '
5a6ef5c2b4 Mich*0186 CALL READ_MFLDS_3D_RL( fieldname, vec,
a4576c7cde Juli*0187 & nj, fp, Nr, myIter, myThid )
0188 CALL EXCH_3D_RL( vec, Nr, myThid )
5a6ef5c2b4 Mich*0189 DO bj=myByLo(myThid),myByHi(myThid)
0190 DO bi=myBxLo(myThid),myBxHi(myThid)
0191 DO k=1,Nr
df5a9764ba Jean*0192 DO j=1-OLy,sNy+OLy
0193 DO i=1-OLx,sNx+OLx
a4576c7cde Juli*0194 modesC(1,i,j,k,bi,bj) = vec(i,j,k,bi,bj)
5a6ef5c2b4 Mich*0195 ENDDO
0196 ENDDO
0197 ENDDO
0198 ENDDO
0199 ENDDO
0200
a4576c7cde Juli*0201
0202 DO n=1,GM_Bates_NModes
0203 WRITE(fieldname, '(A,I2.2,A)') 'mode',n,'W'
0204 CALL READ_MFLDS_3D_RL( fieldname, vec,
0205 & nj, fp, Nr, myIter, myThid )
0206 CALL EXCH_3D_RL( vec, Nr, myThid )
0207 DO bj=myByLo(myThid),myByHi(myThid)
0208 DO bi=myBxLo(myThid),myBxHi(myThid)
0209 DO k=1,Nr
0210 DO j=1-OLy,sNy+OLy
0211 DO i=1-OLx,sNx+OLx
0212 modesW(n,i,j,k,bi,bj) = vec(i,j,k,bi,bj)
0213 ENDDO
5a6ef5c2b4 Mich*0214 ENDDO
0215 ENDDO
0216 ENDDO
0217 ENDDO
0218 ENDDO
0219
a4576c7cde Juli*0220
0221 DO n=1,GM_Bates_NModes
0222 WRITE(fieldname, '(A,I2.2,A)') 'mode',n,'S'
0223 CALL READ_MFLDS_3D_RL( fieldname, vec,
0224 & nj, fp, Nr, myIter, myThid )
0225 CALL EXCH_3D_RL( vec, Nr, myThid )
0226 DO bj=myByLo(myThid),myByHi(myThid)
0227 DO bi=myBxLo(myThid),myBxHi(myThid)
0228 DO k=1,Nr
0229 DO j=1-OLy,sNy+OLy
0230 DO i=1-OLx,sNx+OLx
0231 modesS(n,i,j,k,bi,bj) = vec(i,j,k,bi,bj)
0232 ENDDO
0233 ENDDO
0234 ENDDO
0235 ENDDO
0236 ENDDO
0237 ENDDO
5a6ef5c2b4 Mich*0238
a4576c7cde Juli*0239
0240 nj = nj*Nr
5a6ef5c2b4 Mich*0241
a4576c7cde Juli*0242 fieldname = 'Rdef '
0243 CALL READ_MFLDS_3D_RL( fieldname, Rdef,
0244 & nj, fp, 1, myIter, myThid )
0245 CALL EXCH_XY_RL( Rdef, myThid )
0246
0247
0248 ENDIF
0249 #endif /* GM_BATES_K3D */
0250
0251
0252
0253 #ifdef GM_GEOM_VARIABLE_K
0254 IF ( GM_useGEOM ) THEN
0255
0256
0257
0258 fieldname = 'GEOM_EKE'
0259 CALL READ_MFLDS_3D_RL( fieldname, GEOM_EKE,
0260 & nj, fp, 1, myIter, myThid )
0261 CALL EXCH_XY_RL( GEOM_EKE, myThid )
0262
0263 fieldname = 'GEKE_Nm1'
0264 CALL READ_MFLDS_3D_RL( fieldname, GEOM_gEKE_Nm1,
0265 & nj, fp, 1, myIter, myThid )
0266 CALL EXCH_XY_RL( GEOM_gEKE_Nm1, myThid )
0267
0268 ENDIF
0269 #endif /* GM_GEOM_VARIABLE_K */
5a6ef5c2b4 Mich*0270
0271
a4576c7cde Juli*0272 ENDIF
5a6ef5c2b4 Mich*0273
a4576c7cde Juli*0274
5a6ef5c2b4 Mich*0275
a4576c7cde Juli*0276 nMissing = missFldDim
0277 CALL READ_MFLDS_CHECK(
0278 O missFldList,
0279 U nMissing,
0280 I myIter, myThid )
0281
0282 _BEGIN_MASTER( myThid )
0283 IF ( nMissing.GT.missFldDim ) THEN
5a6ef5c2b4 Mich*0284 WRITE(msgBuf,'(2A,I4)') 'GMREDI_READ_PICKUP: ',
0285 & 'missing fields list has been truncated to', missFldDim
0286 CALL PRINT_ERROR( msgBuf, myThid )
a4576c7cde Juli*0287 CALL ALL_PROC_DIE( 0 )
5a6ef5c2b4 Mich*0288 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP (list-size Pb)'
a4576c7cde Juli*0289 ENDIF
0290 IF ( nMissing.GE.1 ) THEN
0291 stopFlag = .FALSE.
0292 IF ( pickupStrictlyMatch ) THEN
5a6ef5c2b4 Mich*0293 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
a4576c7cde Juli*0294 & 'try with " pickupStrictlyMatch=.FALSE.,"',
0295 & ' in file: "data", NameList: "PARM03"'
5a6ef5c2b4 Mich*0296 CALL PRINT_ERROR( msgBuf, myThid )
a4576c7cde Juli*0297 stopFlag = .TRUE.
0298 ELSE
0299 DO j=1,nMissing
0300 IF ( missFldList(j).EQ.'GEOM_EKE' ) THEN
0301 #ifdef GM_GEOM_VARIABLE_K
0302 GEOM_startAB = 0
0303 WRITE(msgBuf,'(4A)') '** WARNING ** GMREDI_READ_PICKUP: ',
0304 & 'restart with uniform GEOM_EKE = GEOM_ini_EKE'
0305 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0306 ELSEIF ( missFldList(j).EQ.'GEKE_Nm1' ) THEN
0307 GEOM_startAB = 0
0308 WRITE(msgBuf,'(4A)') '** WARNING ** GMREDI_READ_PICKUP: ',
0309 & 'Will get only an approximated Restart (GEOM_startAB=0)'
0310 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
0311 #endif /* GM_GEOM_VARIABLE_K */
0312 ELSE
0313 stopFlag = .TRUE.
0314 WRITE(msgBuf,'(4A)') 'GMREDI_READ_PICKUP: ',
0315 & 'cannot restart without field "',missFldList(j),'"'
0316 CALL PRINT_ERROR( msgBuf, myThid )
0317 ENDIF
0318 ENDDO
0319 ENDIF
0320 IF ( stopFlag ) THEN
0321 CALL ALL_PROC_DIE( 0 )
0322 STOP 'ABNORMAL END: S/R GMREDI_READ_PICKUP'
0323 ENDIF
5a6ef5c2b4 Mich*0324
a4576c7cde Juli*0325 ENDIF
0326 _END_MASTER( myThid )
0327
0328
0329
0330 ENDIF
0331 #endif /* GM_BATES_K3D or GM_GEOM_VARIABLE_K */
5a6ef5c2b4 Mich*0332
0333 RETURN
0334 END