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

Annotation of /MITgcm/model/src/checkpoint.F

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


Revision 1.59 - (hide annotations) (download)
Tue Nov 8 02:14:10 2005 UTC (18 years, 7 months ago) by jmc
Branch: MAIN
Changes since 1.58: +3 -5 lines
put all NH variables (formely in DYNVARS.h & GW.h) in NH_VARS.h

1 jmc 1.59 C $Header: /u/gcmpack/MITgcm/model/src/checkpoint.F,v 1.58 2005/11/04 01:19:24 jmc Exp $
2 adcroft 1.10 C $Name: $
3 adcroft 1.1
4 edhill 1.25 #include "PACKAGES_CONFIG.h"
5 adcroft 1.1 #include "CPP_OPTIONS.h"
6    
7 edhill 1.41 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 adcroft 1.1
13 edhill 1.41 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 adcroft 1.1 IMPLICIT NONE
27 edhill 1.41
28     C !INPUT PARAMETERS:
29 adcroft 1.1 LOGICAL flag
30 edhill 1.41 CEOP
31 adcroft 1.1 COMMON /PCKP_GBLFLS/ globalFile
32     LOGICAL globalFile
33 edhill 1.41
34     globalFile = flag
35    
36 adcroft 1.1 RETURN
37     END
38    
39 edhill 1.41 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
40 cnh 1.14 CBOP
41     C !ROUTINE: READ_CHECKPOINT
42     C !INTERFACE:
43 edhill 1.41 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 cnh 1.14 C !USES:
53 adcroft 1.1 IMPLICIT NONE
54     #include "SIZE.h"
55     #include "EEPARAMS.h"
56     #include "PARAMS.h"
57 edhill 1.49 #ifdef ALLOW_MNC
58     #include "MNC_PARAMS.h"
59     #endif
60 adcroft 1.1 #include "DYNVARS.h"
61 jmc 1.43 #include "SURFACE.h"
62 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
63 jmc 1.59 #include "NH_VARS.h"
64 adcroft 1.1 #endif
65     INTEGER IO_ERRCOUNT
66     EXTERNAL IO_ERRCOUNT
67    
68 cnh 1.14 C !INPUT/OUTPUT PARAMETERS:
69 adcroft 1.1 C myThid - Thread number for this instance of the routine.
70 jmc 1.5 C myIter - Iteration number
71 adcroft 1.1 INTEGER myThid
72 jmc 1.5 INTEGER myIter
73 edhill 1.41 CEOP
74 adcroft 1.1
75 cnh 1.14 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 jmc 1.58 INTEGER prec
80     INTEGER i, nj
81 adcroft 1.1 CHARACTER*(MAX_LEN_FNAM) fn
82 adcroft 1.21 CHARACTER*(10) suff
83 jmc 1.58 #ifdef OLD_STYLE_WITH_MANY_FILES
84     INTEGER oldPrec
85     #endif
86     #ifdef ALLOW_ADAMSBASHFORTH_3
87     INTEGER j
88     #endif
89 adcroft 1.1
90 edhill 1.44 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 edhill 1.41 _BARRIER
103     _BEGIN_MASTER( myThid )
104 adcroft 1.1
105 edhill 1.44 IF (pickup_read_mdsio) THEN
106    
107 jmc 1.31 #ifdef OLD_STYLE_WITH_MANY_FILES
108    
109 edhill 1.44 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 jmc 1.53 CALL READ_REC_XYZ_RL( 'guNm1', guNm1, 1,myIter,myThid)
118 edhill 1.44 CALL READ_REC_XYZ_RL( 'vVel', vVel, 1,myIter,myThid)
119     CALL READ_REC_XYZ_RL( 'gV', gV, 1,myIter,myThid)
120 jmc 1.53 CALL READ_REC_XYZ_RL( 'gvNm1', gvNm1, 1,myIter,myThid)
121 edhill 1.44 CALL READ_REC_XYZ_RL( 'theta', theta, 1,myIter,myThid)
122     CALL READ_REC_XYZ_RL( 'gT', gT, 1,myIter,myThid)
123 jmc 1.53 CALL READ_REC_XYZ_RL( 'gtNm1', gtNm1, 1,myIter,myThid)
124 edhill 1.44 CALL READ_REC_XYZ_RL( 'salt', salt, 1,myIter,myThid)
125     CALL READ_REC_XYZ_RL( 'gS', gS, 1,myIter,myThid)
126 jmc 1.53 CALL READ_REC_XYZ_RL( 'gsNm1', gsNm1, 1,myIter,myThid)
127 edhill 1.44 CALL READ_REC_XY_RL ( 'etaN', etaN, 1,myIter,myThid)
128    
129 edhill 1.41 #ifdef ALLOW_NONHYDROSTATIC
130 edhill 1.44 IF ( nonHydrostatic ) THEN
131     CALL READ_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
132     CALL READ_REC_XYZ_RL( 'gW', gW,1,myIter,myThid)
133     c CALL READ_REC_XYZ_RL( 'gWnm1', gWnm1,1,myIter,myThid)
134     ENDIF
135 edhill 1.41 #endif
136 cheisey 1.16
137 edhill 1.44 C Reset default IO precision
138     readBinaryPrec = oldPrec
139 edhill 1.41
140     #else /* OLD_STYLE_WITH_MANY_FILES */
141    
142 edhill 1.44 prec = precFloat64
143    
144 jmc 1.53 #ifdef ALLOW_MDSIO
145    
146 edhill 1.44 C Read model fields
147     IF ( usePickupBeforeC54 ) THEN
148 jmc 1.53 #ifndef ALLOW_ADAMSBASHFORTH_3
149 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,uVel, 1,myThid)
150     CALL MDSREADFIELD(fn,prec,'RL',Nr,gU, 2,myThid)
151 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,guNm1, 3,myThid)
152 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,vVel, 4,myThid)
153     CALL MDSREADFIELD(fn,prec,'RL',Nr,gV, 5,myThid)
154 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,gvNm1, 6,myThid)
155 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,theta, 7,myThid)
156     CALL MDSREADFIELD(fn,prec,'RL',Nr,gT, 8,myThid)
157 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,gtNm1, 9,myThid)
158 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,salt, 10,myThid)
159     CALL MDSREADFIELD(fn,prec,'RL',Nr,gS, 11,myThid)
160 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,gsNm1, 12,myThid)
161     #endif /* ALLOW_ADAMSBASHFORTH_3 */
162 edhill 1.44 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 jmc 1.53 #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 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,uVel, 1,myThid)
199 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,guNm1, 2,myThid)
200 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,vVel, 3,myThid)
201 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,gvNm1, 4,myThid)
202 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,theta, 5,myThid)
203 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',Nr,gtNm1, 6,myThid)
204 edhill 1.44 CALL MDSREADFIELD(fn,prec,'RL',Nr,salt, 7,myThid)
205 jmc 1.53 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 edhill 1.44 #ifdef EXACT_CONSERV
210     IF (exactConserv) THEN
211 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',1,dEtaHdt,nj*Nr+2,myThid)
212 edhill 1.44 ENDIF
213     IF (nonlinFreeSurf .GT. 0) THEN
214 jmc 1.53 CALL MDSREADFIELD(fn,prec,'RL',1,etaH, nj*Nr+3,myThid)
215 edhill 1.44 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 ( nonHydrostatic ) THEN
225     WRITE(fn,'(A,A10)') 'pickup_nh.',suff
226     CALL MDSREADFIELD(fn,prec,'RL',Nr,phi_nh,1,myThid)
227     CALL MDSREADFIELD(fn,prec,'RL',Nr, gW,2,myThid)
228     c CALL MDSREADFIELD(fn,prec,'RL',Nr, gWnm1,3,myThid)
229     ENDIF
230     #endif
231    
232 jmc 1.53 #endif /* ALLOW_MDSIO */
233    
234 edhill 1.44 #endif /* OLD_STYLE_WITH_MANY_FILES */
235    
236 edhill 1.41 ENDIF
237    
238     #ifdef ALLOW_MNC
239 edhill 1.45 IF (useMNC .AND. pickup_read_mnc) THEN
240 edhill 1.56 WRITE(fn,'(A)') 'pickup'
241 edhill 1.41 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
242     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
243 edhill 1.56 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
244 edhill 1.41 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 edhill 1.46 CALL MNC_CW_RL_R('D',fn,0,0,'Temp',theta, myThid)
247 edhill 1.41 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 jmc 1.53 #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 edhill 1.44 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 jmc 1.43 #ifdef EXACT_CONSERV
260 edhill 1.44 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 jmc 1.43 ENDIF
266     #endif
267 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
268 edhill 1.44 IF (nonHydrostatic) THEN
269 edhill 1.41 CALL MNC_CW_RL_R('D',fn,0,0,'phi_nh', phi_nh, myThid)
270     CALL MNC_CW_RL_R('D',fn,0,0,'gW', gW, myThid)
271 adcroft 1.1 ENDIF
272     #endif
273 jmc 1.42 IF ( useDynP_inEos_Zc ) THEN
274 edhill 1.44 CALL MNC_CW_RL_R('D',fn,0,0,'phiHyd',totPhiHyd,myThid)
275 jmc 1.42 ENDIF
276 edhill 1.41 ENDIF
277     #endif /* ALLOW_MNC */
278 edhill 1.34
279 edhill 1.38 _END_MASTER( myThid )
280     _BARRIER
281 edhill 1.41
282 edhill 1.44 C Fill in edge regions
283 adcroft 1.9 CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
284 adcroft 1.1 _EXCH_XYZ_R8(theta , myThid )
285     _EXCH_XYZ_R8(salt , myThid )
286 jmc 1.53 c CALL EXCH_UV_XYZ_RL(gU,gV,.TRUE.,myThid)
287     c _EXCH_XYZ_R8(gt , myThid )
288     c _EXCH_XYZ_R8(gs , myThid )
289     #ifdef ALLOW_ADAMSBASHFORTH_3
290     CALL EXCH_UV_XYZ_RL(guNm(1-Olx,1-Oly,1,1,1,1),
291     & gvNm(1-Olx,1-Oly,1,1,1,1),.TRUE.,myThid)
292     _EXCH_XYZ_R8( gtNm(1-Olx,1-Oly,1,1,1,1), myThid )
293     _EXCH_XYZ_R8( gsNm(1-Olx,1-Oly,1,1,1,1), myThid )
294     CALL EXCH_UV_XYZ_RL(guNm(1-Olx,1-Oly,1,1,1,2),
295     & gvNm(1-Olx,1-Oly,1,1,1,2),.TRUE.,myThid)
296     _EXCH_XYZ_R8( gtNm(1-Olx,1-Oly,1,1,1,2), myThid )
297     _EXCH_XYZ_R8( gsNm(1-Olx,1-Oly,1,1,1,2), myThid )
298     #else /* ALLOW_ADAMSBASHFORTH_3 */
299     CALL EXCH_UV_XYZ_RL(guNm1,gvNm1,.TRUE.,myThid)
300     _EXCH_XYZ_R8(gtNm1 , myThid )
301     _EXCH_XYZ_R8(gsNm1 , myThid )
302     #endif /* ALLOW_ADAMSBASHFORTH_3 */
303 jmc 1.6 _EXCH_XY_R8 (etaN, myThid )
304 jmc 1.53 _EXCH_XY_R8( etaH, myThid )
305 jmc 1.43 #ifdef EXACT_CONSERV
306     _EXCH_XY_R8( detaHdt, myThid )
307     #endif
308    
309 jmc 1.19 IF ( useDynP_inEos_Zc )
310 edhill 1.41 & _EXCH_XYZ_RL( totPhiHyd, myThid )
311 jmc 1.19
312 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
313 edhill 1.41 IF ( nonHydrostatic ) THEN
314     _EXCH_XYZ_R8(phi_nh, myThid )
315     _EXCH_XYZ_R8(gW , myThid )
316     c _EXCH_XYZ_R8(gWNM1 , myThid )
317     ENDIF
318 adcroft 1.1 #endif
319 edhill 1.44
320 adcroft 1.1 RETURN
321     END
322    
323 edhill 1.41 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
324 cnh 1.14 CBOP
325     C !ROUTINE: WRITE_CHECKPOINT
326     C !INTERFACE:
327 edhill 1.41 SUBROUTINE WRITE_CHECKPOINT(
328     I modelEnd, myTime,
329     I myIter, myThid )
330    
331     C !DESCRIPTION:
332     C This is the controlling routine for IO to write restart (or
333     C ``pickup'' or ``checkpoint'') files. It calls routines from other
334     C packages (\textit{eg.} mdsio and mnc) to do the per-variable
335     C writes.
336     C
337     C Both ``rolling-checkpoint'' files and permanent checkpoint files
338     C are written here. A rolling checkpoint works through a circular
339     C list of suffices. Generally the circular list has two entries so
340     C that a rolling checkpoint will overwrite the last rolling
341     C checkpoint but one. This is useful for running long jobs without
342     C filling too much disk space. In a permanent checkpoint, data is
343     C written suffixed by the current timestep number. Permanent
344     C checkpoints can be used to provide snap-shots from which the
345     C model can be restarted.
346 cnh 1.14
347     C !USES:
348 adcroft 1.1 IMPLICIT NONE
349     #include "SIZE.h"
350     #include "EEPARAMS.h"
351     #include "PARAMS.h"
352 edhill 1.49 #ifdef ALLOW_MNC
353     #include "MNC_PARAMS.h"
354     #endif
355 jmc 1.54 LOGICAL DIFFERENT_MULTIPLE
356     EXTERNAL DIFFERENT_MULTIPLE
357 adcroft 1.1 INTEGER IO_ERRCOUNT
358     EXTERNAL IO_ERRCOUNT
359    
360 edhill 1.41 C !INPUT PARAMETERS:
361     C modelEnd :: Checkpoint call at end of model run.
362     C myThid :: Thread number for this instance of the routine.
363     C myIter :: Iteration number
364     C myTime :: Current time of simulation ( s )
365 adcroft 1.1 LOGICAL modelEnd
366     INTEGER myThid
367 jmc 1.5 INTEGER myIter
368 adcroft 1.15 _RL myTime
369 edhill 1.41 CEOP
370 adcroft 1.1
371 cnh 1.14 C !LOCAL VARIABLES:
372     C permCheckPoint :: Flag indicating whether a permanent checkpoint will
373     C be written.
374 jmc 1.31 C tempCheckPoint :: Flag indicating if it is time to write a non-permanent
375     C checkpoint (that will be permanent if permCheckPoint=T)
376     LOGICAL permCheckPoint, tempCheckPoint
377 jmc 1.58 #ifdef ALLOW_CAL
378 dimitri 1.51 INTEGER thisdate(4), prevdate(4)
379 jmc 1.58 #endif
380 dimitri 1.51
381 adcroft 1.1 permCheckPoint = .FALSE.
382 jmc 1.31 tempCheckPoint = .FALSE.
383 edhill 1.41 permCheckPoint =
384 jmc 1.54 & DIFFERENT_MULTIPLE(pChkptFreq,myTime,deltaTClock)
385 edhill 1.41 tempCheckPoint =
386 jmc 1.54 & DIFFERENT_MULTIPLE( ChkptFreq,myTime,deltaTClock)
387 dimitri 1.51
388     #ifdef ALLOW_CAL
389     IF ( calendarDumps ) THEN
390     C-- Convert approximate months (30-31 days) and years (360-372 days)
391     C to exact calendar months and years.
392     C- First determine calendar dates for this and previous time step.
393     call cal_GetDate( myiter ,mytime ,thisdate,mythid )
394     call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )
395     C- Monthly pChkptFreq:
396     IF( pChkptFreq.GE. 2592000 .AND. pChkptFreq.LE. 2678400 ) THEN
397     permCheckPoint = .FALSE.
398     IF((thisdate(1)-prevdate(1)) .GT. 50 )permCheckPoint=.TRUE.
399     ENDIF
400     C- Yearly pChkptFreq:
401     IF( pChkptFreq.GE.31104000 .AND. pChkptFreq.LE.31968000 ) THEN
402     permCheckPoint = .FALSE.
403     IF((thisdate(1)-prevdate(1)) .GT. 5000)permCheckPoint=.TRUE.
404     ENDIF
405     C- Monthly ChkptFreq:
406     IF( ChkptFreq.GE. 2592000 .AND. ChkptFreq.LE. 2678400 ) THEN
407     tempCheckPoint = .FALSE.
408     IF((thisdate(1)-prevdate(1)) .GT. 50 )tempCheckPoint=.TRUE.
409     ENDIF
410     C- Yearly ChkptFreq:
411     IF( ChkptFreq.GE.31104000 .AND. ChkptFreq.LE.31968000 ) THEN
412     tempCheckPoint = .FALSE.
413     IF((thisdate(1)-prevdate(1)) .GT. 5000)tempCheckPoint=.TRUE.
414     ENDIF
415     ENDIF
416     #endif
417    
418 adcroft 1.1 IF (
419 edhill 1.41 & ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
420     & .OR.
421     & ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
422     & ) THEN
423    
424 edhill 1.44 CALL WRITE_CHECKPOINT_NOW(
425     & permCheckPoint, myTime, myIter, myThid )
426    
427    
428     ENDIF
429     RETURN
430     END
431    
432     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
433     CBOP
434     C !ROUTINE: WRITE_CHECKPOINT_NOW
435     C !INTERFACE:
436     SUBROUTINE WRITE_CHECKPOINT_NOW(
437     I permCheckPoint, myTime,
438     I myIter, myThid )
439    
440     C !DESCRIPTION:
441     C Write the checkpoint and do it NOW.
442    
443     C !USES:
444     IMPLICIT NONE
445     #include "SIZE.h"
446     #include "EEPARAMS.h"
447     #include "PARAMS.h"
448     #ifdef ALLOW_MNC
449     #include "MNC_PARAMS.h"
450     #endif
451     #include "DYNVARS.h"
452     #include "SURFACE.h"
453     #ifdef ALLOW_NONHYDROSTATIC
454 jmc 1.59 #include "NH_VARS.h"
455 edhill 1.44 #endif
456     INTEGER IO_ERRCOUNT
457     EXTERNAL IO_ERRCOUNT
458     COMMON /PCKP_GBLFLS/ globalFile
459     LOGICAL globalFile
460    
461     C !INPUT PARAMETERS:
462     C permCheckPoint :: Is or is not a permanent checkpoint.
463     C myThid :: Thread number for this instance of the routine.
464     C myIter :: Iteration number
465     C myTime :: Current time of simulation ( s )
466     LOGICAL permCheckPoint
467     INTEGER myThid
468     INTEGER myIter
469     _RL myTime
470     CEOP
471    
472     C !LOCAL VARIABLES:
473     C oldPrc :: Temp. for holding I/O precision
474     C fn :: Temp. for building file name string.
475     C lgf :: Flag to indicate whether to use global file mode.
476 jmc 1.58 #ifdef OLD_STYLE_WITH_MANY_FILES
477     INTEGER oldPrec
478     #endif
479     INTEGER prec
480 jmc 1.53 INTEGER i, nj
481 edhill 1.44 CHARACTER*(MAX_LEN_FNAM) fn
482     CHARACTER*(MAX_LEN_MBUF) msgBuf
483     LOGICAL lgf
484    
485     C Write model fields
486     DO i = 1,MAX_LEN_FNAM
487     fn(i:i) = ' '
488     ENDDO
489     IF ( permCheckPoint ) THEN
490     WRITE(fn,'(A,I10.10)') 'pickup.',myIter
491     ELSE
492     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
493     ENDIF
494    
495     C Going to really do some IO. Make everyone except master thread wait.
496     _BARRIER
497     _BEGIN_MASTER( myThid )
498    
499     IF (pickup_write_mdsio) THEN
500 adcroft 1.1
501 jmc 1.31 #ifdef OLD_STYLE_WITH_MANY_FILES
502 edhill 1.41
503 adcroft 1.1 C Force 64-bit IO
504     oldPrec = writeBinaryPrec
505     writeBinaryPrec = precFloat64
506 edhill 1.44 C Write model fields
507 adcroft 1.1 C Raw fields
508 edhill 1.44 CALL WRITE_REC_XYZ_RL( 'uVel', uVel, 1,myIter,myThid)
509     CALL WRITE_REC_XYZ_RL( 'gU', gU, 1,myIter,myThid)
510     CALL WRITE_REC_XYZ_RL( 'gUNm1', gUNm1, 1,myIter,myThid)
511     CALL WRITE_REC_XYZ_RL( 'vVel', vVel, 1,myIter,myThid)
512     CALL WRITE_REC_XYZ_RL( 'gV', gV, 1,myIter,myThid)
513     CALL WRITE_REC_XYZ_RL( 'gVNm1', gVNm1, 1,myIter,myThid)
514     CALL WRITE_REC_XYZ_RL( 'theta', theta, 1,myIter,myThid)
515     CALL WRITE_REC_XYZ_RL( 'gT', gT, 1,myIter,myThid)
516     CALL WRITE_REC_XYZ_RL( 'gTNm1', gTNm1, 1,myIter,myThid)
517     CALL WRITE_REC_XYZ_RL( 'salt', salt, 1,myIter,myThid)
518     CALL WRITE_REC_XYZ_RL( 'gS', gS, 1,myIter,myThid)
519     CALL WRITE_REC_XYZ_RL( 'gSNm1', gSNm1, 1,myIter,myThid)
520     CALL WRITE_REC_XY_RL ( 'etaN', etaN, 1,myIter,myThid)
521 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
522     IF ( nonHydrostatic ) THEN
523 edhill 1.41 CALL WRITE_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
524 edhill 1.44 CALL WRITE_REC_XYZ_RL( 'gW', gW,1,myIter,myThid)
525     C CALL WRITE_REC_XYZ_RL( 'gWnm1', gWnm1,1,myIter,myThid)
526 adcroft 1.1 ENDIF
527     #endif
528 edhill 1.44 C Reset binary precision
529 jmc 1.31 writeBinaryPrec = oldPrec
530 edhill 1.44
531 jmc 1.11 #else /* OLD_STYLE_WITH_MANY_FILES */
532 edhill 1.41
533 adcroft 1.1 prec = precFloat64
534     lgf = globalFile
535 edhill 1.41
536 jmc 1.53 #ifdef ALLOW_MDSIO
537    
538     #ifdef ALLOW_ADAMSBASHFORTH_3
539     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
540     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
541     & guNm(1-Olx,1-Oly,1,1,1,1), 2,myIter,myThid)
542     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
543     & guNm(1-Olx,1-Oly,1,1,1,2), 3,myIter,myThid)
544     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 4,myIter,myThid)
545     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
546     & gvNm(1-Olx,1-Oly,1,1,1,1), 5,myIter,myThid)
547     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
548     & gvNm(1-Olx,1-Oly,1,1,1,2), 6,myIter,myThid)
549     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta, 7,myIter,myThid)
550     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
551     & gtNm(1-Olx,1-Oly,1,1,1,1), 8,myIter,myThid)
552     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
553     & gtNm(1-Olx,1-Oly,1,1,1,2), 9,myIter,myThid)
554     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 10,myIter,myThid)
555     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
556     & gsNm(1-Olx,1-Oly,1,1,1,1),11,myIter,myThid)
557     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
558     & gsNm(1-Olx,1-Oly,1,1,1,2),12,myIter,myThid)
559     nj = 12
560     #else /* ALLOW_ADAMSBASHFORTH_3 */
561 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
562 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,guNm1,2,myIter,myThid)
563 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 3,myIter,myThid)
564 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gvNm1,4,myIter,myThid)
565 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta,5,myIter,myThid)
566 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gtNm1,6,myIter,myThid)
567 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 7,myIter,myThid)
568 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gsNm1,8,myIter,myThid)
569     nj = 8
570     #endif /* ALLOW_ADAMSBASHFORTH_3 */
571     CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaN, nj*Nr+1,
572 edhill 1.44 & myIter,myThid)
573 jmc 1.43 #ifdef EXACT_CONSERV
574 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,dEtaHdt,nj*Nr+2,
575 edhill 1.44 & myIter,myThid)
576 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaHnm1,nj*Nr+3,
577 edhill 1.44 & myIter,myThid)
578     #endif /* EXACT_CONSERV */
579     IF ( useDynP_inEos_Zc ) THEN
580     IF ( permCheckPoint ) THEN
581     WRITE(fn,'(A,I10.10)') 'pickup_ph.',myIter
582     ELSE
583     WRITE(fn,'(A,A)') 'pickup_ph.',checkPtSuff(nCheckLev)
584     ENDIF
585     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,totPhiHyd,
586     & 1,myIter,myThid)
587     ENDIF
588 edhill 1.41 #ifdef ALLOW_NONHYDROSTATIC
589 edhill 1.44 IF ( nonHydrostatic ) THEN
590     IF ( permCheckPoint ) THEN
591     WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
592     ELSE
593     WRITE(fn,'(A,A)') 'pickup_nh.',checkPtSuff(nCheckLev)
594 edhill 1.41 ENDIF
595 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,phi_nh, 1,
596     & myIter,myThid)
597     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gW, 2,
598 edhill 1.41 & myIter,myThid)
599 edhill 1.44 C CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gWnm1, 3,
600     C & myIter,myThid)
601 edhill 1.41 ENDIF
602 edhill 1.44 #endif /* ALLOW_NONHYDROSTATIC */
603 edhill 1.34
604 jmc 1.53 #endif /* ALLOW_MDSIO */
605    
606 edhill 1.41 #endif /* OLD_STYLE_WITH_MANY_FILES */
607 heimbach 1.8
608 edhill 1.44 ENDIF
609    
610     #ifdef ALLOW_MNC
611 edhill 1.45 IF (useMNC .AND. pickup_write_mnc) THEN
612 edhill 1.56 IF ( permCheckPoint ) THEN
613     WRITE(fn,'(A)') 'pickup'
614     ELSE
615     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
616     ENDIF
617 edhill 1.57 C First ***define*** the file group name
618     CALL MNC_CW_SET_UDIM(fn, 0, myThid)
619 edhill 1.56 IF ( permCheckPoint ) THEN
620     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
621     ELSE
622     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
623     ENDIF
624 edhill 1.57 C Then set the actual unlimited dimension
625     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
626 edhill 1.55 CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
627     CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
628 edhill 1.44 CALL MNC_CW_RL_W('D',fn,0,0,'U', uVel, myThid)
629     CALL MNC_CW_RL_W('D',fn,0,0,'V', vVel, myThid)
630 edhill 1.46 CALL MNC_CW_RL_W('D',fn,0,0,'Temp', theta, myThid)
631 edhill 1.44 CALL MNC_CW_RL_W('D',fn,0,0,'S', salt, myThid)
632     CALL MNC_CW_RL_W('D',fn,0,0,'Eta', etaN, myThid)
633 jmc 1.53 #ifndef ALLOW_ADAMSBASHFORTH_3
634     CALL MNC_CW_RL_W('D',fn,0,0,'gUnm1', guNm1, myThid)
635     CALL MNC_CW_RL_W('D',fn,0,0,'gVnm1', gvNm1, myThid)
636     CALL MNC_CW_RL_W('D',fn,0,0,'gTnm1', gtNm1, myThid)
637     CALL MNC_CW_RL_W('D',fn,0,0,'gSnm1', gsNm1, myThid)
638     #endif /* ALLOW_ADAMSBASHFORTH_3 */
639 edhill 1.44 #ifdef EXACT_CONSERV
640     CALL MNC_CW_RL_W('D',fn,0,0,'dEtaHdt', dEtaHdt, myThid)
641     CALL MNC_CW_RL_W('D',fn,0,0,'EtaH', etaHnm1, myThid)
642     #endif
643     #ifdef ALLOW_NONHYDROSTATIC
644     IF ( nonHydrostatic ) THEN
645     CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)
646     CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)
647 jmc 1.32 ENDIF
648 edhill 1.44 #endif
649     IF ( useDynP_inEos_Zc ) THEN
650     CALL MNC_CW_RL_W('D',fn,0,0,'phiHyd', totPhiHyd, myThid)
651 adcroft 1.1 ENDIF
652     ENDIF
653 edhill 1.44 #endif /* ALLOW_MNC */
654 adcroft 1.1
655 edhill 1.44 C Write suffix for stdout information
656     IF ( permCheckPoint ) THEN
657     WRITE(fn,'(I10.10)') myIter
658     ELSE
659     WRITE(fn,'(A)') checkPtSuff(nCheckLev)
660     ENDIF
661    
662     IF ( .NOT. permCheckPoint ) THEN
663     nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
664     ENDIF
665    
666     _END_MASTER(myThid)
667     _BARRIER
668    
669     C Write information to stdout so there is a record that the
670     C checkpoint was completed
671     _BEGIN_MASTER(myThid)
672     WRITE(msgBuf,'(A11,I10,1X,A10)')
673     & "%CHECKPOINT ",myIter,fn
674     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
675     _END_MASTER(myThid)
676    
677 adcroft 1.1 RETURN
678     END

  ViewVC Help
Powered by ViewVC 1.1.22