/[MITgcm]/MITgcm_contrib/sannino/OASIS_3.0_Coupler/code/checkpoint.F
ViewVC logotype

Annotation of /MITgcm_contrib/sannino/OASIS_3.0_Coupler/code/checkpoint.F

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

Revision 1.1 - (hide annotations) (download)
Thu Jul 20 21:08:15 2006 UTC (19 years, 3 months ago) by sannino
Branch: MAIN
CVS Tags: HEAD 
o Adding OASIS package
o Adding grid refinement package
1 sannino 1.1 C $Header: /u/gcmpack/MITgcm/model/src/checkpoint.F,v 1.66 2006/05/03 15:38:42 heimbach Exp $
2     C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6    
7     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8     CBOP
9     C !ROUTINE: SET_WRITE_GLOBAL_PICKUP
10     C !INTERFACE:
11     SUBROUTINE SET_WRITE_GLOBAL_PICKUP( flag )
12    
13     C !DESCRIPTION:
14     C Sets an internal logical state to indicate whether files written
15     C by subsequent calls to the READ_WRITE_FLD package should create
16     C "global" or "tiled" files:
17     C \begin{center}
18     C \begin{tabular}[h]{|l|l|}\hline
19     C \texttt{flag} & Meaning \\\hline
20     C \texttt{.TRUE.} & use ``global'' files \\
21     C \texttt{.TRUE.} & use ``tiled'' files \\\hline
22     C \end{tabular}
23     C \end{center}
24    
25     C !USES:
26     IMPLICIT NONE
27    
28     C !INPUT PARAMETERS:
29     LOGICAL flag
30     CEOP
31     COMMON /PCKP_GBLFLS/ globalFile
32     LOGICAL globalFile
33    
34     globalFile = flag
35    
36     RETURN
37     END
38    
39     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
40     CBOP
41     C !ROUTINE: READ_CHECKPOINT
42     C !INTERFACE:
43     SUBROUTINE READ_CHECKPOINT(
44     I myIter, myThid )
45    
46     C !DESCRIPTION:
47     C This is the controlling routine for IO to write restart (or
48     C ``pickup'' or ``checkpoint'') files. It calls routines from other
49     C packages (\textit{eg.} mdsio and mnc) to do the per-variable
50     C reads.
51    
52     C !USES:
53     IMPLICIT NONE
54     #include "SIZE.h"
55     #include "EEPARAMS.h"
56     #include "PARAMS.h"
57     #ifdef ALLOW_MNC
58     #include "MNC_PARAMS.h"
59     #endif
60     #include "DYNVARS.h"
61     #include "SURFACE.h"
62     #ifdef ALLOW_NONHYDROSTATIC
63     #include "NH_VARS.h"
64     #endif
65     INTEGER IO_ERRCOUNT
66     EXTERNAL IO_ERRCOUNT
67    
68     C !INPUT/OUTPUT PARAMETERS:
69     C myThid - Thread number for this instance of the routine.
70     C myIter - Iteration number
71     INTEGER myThid
72     INTEGER myIter
73     CEOP
74    
75     C !LOCAL VARIABLES:
76     C oldPrec :: Temp. for hold I/O precision information
77     C prec
78     C fn :: Temp. for building file name.
79     INTEGER prec
80     INTEGER i, nj
81     CHARACTER*(MAX_LEN_FNAM) fn
82     CHARACTER*(10) suff
83     #ifdef OLD_STYLE_WITH_MANY_FILES
84     INTEGER oldPrec
85     #endif
86     #ifdef ALLOW_ADAMSBASHFORTH_3
87     INTEGER j
88     #endif
89    
90     C Suffix for pickup files
91     DO i = 1,MAX_LEN_FNAM
92     fn(i:i) = ' '
93     ENDDO
94     IF (pickupSuff .EQ. ' ') THEN
95     WRITE(suff,'(I10.10)') myIter
96     ELSE
97     WRITE(suff,'(A10)') pickupSuff
98     ENDIF
99     WRITE(fn,'(A,A10)') 'pickup.',suff
100    
101     C Going to really do some IO. Make everyone except master thread wait.
102     _BARRIER
103     C _BEGIN_MASTER( myThid )
104    
105     IF (pickup_read_mdsio) THEN
106    
107     #ifdef OLD_STYLE_WITH_MANY_FILES
108    
109     C Force 64-bit IO
110     oldPrec = readBinaryPrec
111     readBinaryPrec = precFloat64
112    
113     C Read model fields
114     C Raw fields
115     CALL READ_REC_XYZ_RL( 'uVel', uVel, 1,myIter,myThid)
116     CALL READ_REC_XYZ_RL( 'gU', gU, 1,myIter,myThid)
117     CALL READ_REC_XYZ_RL( 'guNm1', guNm1, 1,myIter,myThid)
118     CALL READ_REC_XYZ_RL( 'vVel', vVel, 1,myIter,myThid)
119     CALL READ_REC_XYZ_RL( 'gV', gV, 1,myIter,myThid)
120     CALL READ_REC_XYZ_RL( 'gvNm1', gvNm1, 1,myIter,myThid)
121     CALL READ_REC_XYZ_RL( 'theta', theta, 1,myIter,myThid)
122     CALL READ_REC_XYZ_RL( 'gT', gT, 1,myIter,myThid)
123     CALL READ_REC_XYZ_RL( 'gtNm1', gtNm1, 1,myIter,myThid)
124     CALL READ_REC_XYZ_RL( 'salt', salt, 1,myIter,myThid)
125     CALL READ_REC_XYZ_RL( 'gS', gS, 1,myIter,myThid)
126     CALL READ_REC_XYZ_RL( 'gsNm1', gsNm1, 1,myIter,myThid)
127     CALL READ_REC_XY_RL ( 'etaN', etaN, 1,myIter,myThid)
128    
129     #ifdef ALLOW_NONHYDROSTATIC
130     IF ( use3Dsolver ) THEN
131     CALL READ_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
132     c CALL READ_REC_XYZ_RL( 'gW', gW,1,myIter,myThid)
133     CALL READ_REC_XYZ_RL( 'gWnm1', gwNm1,1,myIter,myThid)
134     ENDIF
135     #endif
136    
137     C Reset default IO precision
138     readBinaryPrec = oldPrec
139    
140     #else /* OLD_STYLE_WITH_MANY_FILES */
141    
142     prec = precFloat64
143    
144     #ifdef ALLOW_MDSIO
145    
146     C Read model fields
147     IF ( usePickupBeforeC54 ) THEN
148     #ifndef ALLOW_ADAMSBASHFORTH_3
149     CALL MDSREADFIELD(fn,prec,'RL',Nr,uVel, 1,myThid)
150     CALL MDSREADFIELD(fn,prec,'RL',Nr,gU, 2,myThid)
151     CALL MDSREADFIELD(fn,prec,'RL',Nr,guNm1, 3,myThid)
152     CALL MDSREADFIELD(fn,prec,'RL',Nr,vVel, 4,myThid)
153     CALL MDSREADFIELD(fn,prec,'RL',Nr,gV, 5,myThid)
154     CALL MDSREADFIELD(fn,prec,'RL',Nr,gvNm1, 6,myThid)
155     CALL MDSREADFIELD(fn,prec,'RL',Nr,theta, 7,myThid)
156     CALL MDSREADFIELD(fn,prec,'RL',Nr,gT, 8,myThid)
157     CALL MDSREADFIELD(fn,prec,'RL',Nr,gtNm1, 9,myThid)
158     CALL MDSREADFIELD(fn,prec,'RL',Nr,salt, 10,myThid)
159     CALL MDSREADFIELD(fn,prec,'RL',Nr,gS, 11,myThid)
160     CALL MDSREADFIELD(fn,prec,'RL',Nr,gsNm1, 12,myThid)
161     #endif /* ALLOW_ADAMSBASHFORTH_3 */
162     CALL MDSREADFIELD(fn,prec,'RL', 1,etaN,12*Nr+1,myThid)
163     #ifdef NONLIN_FRSURF
164     IF (nonlinFreeSurf .GE. 0) THEN
165     CALL MDSREADFIELD(fn,prec,'RL',1,etaH,12*Nr+2,myThid)
166     ENDIF
167     #endif
168     ELSE
169     #ifdef ALLOW_ADAMSBASHFORTH_3
170     j = 3
171     IF ( startFromPickupAB2 ) j = 2
172     nj = 0
173     CALL MDSREADFIELD(fn,prec,'RL',Nr,uVel, nj+1,myThid)
174     CALL MDSREADFIELD(fn,prec,'RL',Nr,
175     & guNm(1-Olx,1-Oly,1,1,1,1), nj+2,myThid)
176     CALL MDSREADFIELD(fn,prec,'RL',Nr,
177     & guNm(1-Olx,1-Oly,1,1,1,2), nj+j,myThid)
178     nj = j
179     CALL MDSREADFIELD(fn,prec,'RL',Nr,vVel, nj+1,myThid)
180     CALL MDSREADFIELD(fn,prec,'RL',Nr,
181     & gvNm(1-Olx,1-Oly,1,1,1,1), nj+2,myThid)
182     CALL MDSREADFIELD(fn,prec,'RL',Nr,
183     & gvNm(1-Olx,1-Oly,1,1,1,2), nj+j,myThid)
184     nj = 2*j
185     CALL MDSREADFIELD(fn,prec,'RL',Nr,theta,nj+1,myThid)
186     CALL MDSREADFIELD(fn,prec,'RL',Nr,
187     & gtNm(1-Olx,1-Oly,1,1,1,1), nj+2,myThid)
188     CALL MDSREADFIELD(fn,prec,'RL',Nr,
189     & gtNm(1-Olx,1-Oly,1,1,1,2), nj+j,myThid)
190     nj = 3*j
191     CALL MDSREADFIELD(fn,prec,'RL',Nr,salt, nj+1,myThid)
192     CALL MDSREADFIELD(fn,prec,'RL',Nr,
193     & gsNm(1-Olx,1-Oly,1,1,1,1), nj+2,myThid)
194     CALL MDSREADFIELD(fn,prec,'RL',Nr,
195     & gsNm(1-Olx,1-Oly,1,1,1,2), nj+j,myThid)
196     nj = 4*j
197     #else /* ALLOW_ADAMSBASHFORTH_3 */
198     CALL MDSREADFIELD(fn,prec,'RL',Nr,uVel, 1,myThid)
199     CALL MDSREADFIELD(fn,prec,'RL',Nr,guNm1, 2,myThid)
200     CALL MDSREADFIELD(fn,prec,'RL',Nr,vVel, 3,myThid)
201     CALL MDSREADFIELD(fn,prec,'RL',Nr,gvNm1, 4,myThid)
202     CALL MDSREADFIELD(fn,prec,'RL',Nr,theta, 5,myThid)
203     CALL MDSREADFIELD(fn,prec,'RL',Nr,gtNm1, 6,myThid)
204     CALL MDSREADFIELD(fn,prec,'RL',Nr,salt, 7,myThid)
205     CALL MDSREADFIELD(fn,prec,'RL',Nr,gsNm1, 8,myThid)
206     nj = 8
207     #endif /* ALLOW_ADAMSBASHFORTH_3 */
208     CALL MDSREADFIELD(fn,prec,'RL', 1,etaN, nj*Nr+1,myThid)
209     #ifdef EXACT_CONSERV
210     IF (exactConserv) THEN
211     CALL MDSREADFIELD(fn,prec,'RL',1,dEtaHdt,nj*Nr+2,myThid)
212     ENDIF
213     IF (nonlinFreeSurf .GT. 0) THEN
214     CALL MDSREADFIELD(fn,prec,'RL',1,etaH, nj*Nr+3,myThid)
215     ENDIF
216     #endif
217     ENDIF
218    
219     IF ( useDynP_inEos_Zc ) THEN
220     WRITE(fn,'(A,A10)') 'pickup_ph.',suff
221     CALL MDSREADFIELD(fn,prec,'RL',Nr,totPhiHyd,1,myThid)
222     ENDIF
223     #ifdef ALLOW_NONHYDROSTATIC
224     IF ( use3Dsolver ) THEN
225     WRITE(fn,'(A,A10)') 'pickup_nh.',suff
226     CALL MDSREADFIELD(fn,prec,'RL',Nr,phi_nh,1,myThid)
227     c CALL MDSREADFIELD(fn,prec,'RL',Nr, gW,2,myThid)
228     CALL MDSREADFIELD(fn,prec,'RL',Nr, gwNm1,2,myThid)
229     ENDIF
230     #endif
231    
232     #endif /* ALLOW_MDSIO */
233    
234     #endif /* OLD_STYLE_WITH_MANY_FILES */
235    
236     ENDIF
237    
238     #ifdef ALLOW_MNC
239     IF (useMNC .AND. pickup_read_mnc) THEN
240     WRITE(fn,'(A)') 'pickup'
241     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
242     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
243     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
244     CALL MNC_CW_RL_R('D',fn,0,0,'U',uVel, myThid)
245     CALL MNC_CW_RL_R('D',fn,0,0,'V',vVel, myThid)
246     CALL MNC_CW_RL_R('D',fn,0,0,'Temp',theta, myThid)
247     CALL MNC_CW_RL_R('D',fn,0,0,'S',salt, myThid)
248     CALL MNC_CW_RL_R('D',fn,0,0,'Eta',etaN, myThid)
249     #ifndef ALLOW_ADAMSBASHFORTH_3
250     CALL MNC_CW_RL_R('D',fn,0,0,'gUnm1',guNm1, myThid)
251     CALL MNC_CW_RL_R('D',fn,0,0,'gVnm1',gvNm1, myThid)
252     CALL MNC_CW_RL_R('D',fn,0,0,'gTnm1',gtNm1, myThid)
253     CALL MNC_CW_RL_R('D',fn,0,0,'gSnm1',gsNm1, myThid)
254     #endif /* ALLOW_ADAMSBASHFORTH_3 */
255     C#ifdef NONLIN_FRSURF
256     C IF ( nonlinFreeSurf.GE.0 .AND. usePickupBeforeC54 )
257     C & CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
258     C#endif
259     #ifdef EXACT_CONSERV
260     IF (exactConserv) THEN
261     CALL MNC_CW_RL_R('D',fn,0,0,'dEtaHdt',dEtaHdt,myThid)
262     ENDIF
263     IF (nonlinFreeSurf .GT. 0) THEN
264     CALL MNC_CW_RL_R('D',fn,0,0,'EtaH', etaH, myThid)
265     ENDIF
266     #endif
267     #ifdef ALLOW_NONHYDROSTATIC
268     IF (use3Dsolver) THEN
269     CALL MNC_CW_RL_R('D',fn,0,0,'phi_nh', phi_nh, myThid)
270     c CALL MNC_CW_RL_R('D',fn,0,0,'gW', gW, myThid)
271     CALL MNC_CW_RL_R('D',fn,0,0,'gWnm1', gwNm1, myThid)
272     ENDIF
273     #endif
274     IF ( useDynP_inEos_Zc ) THEN
275     CALL MNC_CW_RL_R('D',fn,0,0,'phiHyd',totPhiHyd,myThid)
276     ENDIF
277     ENDIF
278     #endif /* ALLOW_MNC */
279    
280     C _END_MASTER( myThid )
281     _BARRIER
282    
283     C Fill in edge regions
284     CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
285     _EXCH_XYZ_R8(theta , myThid )
286     _EXCH_XYZ_R8(salt , myThid )
287     c CALL EXCH_UV_XYZ_RL(gU,gV,.TRUE.,myThid)
288     c _EXCH_XYZ_R8(gt , myThid )
289     c _EXCH_XYZ_R8(gs , myThid )
290     #ifdef ALLOW_ADAMSBASHFORTH_3
291     CALL EXCH_UV_XYZ_RL(guNm(1-Olx,1-Oly,1,1,1,1),
292     & gvNm(1-Olx,1-Oly,1,1,1,1),.TRUE.,myThid)
293     _EXCH_XYZ_R8( gtNm(1-Olx,1-Oly,1,1,1,1), myThid )
294     _EXCH_XYZ_R8( gsNm(1-Olx,1-Oly,1,1,1,1), myThid )
295     CALL EXCH_UV_XYZ_RL(guNm(1-Olx,1-Oly,1,1,1,2),
296     & gvNm(1-Olx,1-Oly,1,1,1,2),.TRUE.,myThid)
297     _EXCH_XYZ_R8( gtNm(1-Olx,1-Oly,1,1,1,2), myThid )
298     _EXCH_XYZ_R8( gsNm(1-Olx,1-Oly,1,1,1,2), myThid )
299     #else /* ALLOW_ADAMSBASHFORTH_3 */
300     CALL EXCH_UV_XYZ_RL(guNm1,gvNm1,.TRUE.,myThid)
301     _EXCH_XYZ_R8(gtNm1 , myThid )
302     _EXCH_XYZ_R8(gsNm1 , myThid )
303     #endif /* ALLOW_ADAMSBASHFORTH_3 */
304     _EXCH_XY_R8 (etaN, myThid )
305     _EXCH_XY_R8( etaH, myThid )
306     #ifdef EXACT_CONSERV
307     _EXCH_XY_R8( detaHdt, myThid )
308     #endif
309    
310     IF ( useDynP_inEos_Zc )
311     & _EXCH_XYZ_RL( totPhiHyd, myThid )
312    
313     #ifdef ALLOW_NONHYDROSTATIC
314     IF ( use3Dsolver ) THEN
315     _EXCH_XYZ_R8(phi_nh, myThid )
316     c _EXCH_XYZ_R8(gW , myThid )
317     _EXCH_XYZ_R8(gwNm1 , myThid )
318     ENDIF
319     #endif
320    
321     RETURN
322     END
323    
324     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
325     CBOP
326     C !ROUTINE: WRITE_CHECKPOINT
327     C !INTERFACE:
328     SUBROUTINE WRITE_CHECKPOINT(
329     I modelEnd, myTime,
330     I myIter, myThid )
331    
332     C !DESCRIPTION:
333     C This is the controlling routine for IO to write restart (or
334     C ``pickup'' or ``checkpoint'') files. It calls routines from other
335     C packages (\textit{eg.} mdsio and mnc) to do the per-variable
336     C writes.
337     C
338     C Both ``rolling-checkpoint'' files and permanent checkpoint files
339     C are written here. A rolling checkpoint works through a circular
340     C list of suffices. Generally the circular list has two entries so
341     C that a rolling checkpoint will overwrite the last rolling
342     C checkpoint but one. This is useful for running long jobs without
343     C filling too much disk space. In a permanent checkpoint, data is
344     C written suffixed by the current timestep number. Permanent
345     C checkpoints can be used to provide snap-shots from which the
346     C model can be restarted.
347    
348     C !USES:
349     IMPLICIT NONE
350     #include "SIZE.h"
351     #include "EEPARAMS.h"
352     #include "PARAMS.h"
353     LOGICAL DIFFERENT_MULTIPLE
354     EXTERNAL DIFFERENT_MULTIPLE
355     INTEGER IO_ERRCOUNT
356     EXTERNAL IO_ERRCOUNT
357    
358     C !INPUT PARAMETERS:
359     C modelEnd :: Checkpoint call at end of model run.
360     C myThid :: Thread number for this instance of the routine.
361     C myIter :: Iteration number
362     C myTime :: Current time of simulation ( s )
363     LOGICAL modelEnd
364     INTEGER myThid
365     INTEGER myIter
366     _RL myTime
367     CEOP
368    
369     C !LOCAL VARIABLES:
370     C permCheckPoint :: Flag indicating whether a permanent checkpoint will
371     C be written.
372     C tempCheckPoint :: Flag indicating if it is time to write a non-permanent
373     C checkpoint (that will be permanent if permCheckPoint=T)
374     LOGICAL permCheckPoint, tempCheckPoint
375    
376     IF ( .NOT.useOffLine ) THEN
377     permCheckPoint = .FALSE.
378     tempCheckPoint = .FALSE.
379     permCheckPoint =
380     & DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
381     tempCheckPoint =
382     & DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
383    
384     #ifdef ALLOW_CAL
385     IF ( useCAL ) THEN
386     CALL CAL_TIME2DUMP( pChkPtFreq, deltaTClock,
387     U permCheckPoint,
388     I myTime, myIter, myThid )
389     CALL CAL_TIME2DUMP( chkPtFreq, deltaTClock,
390     U tempCheckPoint,
391     I myTime, myIter, myThid )
392     ENDIF
393     #endif
394    
395     IF (
396     & ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
397     & .OR.
398     & ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
399     & ) THEN
400     CALL WRITE_CHECKPOINT_NOW(
401     & permCheckPoint, myTime, myIter, myThid )
402     ENDIF
403    
404     cgmOASIS(
405     c CALL OASIS_RESTART (myTime, myIter, myThid)
406     cgmOASIS)
407    
408     C- if not useOffLine: end
409     ENDIF
410    
411     RETURN
412     END
413    
414     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
415     CBOP
416     C !ROUTINE: WRITE_CHECKPOINT_NOW
417     C !INTERFACE:
418     SUBROUTINE WRITE_CHECKPOINT_NOW(
419     I permCheckPoint, myTime,
420     I myIter, myThid )
421    
422     C !DESCRIPTION:
423     C Write the checkpoint and do it NOW.
424    
425     C !USES:
426     IMPLICIT NONE
427     #include "SIZE.h"
428     #include "EEPARAMS.h"
429     #include "PARAMS.h"
430     #ifdef ALLOW_MNC
431     #include "MNC_PARAMS.h"
432     #endif
433     #include "DYNVARS.h"
434     #include "SURFACE.h"
435     #ifdef ALLOW_NONHYDROSTATIC
436     #include "NH_VARS.h"
437     #endif
438     INTEGER IO_ERRCOUNT
439     EXTERNAL IO_ERRCOUNT
440     COMMON /PCKP_GBLFLS/ globalFile
441     LOGICAL globalFile
442    
443     C !INPUT PARAMETERS:
444     C permCheckPoint :: Is or is not a permanent checkpoint.
445     C myThid :: Thread number for this instance of the routine.
446     C myIter :: Iteration number
447     C myTime :: Current time of simulation ( s )
448     LOGICAL permCheckPoint
449     INTEGER myThid
450     INTEGER myIter
451     _RL myTime
452     CEOP
453    
454     C !LOCAL VARIABLES:
455     C oldPrc :: Temp. for holding I/O precision
456     C fn :: Temp. for building file name string.
457     C lgf :: Flag to indicate whether to use global file mode.
458     #ifdef OLD_STYLE_WITH_MANY_FILES
459     INTEGER oldPrec
460     #endif
461     INTEGER prec
462     INTEGER i, nj
463     CHARACTER*(MAX_LEN_FNAM) fn
464     CHARACTER*(MAX_LEN_MBUF) msgBuf
465     LOGICAL lgf
466    
467     C Write model fields
468     DO i = 1,MAX_LEN_FNAM
469     fn(i:i) = ' '
470     ENDDO
471     IF ( permCheckPoint ) THEN
472     WRITE(fn,'(A,I10.10)') 'pickup.',myIter
473     ELSE
474     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
475     ENDIF
476    
477     C Going to really do some IO. Make everyone except master thread wait.
478     _BARRIER
479     C _BEGIN_MASTER( myThid )
480    
481     IF (pickup_write_mdsio) THEN
482    
483     #ifdef OLD_STYLE_WITH_MANY_FILES
484    
485     C Force 64-bit IO
486     oldPrec = writeBinaryPrec
487     writeBinaryPrec = precFloat64
488     C Write model fields
489     C Raw fields
490     CALL WRITE_REC_XYZ_RL( 'uVel', uVel, 1,myIter,myThid)
491     CALL WRITE_REC_XYZ_RL( 'gU', gU, 1,myIter,myThid)
492     CALL WRITE_REC_XYZ_RL( 'gUNm1', guNm1, 1,myIter,myThid)
493     CALL WRITE_REC_XYZ_RL( 'vVel', vVel, 1,myIter,myThid)
494     CALL WRITE_REC_XYZ_RL( 'gV', gV, 1,myIter,myThid)
495     CALL WRITE_REC_XYZ_RL( 'gVNm1', gvNm1, 1,myIter,myThid)
496     CALL WRITE_REC_XYZ_RL( 'theta', theta, 1,myIter,myThid)
497     CALL WRITE_REC_XYZ_RL( 'gT', gT, 1,myIter,myThid)
498     CALL WRITE_REC_XYZ_RL( 'gTNm1', gtNm1, 1,myIter,myThid)
499     CALL WRITE_REC_XYZ_RL( 'salt', salt, 1,myIter,myThid)
500     CALL WRITE_REC_XYZ_RL( 'gS', gS, 1,myIter,myThid)
501     CALL WRITE_REC_XYZ_RL( 'gSNm1', gsNm1, 1,myIter,myThid)
502     CALL WRITE_REC_XY_RL ( 'etaN', etaN, 1,myIter,myThid)
503     #ifdef ALLOW_NONHYDROSTATIC
504     IF ( use3Dsolver ) THEN
505     CALL WRITE_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
506     c CALL WRITE_REC_XYZ_RL( 'gW', gW,1,myIter,myThid)
507     CALL WRITE_REC_XYZ_RL( 'gWnm1', gwNm1,1,myIter,myThid)
508     ENDIF
509     #endif
510     C Reset binary precision
511     writeBinaryPrec = oldPrec
512    
513     #else /* OLD_STYLE_WITH_MANY_FILES */
514    
515     prec = precFloat64
516     lgf = globalFile
517    
518     #ifdef ALLOW_MDSIO
519    
520     #ifdef ALLOW_ADAMSBASHFORTH_3
521     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
522     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
523     & guNm(1-Olx,1-Oly,1,1,1,1), 2,myIter,myThid)
524     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
525     & guNm(1-Olx,1-Oly,1,1,1,2), 3,myIter,myThid)
526     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 4,myIter,myThid)
527     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
528     & gvNm(1-Olx,1-Oly,1,1,1,1), 5,myIter,myThid)
529     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
530     & gvNm(1-Olx,1-Oly,1,1,1,2), 6,myIter,myThid)
531     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta, 7,myIter,myThid)
532     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
533     & gtNm(1-Olx,1-Oly,1,1,1,1), 8,myIter,myThid)
534     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
535     & gtNm(1-Olx,1-Oly,1,1,1,2), 9,myIter,myThid)
536     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 10,myIter,myThid)
537     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
538     & gsNm(1-Olx,1-Oly,1,1,1,1),11,myIter,myThid)
539     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
540     & gsNm(1-Olx,1-Oly,1,1,1,2),12,myIter,myThid)
541     nj = 12
542     #else /* ALLOW_ADAMSBASHFORTH_3 */
543     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
544     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,guNm1,2,myIter,myThid)
545     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 3,myIter,myThid)
546     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gvNm1,4,myIter,myThid)
547     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta,5,myIter,myThid)
548     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gtNm1,6,myIter,myThid)
549     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 7,myIter,myThid)
550     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gsNm1,8,myIter,myThid)
551     nj = 8
552     #endif /* ALLOW_ADAMSBASHFORTH_3 */
553     CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaN, nj*Nr+1,
554     & myIter,myThid)
555     #ifdef EXACT_CONSERV
556     CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,dEtaHdt,nj*Nr+2,
557     & myIter,myThid)
558     CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaHnm1,nj*Nr+3,
559     & myIter,myThid)
560     #endif /* EXACT_CONSERV */
561     IF ( useDynP_inEos_Zc ) THEN
562     IF ( permCheckPoint ) THEN
563     WRITE(fn,'(A,I10.10)') 'pickup_ph.',myIter
564     ELSE
565     WRITE(fn,'(A,A)') 'pickup_ph.',checkPtSuff(nCheckLev)
566     ENDIF
567     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,totPhiHyd,
568     & 1,myIter,myThid)
569     ENDIF
570     #ifdef ALLOW_NONHYDROSTATIC
571     IF ( use3Dsolver ) THEN
572     IF ( permCheckPoint ) THEN
573     WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
574     ELSE
575     WRITE(fn,'(A,A)') 'pickup_nh.',checkPtSuff(nCheckLev)
576     ENDIF
577     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,phi_nh, 1,
578     & myIter,myThid)
579     c CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gW, 2,
580     c & myIter,myThid)
581     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gwNm1, 2,
582     & myIter,myThid)
583     ENDIF
584     #endif /* ALLOW_NONHYDROSTATIC */
585    
586     #endif /* ALLOW_MDSIO */
587    
588     #endif /* OLD_STYLE_WITH_MANY_FILES */
589    
590     ENDIF
591    
592     #ifdef ALLOW_MNC
593     IF (useMNC .AND. pickup_write_mnc) THEN
594     IF ( permCheckPoint ) THEN
595     WRITE(fn,'(A)') 'pickup'
596     ELSE
597     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
598     ENDIF
599     C First ***define*** the file group name
600     CALL MNC_CW_SET_UDIM(fn, 0, myThid)
601     IF ( permCheckPoint ) THEN
602     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
603     ELSE
604     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
605     ENDIF
606     C Then set the actual unlimited dimension
607     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
608     CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
609     CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
610     CALL MNC_CW_RL_W('D',fn,0,0,'U', uVel, myThid)
611     CALL MNC_CW_RL_W('D',fn,0,0,'V', vVel, myThid)
612     CALL MNC_CW_RL_W('D',fn,0,0,'Temp', theta, myThid)
613     CALL MNC_CW_RL_W('D',fn,0,0,'S', salt, myThid)
614     CALL MNC_CW_RL_W('D',fn,0,0,'Eta', etaN, myThid)
615     #ifndef ALLOW_ADAMSBASHFORTH_3
616     CALL MNC_CW_RL_W('D',fn,0,0,'gUnm1', guNm1, myThid)
617     CALL MNC_CW_RL_W('D',fn,0,0,'gVnm1', gvNm1, myThid)
618     CALL MNC_CW_RL_W('D',fn,0,0,'gTnm1', gtNm1, myThid)
619     CALL MNC_CW_RL_W('D',fn,0,0,'gSnm1', gsNm1, myThid)
620     #endif /* ALLOW_ADAMSBASHFORTH_3 */
621     #ifdef EXACT_CONSERV
622     CALL MNC_CW_RL_W('D',fn,0,0,'dEtaHdt', dEtaHdt, myThid)
623     CALL MNC_CW_RL_W('D',fn,0,0,'EtaH', etaHnm1, myThid)
624     #endif
625     #ifdef ALLOW_NONHYDROSTATIC
626     IF ( use3Dsolver ) THEN
627     CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)
628     c CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)
629     CALL MNC_CW_RL_W('D',fn,0,0,'gWnm1', gwNm1, myThid)
630     ENDIF
631     #endif
632     IF ( useDynP_inEos_Zc ) THEN
633     CALL MNC_CW_RL_W('D',fn,0,0,'phiHyd', totPhiHyd, myThid)
634     ENDIF
635     ENDIF
636     #endif /* ALLOW_MNC */
637    
638     C Write suffix for stdout information
639     IF ( permCheckPoint ) THEN
640     WRITE(fn,'(I10.10)') myIter
641     ELSE
642     WRITE(fn,'(A)') checkPtSuff(nCheckLev)
643     ENDIF
644    
645     IF ( .NOT. permCheckPoint ) THEN
646     nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
647     ENDIF
648    
649     C _END_MASTER(myThid)
650     _BARRIER
651    
652     C Write information to stdout so there is a record that the
653     C checkpoint was completed
654     _BEGIN_MASTER(myThid)
655     WRITE(msgBuf,'(A11,I10,1X,A10)')
656     & "%CHECKPOINT ",myIter,fn
657     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
658     _END_MASTER(myThid)
659    
660     RETURN
661     END
  ViewVC Help
Powered by ViewVC 1.1.22