/[MITgcm]/MITgcm/model/src/read_pickup.F
ViewVC logotype

Diff of /MITgcm/model/src/read_pickup.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jmc, Thu Aug 24 01:14:19 2006 UTC revision 1.2 by jmc, Tue Oct 23 15:22:04 2007 UTC
# Line 22  C     !USES: Line 22  C     !USES:
22  #include "SIZE.h"  #include "SIZE.h"
23  #include "EEPARAMS.h"  #include "EEPARAMS.h"
24  #include "PARAMS.h"  #include "PARAMS.h"
25    #include "RESTART.h"
26  #include "DYNVARS.h"  #include "DYNVARS.h"
27  #include "SURFACE.h"  #include "SURFACE.h"
28    #ifdef ALLOW_GENERIC_ADVDIFF
29    # include "GAD.h"
30    #endif
31  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
32  #include "NH_VARS.h"  #include "NH_VARS.h"
33  #endif  #endif
# Line 33  C     !USES: Line 37  C     !USES:
37    
38  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
39  C     myIter :: Iteration number  C     myIter :: Iteration number
40  C     myThid :: my Thread number Id.  C     myThid :: my Thread Id. number
41        INTEGER myIter        INTEGER myIter
42        INTEGER myThid        INTEGER myThid
43  CEOP  CEOP
44    
45  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
46  C     fp      :: pickup-file precision  C     fp          :: pickup-file precision
47  C     fn      :: Temp. for building file name.  C     fn          :: Temp. for building file name.
48    C     suff        :: suffix of pickup file to read
49    C     filePrec    :: pickup-file precision (read from meta file)
50    C     nbFields    :: number of fields in pickup file (read from meta file)
51    C     missFldList :: List of missing fields   (attempted to read but not found)
52    C     missFldDim  :: Dimension of missing fields list array: missFldList
53    C     nMissing    :: Number of missing fields (attempted to read but not found)
54    C     m1,m2       :: 6.th dim index (AB-3) corresponding to time-step N-1 & N-2
55    C     j           :: loop index
56    C     nj          :: record number
57    C     ioUnit      :: temp for writing msg unit
58    C     msgBuf      :: Informational/error message buffer
59        INTEGER fp        INTEGER fp
       INTEGER i, nj  
