/[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.61 - (hide annotations) (download)
Thu Dec 15 02:06:06 2005 UTC (18 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58, checkpoint58a_post, checkpoint57z_post
Changes since 1.60: +20 -18 lines
cycle gW,gwNm1 like other tendencies (gU,gT ...) and write gwNm1 to pickup file

1 jmc 1.61 C $Header: /u/gcmpack/MITgcm/model/src/checkpoint.F,v 1.60 2005/11/08 23:01:10 cnh 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 cnh 1.60 C _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 jmc 1.61 c CALL READ_REC_XYZ_RL( 'gW', gW,1,myIter,myThid)
133     CALL READ_REC_XYZ_RL( 'gWnm1', gwNm1,1,myIter,myThid)
134 edhill 1.44 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 jmc 1.61 c CALL MDSREADFIELD(fn,prec,'RL',Nr, gW,2,myThid)
228     CALL MDSREADFIELD(fn,prec,'RL',Nr, gwNm1,2,myThid)
229 edhill 1.44 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 jmc 1.61 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 adcroft 1.1 ENDIF
273     #endif
274 jmc 1.42 IF ( useDynP_inEos_Zc ) THEN
275 edhill 1.44 CALL MNC_CW_RL_R('D',fn,0,0,'phiHyd',totPhiHyd,myThid)
276 jmc 1.42 ENDIF
277 edhill 1.41 ENDIF
278     #endif /* ALLOW_MNC */
279 edhill 1.34
280 cnh 1.60 C _END_MASTER( myThid )
281 edhill 1.38 _BARRIER
282 edhill 1.41
283 edhill 1.44 C Fill in edge regions
284 adcroft 1.9 CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
285 adcroft 1.1 _EXCH_XYZ_R8(theta , myThid )
286     _EXCH_XYZ_R8(salt , myThid )
287 jmc 1.53 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 jmc 1.6 _EXCH_XY_R8 (etaN, myThid )
305 jmc 1.53 _EXCH_XY_R8( etaH, myThid )
306 jmc 1.43 #ifdef EXACT_CONSERV
307     _EXCH_XY_R8( detaHdt, myThid )
308     #endif
309    
310 jmc 1.19 IF ( useDynP_inEos_Zc )
311 edhill 1.41 & _EXCH_XYZ_RL( totPhiHyd, myThid )
312 jmc 1.19
313 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
314 edhill 1.41 IF ( nonHydrostatic ) THEN
315     _EXCH_XYZ_R8(phi_nh, myThid )
316 jmc 1.61 c _EXCH_XYZ_R8(gW , myThid )
317     _EXCH_XYZ_R8(gwNm1 , myThid )
318 edhill 1.41 ENDIF
319 adcroft 1.1 #endif
320 edhill 1.44
321 adcroft 1.1 RETURN
322     END
323    
324 edhill 1.41 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
325 cnh 1.14 CBOP
326     C !ROUTINE: WRITE_CHECKPOINT
327     C !INTERFACE:
328 edhill 1.41 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 cnh 1.14
348     C !USES:
349 adcroft 1.1 IMPLICIT NONE
350     #include "SIZE.h"
351     #include "EEPARAMS.h"
352     #include "PARAMS.h"
353 edhill 1.49 #ifdef ALLOW_MNC
354     #include "MNC_PARAMS.h"
355     #endif
356 jmc 1.54 LOGICAL DIFFERENT_MULTIPLE
357     EXTERNAL DIFFERENT_MULTIPLE
358 adcroft 1.1 INTEGER IO_ERRCOUNT
359     EXTERNAL IO_ERRCOUNT
360    
361 edhill 1.41 C !INPUT PARAMETERS:
362     C modelEnd :: Checkpoint call at end of model run.
363     C myThid :: Thread number for this instance of the routine.
364     C myIter :: Iteration number
365     C myTime :: Current time of simulation ( s )
366 adcroft 1.1 LOGICAL modelEnd
367     INTEGER myThid
368 jmc 1.5 INTEGER myIter
369 adcroft 1.15 _RL myTime
370 edhill 1.41 CEOP
371 adcroft 1.1
372 cnh 1.14 C !LOCAL VARIABLES:
373     C permCheckPoint :: Flag indicating whether a permanent checkpoint will
374     C be written.
375 jmc 1.31 C tempCheckPoint :: Flag indicating if it is time to write a non-permanent
376     C checkpoint (that will be permanent if permCheckPoint=T)
377     LOGICAL permCheckPoint, tempCheckPoint
378 jmc 1.58 #ifdef ALLOW_CAL
379 dimitri 1.51 INTEGER thisdate(4), prevdate(4)
380 jmc 1.58 #endif
381 dimitri 1.51
382 adcroft 1.1 permCheckPoint = .FALSE.
383 jmc 1.31 tempCheckPoint = .FALSE.
384 edhill 1.41 permCheckPoint =
385 jmc 1.54 & DIFFERENT_MULTIPLE(pChkptFreq,myTime,deltaTClock)
386 edhill 1.41 tempCheckPoint =
387 jmc 1.54 & DIFFERENT_MULTIPLE( ChkptFreq,myTime,deltaTClock)
388 dimitri 1.51
389     #ifdef ALLOW_CAL
390     IF ( calendarDumps ) THEN
391     C-- Convert approximate months (30-31 days) and years (360-372 days)
392     C to exact calendar months and years.
393     C- First determine calendar dates for this and previous time step.
394     call cal_GetDate( myiter ,mytime ,thisdate,mythid )
395     call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )
396     C- Monthly pChkptFreq:
397     IF( pChkptFreq.GE. 2592000 .AND. pChkptFreq.LE. 2678400 ) THEN
398     permCheckPoint = .FALSE.
399     IF((thisdate(1)-prevdate(1)) .GT. 50 )permCheckPoint=.TRUE.
400     ENDIF
401     C- Yearly pChkptFreq:
402     IF( pChkptFreq.GE.31104000 .AND. pChkptFreq.LE.31968000 ) THEN
403     permCheckPoint = .FALSE.
404     IF((thisdate(1)-prevdate(1)) .GT. 5000)permCheckPoint=.TRUE.
405     ENDIF
406     C- Monthly ChkptFreq:
407     IF( ChkptFreq.GE. 2592000 .AND. ChkptFreq.LE. 2678400 ) THEN
408     tempCheckPoint = .FALSE.
409     IF((thisdate(1)-prevdate(1)) .GT. 50 )tempCheckPoint=.TRUE.
410     ENDIF
411     C- Yearly ChkptFreq:
412     IF( ChkptFreq.GE.31104000 .AND. ChkptFreq.LE.31968000 ) THEN
413     tempCheckPoint = .FALSE.
414     IF((thisdate(1)-prevdate(1)) .GT. 5000)tempCheckPoint=.TRUE.
415     ENDIF
416     ENDIF
417     #endif
418    
419 adcroft 1.1 IF (
420 edhill 1.41 & ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
421     & .OR.
422     & ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
423     & ) THEN
424    
425 edhill 1.44 CALL WRITE_CHECKPOINT_NOW(
426     & permCheckPoint, myTime, myIter, myThid )
427    
428    
429     ENDIF
430     RETURN
431     END
432    
433     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
434     CBOP
435     C !ROUTINE: WRITE_CHECKPOINT_NOW
436     C !INTERFACE:
437     SUBROUTINE WRITE_CHECKPOINT_NOW(
438     I permCheckPoint, myTime,
439     I myIter, myThid )
440    
441     C !DESCRIPTION:
442     C Write the checkpoint and do it NOW.
443    
444     C !USES:
445     IMPLICIT NONE
446     #include "SIZE.h"
447     #include "EEPARAMS.h"
448     #include "PARAMS.h"
449     #ifdef ALLOW_MNC
450     #include "MNC_PARAMS.h"
451     #endif
452     #include "DYNVARS.h"
453     #include "SURFACE.h"
454     #ifdef ALLOW_NONHYDROSTATIC
455 jmc 1.59 #include "NH_VARS.h"
456 edhill 1.44 #endif
457     INTEGER IO_ERRCOUNT
458     EXTERNAL IO_ERRCOUNT
459     COMMON /PCKP_GBLFLS/ globalFile
460     LOGICAL globalFile
461    
462     C !INPUT PARAMETERS:
463     C permCheckPoint :: Is or is not a permanent checkpoint.
464     C myThid :: Thread number for this instance of the routine.
465     C myIter :: Iteration number
466     C myTime :: Current time of simulation ( s )
467     LOGICAL permCheckPoint
468     INTEGER myThid
469     INTEGER myIter
470     _RL myTime
471     CEOP
472    
473     C !LOCAL VARIABLES:
474     C oldPrc :: Temp. for holding I/O precision
475     C fn :: Temp. for building file name string.
476     C lgf :: Flag to indicate whether to use global file mode.
477 jmc 1.58 #ifdef OLD_STYLE_WITH_MANY_FILES
478     INTEGER oldPrec
479     #endif
480     INTEGER prec
481 jmc 1.53 INTEGER i, nj
482 edhill 1.44 CHARACTER*(MAX_LEN_FNAM) fn
483     CHARACTER*(MAX_LEN_MBUF) msgBuf
484     LOGICAL lgf
485    
486     C Write model fields
487     DO i = 1,MAX_LEN_FNAM
488     fn(i:i) = ' '
489     ENDDO
490     IF ( permCheckPoint ) THEN
491     WRITE(fn,'(A,I10.10)') 'pickup.',myIter
492     ELSE
493     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
494     ENDIF
495    
496     C Going to really do some IO. Make everyone except master thread wait.
497     _BARRIER
498 cnh 1.60 C _BEGIN_MASTER( myThid )
499 edhill 1.44
500     IF (pickup_write_mdsio) THEN
501 adcroft 1.1
502 jmc 1.31 #ifdef OLD_STYLE_WITH_MANY_FILES
503 edhill 1.41
504 adcroft 1.1 C Force 64-bit IO
505     oldPrec = writeBinaryPrec
506     writeBinaryPrec = precFloat64
507 edhill 1.44 C Write model fields
508 adcroft 1.1 C Raw fields
509 edhill 1.44 CALL WRITE_REC_XYZ_RL( 'uVel', uVel, 1,myIter,myThid)
510     CALL WRITE_REC_XYZ_RL( 'gU', gU, 1,myIter,myThid)
511 jmc 1.61 CALL WRITE_REC_XYZ_RL( 'gUNm1', guNm1, 1,myIter,myThid)
512 edhill 1.44 CALL WRITE_REC_XYZ_RL( 'vVel', vVel, 1,myIter,myThid)
513     CALL WRITE_REC_XYZ_RL( 'gV', gV, 1,myIter,myThid)
514 jmc 1.61 CALL WRITE_REC_XYZ_RL( 'gVNm1', gvNm1, 1,myIter,myThid)
515 edhill 1.44 CALL WRITE_REC_XYZ_RL( 'theta', theta, 1,myIter,myThid)
516     CALL WRITE_REC_XYZ_RL( 'gT', gT, 1,myIter,myThid)
517 jmc 1.61 CALL WRITE_REC_XYZ_RL( 'gTNm1', gtNm1, 1,myIter,myThid)
518 edhill 1.44 CALL WRITE_REC_XYZ_RL( 'salt', salt, 1,myIter,myThid)
519     CALL WRITE_REC_XYZ_RL( 'gS', gS, 1,myIter,myThid)
520 jmc 1.61 CALL WRITE_REC_XYZ_RL( 'gSNm1', gsNm1, 1,myIter,myThid)
521 edhill 1.44 CALL WRITE_REC_XY_RL ( 'etaN', etaN, 1,myIter,myThid)
522 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
523     IF ( nonHydrostatic ) THEN
524 edhill 1.41 CALL WRITE_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
525 jmc 1.61 c CALL WRITE_REC_XYZ_RL( 'gW', gW,1,myIter,myThid)
526     CALL WRITE_REC_XYZ_RL( 'gWnm1', gwNm1,1,myIter,myThid)
527 adcroft 1.1 ENDIF
528     #endif
529 edhill 1.44 C Reset binary precision
530 jmc 1.31 writeBinaryPrec = oldPrec
531 edhill 1.44
532 jmc 1.11 #else /* OLD_STYLE_WITH_MANY_FILES */
533 edhill 1.41
534 adcroft 1.1 prec = precFloat64
535     lgf = globalFile
536 edhill 1.41
537 jmc 1.53 #ifdef ALLOW_MDSIO
538    
539     #ifdef ALLOW_ADAMSBASHFORTH_3
540     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
541     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
542     & guNm(1-Olx,1-Oly,1,1,1,1), 2,myIter,myThid)
543     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
544     & guNm(1-Olx,1-Oly,1,1,1,2), 3,myIter,myThid)
545     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 4,myIter,myThid)
546     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
547     & gvNm(1-Olx,1-Oly,1,1,1,1), 5,myIter,myThid)
548     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
549     & gvNm(1-Olx,1-Oly,1,1,1,2), 6,myIter,myThid)
550     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta, 7,myIter,myThid)
551     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
552     & gtNm(1-Olx,1-Oly,1,1,1,1), 8,myIter,myThid)
553     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
554     & gtNm(1-Olx,1-Oly,1,1,1,2), 9,myIter,myThid)
555     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 10,myIter,myThid)
556     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
557     & gsNm(1-Olx,1-Oly,1,1,1,1),11,myIter,myThid)
558     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,
559     & gsNm(1-Olx,1-Oly,1,1,1,2),12,myIter,myThid)
560     nj = 12
561     #else /* ALLOW_ADAMSBASHFORTH_3 */
562 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
563 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,guNm1,2,myIter,myThid)
564 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 3,myIter,myThid)
565 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gvNm1,4,myIter,myThid)
566 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta,5,myIter,myThid)
567 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gtNm1,6,myIter,myThid)
568 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 7,myIter,myThid)
569 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gsNm1,8,myIter,myThid)
570     nj = 8
571     #endif /* ALLOW_ADAMSBASHFORTH_3 */
572     CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaN, nj*Nr+1,
573 edhill 1.44 & myIter,myThid)
574 jmc 1.43 #ifdef EXACT_CONSERV
575 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,dEtaHdt,nj*Nr+2,
576 edhill 1.44 & myIter,myThid)
577 jmc 1.53 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaHnm1,nj*Nr+3,
578 edhill 1.44 & myIter,myThid)
579     #endif /* EXACT_CONSERV */
580     IF ( useDynP_inEos_Zc ) THEN
581     IF ( permCheckPoint ) THEN
582     WRITE(fn,'(A,I10.10)') 'pickup_ph.',myIter
583     ELSE
584     WRITE(fn,'(A,A)') 'pickup_ph.',checkPtSuff(nCheckLev)
585     ENDIF
586     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,totPhiHyd,
587     & 1,myIter,myThid)
588     ENDIF
589 edhill 1.41 #ifdef ALLOW_NONHYDROSTATIC
590 edhill 1.44 IF ( nonHydrostatic ) THEN
591     IF ( permCheckPoint ) THEN
592     WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
593     ELSE
594     WRITE(fn,'(A,A)') 'pickup_nh.',checkPtSuff(nCheckLev)
595 edhill 1.41 ENDIF
596 edhill 1.44 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,phi_nh, 1,
597     & myIter,myThid)
598 jmc 1.61 c CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gW, 2,
599     c & myIter,myThid)
600     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gwNm1, 2,
601 edhill 1.41 & myIter,myThid)
602     ENDIF
603 edhill 1.44 #endif /* ALLOW_NONHYDROSTATIC */
604 edhill 1.34
605 jmc 1.53 #endif /* ALLOW_MDSIO */
606    
607 edhill 1.41 #endif /* OLD_STYLE_WITH_MANY_FILES */
608 heimbach 1.8
609 edhill 1.44 ENDIF
610    
611     #ifdef ALLOW_MNC
612 edhill 1.45 IF (useMNC .AND. pickup_write_mnc) THEN
613 edhill 1.56 IF ( permCheckPoint ) THEN
614     WRITE(fn,'(A)') 'pickup'
615     ELSE
616     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
617     ENDIF
618 edhill 1.57 C First ***define*** the file group name
619     CALL MNC_CW_SET_UDIM(fn, 0, myThid)
620 edhill 1.56 IF ( permCheckPoint ) THEN
621     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
622     ELSE
623     CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
624     ENDIF
625 edhill 1.57 C Then set the actual unlimited dimension
626     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
627 edhill 1.55 CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
628     CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
629 edhill 1.44 CALL MNC_CW_RL_W('D',fn,0,0,'U', uVel, myThid)
630     CALL MNC_CW_RL_W('D',fn,0,0,'V', vVel, myThid)
631 edhill 1.46 CALL MNC_CW_RL_W('D',fn,0,0,'Temp', theta, myThid)
632 edhill 1.44 CALL MNC_CW_RL_W('D',fn,0,0,'S', salt, myThid)
633     CALL MNC_CW_RL_W('D',fn,0,0,'Eta', etaN, myThid)
634 jmc 1.53 #ifndef ALLOW_ADAMSBASHFORTH_3
635     CALL MNC_CW_RL_W('D',fn,0,0,'gUnm1', guNm1, myThid)
636     CALL MNC_CW_RL_W('D',fn,0,0,'gVnm1', gvNm1, myThid)
637     CALL MNC_CW_RL_W('D',fn,0,0,'gTnm1', gtNm1, myThid)
638     CALL MNC_CW_RL_W('D',fn,0,0,'gSnm1', gsNm1, myThid)
639     #endif /* ALLOW_ADAMSBASHFORTH_3 */
640 edhill 1.44 #ifdef EXACT_CONSERV
641     CALL MNC_CW_RL_W('D',fn,0,0,'dEtaHdt', dEtaHdt, myThid)
642     CALL MNC_CW_RL_W('D',fn,0,0,'EtaH', etaHnm1, myThid)
643     #endif
644     #ifdef ALLOW_NONHYDROSTATIC
645     IF ( nonHydrostatic ) THEN
646     CALL MNC_CW_RL_W('D',fn,0,0,'phi_nh', phi_nh, myThid)
647 jmc 1.61 c CALL MNC_CW_RL_W('D',fn,0,0,'gW', gW, myThid)
648     CALL MNC_CW_RL_W('D',fn,0,0,'gWnm1', gwNm1, myThid)
649 jmc 1.32 ENDIF
650 edhill 1.44 #endif
651     IF ( useDynP_inEos_Zc ) THEN
652     CALL MNC_CW_RL_W('D',fn,0,0,'phiHyd', totPhiHyd, myThid)
653 adcroft 1.1 ENDIF
654     ENDIF
655 edhill 1.44 #endif /* ALLOW_MNC */
656 adcroft 1.1
657 edhill 1.44 C Write suffix for stdout information
658     IF ( permCheckPoint ) THEN
659     WRITE(fn,'(I10.10)') myIter
660     ELSE
661     WRITE(fn,'(A)') checkPtSuff(nCheckLev)
662     ENDIF
663    
664     IF ( .NOT. permCheckPoint ) THEN
665     nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
666     ENDIF
667    
668 cnh 1.60 C _END_MASTER(myThid)
669 edhill 1.44 _BARRIER
670    
671     C Write information to stdout so there is a record that the
672     C checkpoint was completed
673     _BEGIN_MASTER(myThid)
674     WRITE(msgBuf,'(A11,I10,1X,A10)')
675     & "%CHECKPOINT ",myIter,fn
676     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
677     _END_MASTER(myThid)
678    
679 adcroft 1.1 RETURN
680     END

  ViewVC Help
Powered by ViewVC 1.1.22