60        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
61        CHARACTER*(10) suff        CHARACTER*(10) suff
62          INTEGER filePrec, nbFields
63          INTEGER missFldDim, nMissing
64          PARAMETER( missFldDim = 20 )
65          CHARACTER*(8) missFldList(missFldDim)
66  #ifdef ALLOW_ADAMSBASHFORTH_3  #ifdef ALLOW_ADAMSBASHFORTH_3
67        INTEGER j        INTEGER m1, m2
68    #endif
69          INTEGER j, nj, ioUnit
70          CHARACTER*(MAX_LEN_MBUF) msgBuf
71    #ifndef ALLOW_GENERIC_ADVDIFF
72          LOGICAL AdamsBashforthGt
73          LOGICAL AdamsBashforthGs
74          LOGICAL AdamsBashforth_T
75          LOGICAL AdamsBashforth_S
76          PARAMETER ( AdamsBashforthGt = .FALSE. ,
77         &            AdamsBashforthGs = .FALSE. ,
78         &            AdamsBashforth_T = .FALSE. ,
79         &            AdamsBashforth_S = .FALSE. )
80  #endif  #endif
81    
82  C     Suffix for pickup files  C     Suffix for pickup files
83        DO i = 1,MAX_LEN_FNAM        DO j = 1,MAX_LEN_FNAM
84          fn(i:i) = ' '          fn(j:j) = ' '
85        ENDDO        ENDDO
86        IF (pickupSuff .EQ. ' ') THEN        IF (pickupSuff .EQ. ' ') THEN
87          WRITE(suff,'(I10.10)') myIter          WRITE(suff,'(I10.10)') myIter
# Line 65  C     Going to really do some IO. Make e Line 95  C     Going to really do some IO. Make e
95    
96        IF (pickup_read_mdsio) THEN        IF (pickup_read_mdsio) THEN
97    
98          fp = precFloat64         fp = precFloat64
99    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
100    
101           CALL READ_MFLDS_SET(
102         I                      fn,
103         O                      nbFields, filePrec,
104         I                      Nr, myIter, myThid )
105    
106           _BEGIN_MASTER( myThid )
107    c      IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN
108           IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
109             WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
110         &    'pickup-file binary precision do not match !'
111             CALL PRINT_ERROR( msgBuf, myThid )
112             WRITE(msgBuf,'(A,2(A,I4))') 'READ_PICKUP: ',
113         &    'file prec.=', filePrec, ' but expecting prec.=', fp
114             CALL PRINT_ERROR( msgBuf, myThid )
115             STOP 'ABNORMAL END: S/R READ_PICKUP (data-prec Pb)'
116           ENDIF
117           _END_MASTER( myThid )
118    
119    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
120    
121           IF ( nbFields.LE.0 ) THEN
122    C-      No meta-file or old meta-file without List of Fields
123            ioUnit = errorMessageUnit
124            IF ( pickupStrictlyMatch ) THEN
125              WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',
126         &      'no field-list found in meta-file',
127         &      ' => cannot check for strick-matching'
128    c         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
129              CALL PRINT_ERROR( msgBuf, myThid )
130              WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',
131         &      'try with " pickupStrictlyMatch=.FALSE.,"',
132         &      ' in file: "data", NameList: "PARM03"'
133              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
134              STOP 'ABNORMAL END: S/R READ_PICKUP'
135            ELSE
136              WRITE(msgBuf,'(4A)') 'WARNING >> READ_PICKUP: ',
137         &      ' no field-list found'
138              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
139             IF ( nbFields.EQ.-1 ) THEN
140    C-      No meta-file
141              WRITE(msgBuf,'(4A)') 'WARNING >> ',
142         &      ' try to read pickup as currently written'
143              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
144             ELSE
145    C-      Old meta-file without List of Fields
146              WRITE(msgBuf,'(4A)') 'WARNING >> ',
147         &      ' try to read pickup as it used to be written'
148              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
149              WRITE(msgBuf,'(4A)') 'WARNING >> ',
150         &      ' until checkpoint59i (2007 Oct 22)'
151              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
152             ENDIF
153            ENDIF
154           ENDIF
155    
156    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
157    
158  C       Read model fields  C---   Old way to read model fields:
159           IF ( nbFields.EQ.0 ) THEN
160          IF ( usePickupBeforeC54 ) THEN          IF ( usePickupBeforeC54 ) THEN
161  #ifndef ALLOW_ADAMSBASHFORTH_3  #ifndef ALLOW_ADAMSBASHFORTH_3
162            CALL READ_REC_3D_RL( fn, fp, Nr, uVel,  1, myIter,myThid )            CALL READ_REC_3D_RL( fn, fp, Nr, uVel,  1, myIter,myThid )
# Line 133  C       Read model fields Line 222  C       Read model fields
222  #endif /*  ALLOW_ADAMSBASHFORTH_3 */  #endif /*  ALLOW_ADAMSBASHFORTH_3 */
223            CALL READ_REC_3D_RL( fn,fp,1, etaN, nj*Nr+1, myIter,myThid )            CALL READ_REC_3D_RL( fn,fp,1, etaN, nj*Nr+1, myIter,myThid )
224  #ifdef EXACT_CONSERV  #ifdef EXACT_CONSERV
225            IF (exactConserv) THEN            IF ( exactConserv ) THEN
226             CALL READ_REC_3D_RL(fn,fp,1,dEtaHdt,nj*Nr+2,myIter,myThid )             CALL READ_REC_3D_RL(fn,fp,1,dEtaHdt,nj*Nr+2,myIter,myThid )
227            ENDIF            ENDIF
228            IF (nonlinFreeSurf .GT. 0) THEN            IF ( nonlinFreeSurf.GT.0 ) THEN
229             CALL READ_REC_3D_RL(fn,fp,1, etaH, nj*Nr+3, myIter,myThid )             CALL READ_REC_3D_RL(fn,fp,1, etaH, nj*Nr+3, myIter,myThid )
230            ENDIF            ENDIF
231  #endif  #endif
# Line 145  C       Read model fields Line 234  C       Read model fields
234          IF ( useDynP_inEos_Zc ) THEN          IF ( useDynP_inEos_Zc ) THEN
235            WRITE(fn,'(A,A10)') 'pickup_ph.',suff            WRITE(fn,'(A,A10)') 'pickup_ph.',suff
236            CALL READ_REC_3D_RL( fn, fp, Nr, totPhiHyd,1,myIter,myThid )            CALL READ_REC_3D_RL( fn, fp, Nr, totPhiHyd,1,myIter,myThid )
237          ENDIF           ENDIF
238  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
239          IF ( use3Dsolver ) THEN           IF ( use3Dsolver ) THEN
240            WRITE(fn,'(A,A10)') 'pickup_nh.',suff            WRITE(fn,'(A,A10)') 'pickup_nh.',suff
241            CALL READ_REC_3D_RL( fn, fp, Nr, phi_nh,  1, myIter,myThid )            CALL READ_REC_3D_RL( fn, fp, Nr, phi_nh,  1, myIter,myThid )
242            CALL READ_REC_3D_RL( fn, fp, Nr, gwNm1,   2, myIter,myThid )            CALL READ_REC_3D_RL( fn, fp, Nr, gwNm1,   2, myIter,myThid )
243          ENDIF          ENDIF
244  #endif  #endif
245           ELSE
246    C---   New way to read model fields:
247              nj = 0
248    C---    read State 3-D fields for restart
249              CALL READ_MFLDS_3D_RL( 'Uvel    ', uVel,
250         &                                     nj, fp, Nr, myIter, myThid )
251              CALL READ_MFLDS_3D_RL( 'Vvel    ', vVel,
252         &                                     nj, fp, Nr, myIter, myThid )
253              CALL READ_MFLDS_3D_RL( 'Theta   ', theta,
254         &                                     nj, fp, Nr, myIter, myThid )
255              CALL READ_MFLDS_3D_RL( 'Salt    ', salt,
256         &                                     nj, fp, Nr, myIter, myThid )
257    C---    read 3-D fields for AB-restart
258    #ifdef ALLOW_ADAMSBASHFORTH_3
259             m1 = 1 + MOD(myIter+1,2)
260             m2 = 1 + MOD( myIter ,2)
261    C--     U velocity:
262             IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
263              CALL READ_MFLDS_3D_RL( 'GuNm1   ',guNm(1-Olx,1-Oly,1,1,1,m1),
264         &                                     nj, fp, Nr, myIter, myThid )
265             ENDIF
266             IF ( beta_AB.NE.0. ) THEN
267              CALL READ_MFLDS_3D_RL( 'GuNm2   ',guNm(1-Olx,1-Oly,1,1,1,m2),
268         &                                     nj, fp, Nr, myIter, myThid )
269             ENDIF
270    C--     V velocity:
271             IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
272              CALL READ_MFLDS_3D_RL( 'GvNm1   ',gvNm(1-Olx,1-Oly,1,1,1,m1),
273         &                                     nj, fp, Nr, myIter, myThid )
274             ENDIF
275             IF ( beta_AB.NE.0. ) THEN
276              CALL READ_MFLDS_3D_RL( 'GvNm2   ',gvNm(1-Olx,1-Oly,1,1,1,m2),
277         &                                     nj, fp, Nr, myIter, myThid )
278             ENDIF
279    C--     Temperature:
280            IF ( AdamsBashforthGt ) THEN
281             IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
282              CALL READ_MFLDS_3D_RL( 'GtNm1   ',gtNm(1-Olx,1-Oly,1,1,1,m1),
283         &                                     nj, fp, Nr, myIter, myThid )
284             ENDIF
285             IF ( beta_AB.NE.0. ) THEN
286              CALL READ_MFLDS_3D_RL( 'GtNm2   ',gtNm(1-Olx,1-Oly,1,1,1,m2),
287         &                                     nj, fp, Nr, myIter, myThid )
288             ENDIF
289            ELSEIF ( AdamsBashforth_T ) THEN
290             IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
291              CALL READ_MFLDS_3D_RL( 'TempNm1 ',gtNm(1-Olx,1-Oly,1,1,1,m1),
292         &                                     nj, fp, Nr, myIter, myThid )
293             ENDIF
294             IF ( beta_AB.NE.0. ) THEN
295              CALL READ_MFLDS_3D_RL( 'TempNm2 ',gtNm(1-Olx,1-Oly,1,1,1,m2),
296         &                                     nj, fp, Nr, myIter, myThid )
297             ENDIF
298            ENDIF
299    C--     Salinity:
300            IF ( AdamsBashforthGs ) THEN
301             IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
302              CALL READ_MFLDS_3D_RL( 'GsNm1   ',gsNm(1-Olx,1-Oly,1,1,1,m1),
303         &                                     nj, fp, Nr, myIter, myThid )
304             ENDIF
305             IF ( beta_AB.NE.0. ) THEN
306              CALL READ_MFLDS_3D_RL( 'GsNm2   ',gsNm(1-Olx,1-Oly,1,1,1,m2),
307         &                                     nj, fp, Nr, myIter, myThid )
308             ENDIF
309            ELSEIF ( AdamsBashforth_S ) THEN
310             IF ( alph_AB.NE.0. .OR. beta_AB.NE.0. ) THEN
311              CALL READ_MFLDS_3D_RL( 'SaltNm1 ',gsNm(1-Olx,1-Oly,1,1,1,m1),
312         &                                     nj, fp, Nr, myIter, myThid )
313             ENDIF
314             IF ( beta_AB.NE.0. ) THEN
315              CALL READ_MFLDS_3D_RL( 'SaltNm2 ',gsNm(1-Olx,1-Oly,1,1,1,m2),
316         &                                     nj, fp, Nr, myIter, myThid )
317             ENDIF
318            ENDIF
319    #else /*  ALLOW_ADAMSBASHFORTH_3 */
320    C--     U velocity:
321              CALL READ_MFLDS_3D_RL( 'GuNm1   ', guNm1,
322         &                                     nj, fp, Nr, myIter, myThid )
323    C--     V velocity:
324              CALL READ_MFLDS_3D_RL( 'GvNm1   ', gvNm1,
325         &                                     nj, fp, Nr, myIter, myThid )
326    C--     Temperature
327            IF ( AdamsBashforthGt ) THEN
328              CALL READ_MFLDS_3D_RL( 'GtNm1   ', gtNm1,
329         &                                     nj, fp, Nr, myIter, myThid )
330            ENDIF
331    C--     Salinity
332            IF ( AdamsBashforthGs ) THEN
333              CALL READ_MFLDS_3D_RL( 'GsNm1   ', gsNm1,
334         &                                     nj, fp, Nr, myIter, myThid )
335            ENDIF
336    #endif /*  ALLOW_ADAMSBASHFORTH_3 */
337    
338    C-      read Full Pressure for EOS in pressure:
339            IF ( useDynP_inEos_Zc ) THEN
340              CALL READ_MFLDS_3D_RL( 'PhiHyd  ', totPhiHyd,
341         &                                     nj, fp, Nr, myIter, myThid )
342            ENDIF
343    #ifdef ALLOW_NONHYDROSTATIC
344            IF ( use3Dsolver ) THEN
345              CALL READ_MFLDS_3D_RL( 'Phi_NHyd', phi_nh,
346         &                                     nj, fp, Nr, myIter, myThid )
347            ENDIF
348            IF ( nonHydrostatic ) THEN
349              CALL READ_MFLDS_3D_RL( 'GwNm1   ', gwNm1,
350         &                                     nj, fp, Nr, myIter, myThid )
351            ENDIF
352    #endif
353    
354    C---    read 2-D fields, starting with Eta:
355              nj = nj*Nr
356              CALL READ_MFLDS_3D_RL( 'EtaN    ', etaN,
357         &                                     nj, fp, 1 , myIter, myThid )
358    #ifdef EXACT_CONSERV
359            IF ( exactConserv ) THEN
360              CALL READ_MFLDS_3D_RL( 'dEtaHdt ', dEtaHdt,
361         &                                     nj, fp, 1 , myIter, myThid )
362            ENDIF
363            IF ( nonlinFreeSurf.GT.0 ) THEN
364              CALL READ_MFLDS_3D_RL( 'EtaH    ', etaH,
365         &                                     nj, fp, 1 , myIter, myThid )
366            ENDIF
367    #endif
368    C--    end: new way to read pickup file
369           ENDIF
370    
371    C--    Check for missing fields:
372           nMissing = missFldDim
373           CALL READ_MFLDS_CHECK(
374         O                    missFldList,
375         U                    nMissing,
376         I                    myIter, myThid )
377           IF ( nMissing.GT.missFldDim ) THEN
378             WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',
379         &     'missing fields list has been truncated to', missFldDim
380             CALL PRINT_ERROR( msgBuf, myThid )
381             STOP 'ABNORMAL END: S/R READ_PICKUP (list-size Pb)'
382           ENDIF
383           CALL CHECK_PICKUP(
384         I                    missFldList,
385         I                    nMissing, nbFields,
386         I                    myIter, myThid )
387    
388    C--   end: pickup_read_mdsio
389        ENDIF        ENDIF
390    
391  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22