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

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

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


Revision 1.12 - (show annotations) (download)
Thu Sep 13 17:43:55 2001 UTC (22 years, 8 months ago) by adcroft
Branch: MAIN
Changes since 1.11: +9 -2 lines
Added package "flt".
 o pkg/flt
 o verification/flt_example
 o visualization of trajectories supplied
 o works but output not available to testscript

1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/checkpoint.F,v 1.11 2001/08/27 18:50:41 jmc Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 C-- File read_write.F: Routines to handle mid-level I/O interface.
7 C-- Contents
8 C-- o SET_WRITE_GLOBAL_PICKUP
9 C-- o READ_CHECKPOINT - Write out checkpoint files for restarting.
10 C-- o WRITE_CHECKPOINT - Write out checkpoint files for restarting.
11
12 SUBROUTINE SET_WRITE_GLOBAL_PICKUP ( flag )
13 IMPLICIT NONE
14 C SET_WRITE_GLOBAL_FLD( flag ) sets an internal logical state to
15 C indicate whether files written by subsequent call to the
16 C READ_WRITE_FLD package should create "global" or "tiled" files.
17 C flag = .TRUE. indicates "global" files
18 C flag = .FALSE. indicates "tiled" files
19 C
20 C Arguments
21 LOGICAL flag
22 C Common
23 COMMON /PCKP_GBLFLS/ globalFile
24 LOGICAL globalFile
25 C
26 globalFile=flag
27 C
28 RETURN
29 END
30
31 CStartofinterface
32 SUBROUTINE READ_CHECKPOINT ( myIter, myThid )
33 C /==========================================================\
34 C | SUBROUTINE READ_PICKUP |
35 C | o Controlling routine for IO to write restart file. |
36 C |==========================================================|
37 C | Read model checkpoint files for use in restart. |
38 C \==========================================================/
39 IMPLICIT NONE
40
41 C == Global variables ===
42 #include "SIZE.h"
43 #include "EEPARAMS.h"
44 #include "PARAMS.h"
45 #include "DYNVARS.h"
46 #ifdef ALLOW_NONHYDROSTATIC
47 #include "GW.h"
48 #include "SOLVE_FOR_PRESSURE3D.h"
49 #endif
50
51 INTEGER IO_ERRCOUNT
52 EXTERNAL IO_ERRCOUNT
53
54 C == Routine arguments ==
55 C myThid - Thread number for this instance of the routine.
56 C myIter - Iteration number
57 INTEGER myThid
58 INTEGER myIter
59 CEndofinterface
60
61 C == Local variables ==
62 INTEGER oldPrec
63 CHARACTER*(MAX_LEN_FNAM) fn
64 INTEGER prec
65
66 C-- Going to really do some IO. Make everyone except master thread wait.
67 _BARRIER
68 _BEGIN_MASTER( myThid )
69
70 C Force 64-bit IO
71 oldPrec = readBinaryPrec
72 readBinaryPrec = precFloat64
73
74 #ifdef OLD_STYLE_WITH_MANY_FILES
75 C-- Read model fields
76 C Raw fields
77 CALL READ_REC_XYZ_RL( 'uVel', uVel, 1,myIter, myThid)
78 CALL READ_REC_XYZ_RL( 'gU', gU, 1,myIter, myThid)
79 CALL READ_REC_XYZ_RL( 'guNm1', gUNm1, 1,myIter, myThid)
80 CALL READ_REC_XYZ_RL( 'vVel', vVel, 1,myIter, myThid)
81 CALL READ_REC_XYZ_RL( 'gV', gV, 1,myIter, myThid)
82 CALL READ_REC_XYZ_RL( 'gvNm1', gVNm1, 1,myIter, myThid)
83 CALL READ_REC_XYZ_RL( 'theta', theta, 1,myIter, myThid)
84 CALL READ_REC_XYZ_RL( 'gT', gT, 1,myIter, myThid)
85 CALL READ_REC_XYZ_RL( 'gtNm1', gTNm1, 1,myIter, myThid)
86 CALL READ_REC_XYZ_RL( 'salt', salt, 1,myIter, myThid)
87 CALL READ_REC_XYZ_RL( 'gS', gS, 1,myIter, myThid)
88 CALL READ_REC_XYZ_RL( 'gsNm1', gSNm1, 1,myIter, myThid)
89 CALL READ_REC_XY_RL ('etaN', etaN, 1,myIter, myThid)
90 #ifdef INCLUDE_CD_CODE
91 CALL READ_REC_XY_RL
92 & ( 'etaNm1', etaNm1, 1,myIter, myThid)
93 CALL READ_REC_XYZ_RL( 'uVelD', uVelD, 1,myIter, myThid)
94 CALL READ_REC_XYZ_RL( 'vVelD', vVelD, 1,myIter, myThid)
95 CALL READ_REC_XYZ_RL( 'uNm1', uNM1, 1,myIter, myThid)
96 CALL READ_REC_XYZ_RL( 'vNm1', vNM1, 1,myIter, myThid)
97 CALL READ_REC_XYZ_RL( 'guCD', guCD, 1,myIter, myThid)
98 CALL READ_REC_XYZ_RL( 'gvCD', gvCD, 1,myIter, myThid)
99 #endif
100 #ifdef ALLOW_NONHYDROSTATIC
101 IF ( nonHydrostatic ) THEN
102 CALL READ_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
103 CALL READ_REC_XYZ_RL( 'gW',gW, 1,myIter,myThid)
104 c CALL READ_REC_XYZ_RL( 'gWnm1',gWnm1, 1,myIter,myThid)
105 ENDIF
106 #endif
107 #else /* OLD_STYLE_WITH_MANY_FILES */
108
109 prec = precFloat64
110
111 C-- Read model fields
112 WRITE(fn,'(A,I10.10)') 'pickup.',myIter
113 CALL MDSREADFIELD(fn,prec,'RL',Nr,uVel, 1,myThid)
114 CALL MDSREADFIELD(fn,prec,'RL',Nr,gU, 2,myThid)
115 CALL MDSREADFIELD(fn,prec,'RL',Nr,gUnm1, 3,myThid)
116 CALL MDSREADFIELD(fn,prec,'RL',Nr,vVel, 4,myThid)
117 CALL MDSREADFIELD(fn,prec,'RL',Nr,gV, 5,myThid)
118 CALL MDSREADFIELD(fn,prec,'RL',Nr,gVnm1, 6,myThid)
119 CALL MDSREADFIELD(fn,prec,'RL',Nr,theta, 7,myThid)
120 CALL MDSREADFIELD(fn,prec,'RL',Nr,gT, 8,myThid)
121 CALL MDSREADFIELD(fn,prec,'RL',Nr,gTnm1, 9,myThid)
122 CALL MDSREADFIELD(fn,prec,'RL',Nr,salt, 10,myThid)
123 CALL MDSREADFIELD(fn,prec,'RL',Nr,gS, 11,myThid)
124 CALL MDSREADFIELD(fn,prec,'RL',Nr,gSnm1, 12,myThid)
125 CALL MDSREADFIELD(fn,prec,'RL', 1,etaN,12*Nr+1,myThid)
126 #ifdef NONLIN_FRSURF
127 IF ( nonlinFreeSurf.GE.0)
128 & CALL MDSREADFIELD(fn,prec,'RL',1,etaNm1,12*Nr+2,myThid)
129 #endif
130 #ifdef INCLUDE_CD_CODE
131 WRITE(fn,'(A,I10.10)') 'pickup_cd.',myIter
132 CALL MDSREADFIELD(fn,prec,'RL',Nr,uVelD, 1,myThid)
133 CALL MDSREADFIELD(fn,prec,'RL',Nr,vVelD, 2,myThid)
134 CALL MDSREADFIELD(fn,prec,'RL',Nr,uNM1, 3,myThid)
135 CALL MDSREADFIELD(fn,prec,'RL',Nr,vNM1, 4,myThid)
136 CALL MDSREADFIELD(fn,prec,'RL',Nr,guCD, 5,myThid)
137 CALL MDSREADFIELD(fn,prec,'RL',Nr,gvCD, 6,myThid)
138 #ifdef NONLIN_FRSURF
139 IF ( nonlinFreeSurf.LT.0)
140 & CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,6*Nr+1,myThid)
141 #else
142 CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,6*Nr+1,myThid)
143 #endif
144 #endif /* INCLUDE_CD_CODE */
145
146 #ifdef ALLOW_NONHYDROSTATIC
147 IF ( nonHydrostatic ) THEN
148 WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
149 CALL MDSREADFIELD(fn,prec,'RL',Nr,phi_nh,1,myThid)
150 CALL MDSREADFIELD(fn,prec,'RL',Nr,gW, 2,myThid)
151 c CALL MDSREADFIELD(fn,prec,'RL',Nr,gWnm1,3,myThid)
152 ENDIF
153 #endif
154
155 C SPK 4/9/01: Open boundary checkpointing
156 #ifdef ALLOW_OBCS
157 IF (useOBCS) THEN
158 CALL OBCS_READ_CHECKPOINT(prec, myIter, myThid)
159 ENDIF
160 #endif /* ALLOW_OBCS */
161
162 #endif /* OLD_STYLE_WITH_MANY_FILES */
163
164 C Reset default IO precision
165 readBinaryPrec = oldPrec
166
167 _END_MASTER( myThid )
168 _BARRIER
169
170 C-- Fill in edge regions
171 CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
172 CALL EXCH_UV_XYZ_RL(gU,gV,.TRUE.,myThid)
173 CALL EXCH_UV_XYZ_RL(gUnm1,gVnm1,.TRUE.,myThid)
174 c _EXCH_XYZ_R8(uVel , myThid )
175 c _EXCH_XYZ_R8(gu , myThid )
176 c _EXCH_XYZ_R8(guNM1 , myThid )
177 c _EXCH_XYZ_R8(vVel , myThid )
178 c _EXCH_XYZ_R8(gv , myThid )
179 c _EXCH_XYZ_R8(gvNM1 , myThid )
180 _EXCH_XYZ_R8(theta , myThid )
181 _EXCH_XYZ_R8(gt , myThid )
182 _EXCH_XYZ_R8(gtNM1 , myThid )
183 _EXCH_XYZ_R8(salt , myThid )
184 _EXCH_XYZ_R8(gs , myThid )
185 _EXCH_XYZ_R8(gsNM1 , myThid )
186 _EXCH_XY_R8 (etaN, myThid )
187 _EXCH_XY_R8( etaNm1, myThid )
188
189 #ifdef INCLUDE_CD_CODE
190 c**** CALL EXCH_DUV_XYZ_RL(uVelD,vVelD,.TRUE.,myThid)
191 c**** CALL EXCH_DUV_XYZ_RL(guCD,gvCD,.TRUE.,myThid)
192 _EXCH_XYZ_R8( uVelD, myThid )
193 _EXCH_XYZ_R8( vVelD, myThid )
194 CALL EXCH_UV_XYZ_RL(uNM1,vNM1,.TRUE.,myThid)
195 c _EXCH_XYZ_R8( uNM1, myThid )
196 c _EXCH_XYZ_R8( vNM1, myThid )
197 _EXCH_XYZ_R8( guCD, myThid )
198 _EXCH_XYZ_R8( gvCD, myThid )
199 #endif
200 #ifdef ALLOW_NONHYDROSTATIC
201 IF ( nonHydrostatic ) THEN
202 _EXCH_XYZ_R8(phi_nh, myThid )
203 _EXCH_XYZ_R8(gW , myThid )
204 c _EXCH_XYZ_R8(gWNM1 , myThid )
205 ENDIF
206 #endif
207
208 RETURN
209 END
210
211 CStartofinterface
212 SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime,
213 & myIter, myThid )
214 C /==========================================================\
215 C | SUBROUTINE WRITE_PICKUP |
216 C | o Controlling routine for IO to write restart file. |
217 C |==========================================================|
218 C | Write model checkpoint files for use in restart. |
219 C | This routine writes both "rolling-checkpoint" files |
220 C | and permanent checkpoint files. A rolling checkpoint |
221 C | works through a circular list of suffices. Generally the |
222 C | circular list has two entries so that a rolling |
223 C | checkpoint will overwrite the last rolling checkpoint |
224 C | but one. This is useful for running long jobs without |
225 C | filling too much disk space. |
226 C | In a permanent checkpoint data is written suffixed by |
227 C | the current timestep number. This sort of checkpoint can |
228 C | be used to provided a snap-shot from which the model |
229 C | can be rerun. |
230 C \==========================================================/
231 IMPLICIT NONE
232
233 C == Global variables ===
234 #include "SIZE.h"
235 #include "EEPARAMS.h"
236 #include "PARAMS.h"
237 #include "DYNVARS.h"
238 #ifdef ALLOW_NONHYDROSTATIC
239 #include "GW.h"
240 #include "SOLVE_FOR_PRESSURE3D.h"
241 #endif
242
243 LOGICAL DIFFERENT_MULTIPLE
244 EXTERNAL DIFFERENT_MULTIPLE
245 INTEGER IO_ERRCOUNT
246 EXTERNAL IO_ERRCOUNT
247
248 C == Routine arguments ==
249 C modelEnd - Checkpoint call at end of model run.
250 C myThid - Thread number for this instance of the routine.
251 C myIter - Iteration number
252 C myCurrentTime - Current time of simulation ( s )
253 LOGICAL modelEnd
254 INTEGER myThid
255 INTEGER myIter
256 _RL myCurrentTime
257 CEndofinterface
258
259 C == Common blocks ==
260 COMMON /PCKP_GBLFLS/ globalFile
261 LOGICAL globalFile
262
263 C == Local variables ==
264 C permCheckPoint - Flag indicating whether a permanent checkpoint will
265 C be written.
266 LOGICAL permCheckPoint
267 INTEGER oldPrec
268 CHARACTER*(MAX_LEN_FNAM) fn
269 INTEGER prec
270 LOGICAL lgf
271
272 permCheckPoint = .FALSE.
273 permCheckPoint=
274 & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,
275 & myCurrentTime-deltaTClock)
276
277 IF (
278 & (.NOT. modelEnd .AND. (
279 & permCheckPoint
280 & .OR.
281 & DIFFERENT_MULTIPLE(chkptFreq,
282 & myCurrentTime,myCurrentTime-deltaTClock)
283 & )
284 & )
285 & .OR.
286 & (
287 & modelEnd
288 & .AND. .NOT.
289 & permCheckPoint
290 & .AND. .NOT.
291 & DIFFERENT_MULTIPLE(chkptFreq,
292 & myCurrentTime,myCurrentTime-deltaTClock)
293 & )
294 & ) THEN
295
296 C-- Going to really do some IO. Make everyone except master thread wait.
297 _BARRIER
298 _BEGIN_MASTER( myThid )
299
300 C Force 64-bit IO
301 oldPrec = writeBinaryPrec
302 writeBinaryPrec = precFloat64
303
304 #ifdef OLD_STYLE_WITH_MANY_FILES
305 C-- Write model fields
306 C Raw fields
307 CALL WRITE_REC_XYZ_RL( 'uVel', uVel, 1,myIter, myThid)
308 CALL WRITE_REC_XYZ_RL( 'gU', gU, 1,myIter, myThid)
309 CALL WRITE_REC_XYZ_RL( 'gUNm1', gUNm1, 1,myIter, myThid)
310 CALL WRITE_REC_XYZ_RL( 'vVel', vVel, 1,myIter, myThid)
311 CALL WRITE_REC_XYZ_RL( 'gV', gV, 1,myIter, myThid)
312 CALL WRITE_REC_XYZ_RL( 'gVNm1', gVNm1, 1,myIter, myThid)
313 CALL WRITE_REC_XYZ_RL( 'theta', theta, 1,myIter, myThid)
314 CALL WRITE_REC_XYZ_RL( 'gT', gT, 1,myIter, myThid)
315 CALL WRITE_REC_XYZ_RL( 'gTNm1', gTNm1, 1,myIter, myThid)
316 CALL WRITE_REC_XYZ_RL( 'salt', salt, 1,myIter, myThid)
317 CALL WRITE_REC_XYZ_RL( 'gS', gS, 1,myIter, myThid)
318 CALL WRITE_REC_XYZ_RL( 'gSNm1', gSNm1, 1,myIter, myThid)
319 CALL WRITE_REC_XY_RL ('etaN', etaN, 1,myIter, myThid)
320 #ifdef INCLUDE_CD_CODE
321 CALL WRITE_REC_XY_RL
322 & ( 'etaNm1', etaNm1, 1,myIter, myThid)
323 CALL WRITE_REC_XYZ_RL( 'uVelD', uVelD, 1,myIter, myThid)
324 CALL WRITE_REC_XYZ_RL( 'vVelD', vVelD, 1,myIter, myThid)
325 CALL WRITE_REC_XYZ_RL( 'uNM1', uNM1, 1,myIter, myThid)
326 CALL WRITE_REC_XYZ_RL( 'vNM1', vNM1, 1,myIter, myThid)
327 CALL WRITE_REC_XYZ_RL( 'guCD', guCD, 1,myIter, myThid)
328 CALL WRITE_REC_XYZ_RL( 'gvCD', gvCD, 1,myIter, myThid)
329 #endif
330 #ifdef ALLOW_NONHYDROSTATIC
331 IF ( nonHydrostatic ) THEN
332 CALL WRITE_REC_XYZ_RL('phi_nh',phi_nh,1,myIter,myThid)
333 CALL WRITE_REC_XYZ_RL( 'gW',gW, 1,myIter,myThid)
334 c CALL WRITE_REC_XYZ_RL( 'gWnm1',gWnm1, 1,myIter,myThid)
335 ENDIF
336 #endif
337
338 #else /* OLD_STYLE_WITH_MANY_FILES */
339
340 prec = precFloat64
341 lgf = globalFile
342
343 C-- Write model fields
344 IF ( permCheckPoint ) THEN
345 WRITE(fn,'(A,I10.10)') 'pickup.',myIter
346 ELSE
347 WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
348 ENDIF
349 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
350 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gU, 2,myIter,myThid)
351 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gUnm1, 3,myIter,myThid)
352 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 4,myIter,myThid)
353 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gV, 5,myIter,myThid)
354 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gVnm1, 6,myIter,myThid)
355 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta, 7,myIter,myThid)
356 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gT, 8,myIter,myThid)
357 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gTnm1, 9,myIter,myThid)
358 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 10,myIter,myThid)
359 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gS, 11,myIter,myThid)
360 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gSnm1,12,myIter,myThid)
361 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaN,12*Nr+1,
362 & myIter,myThid)
363 #ifdef NONLIN_FRSURF
364 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaNm1,12*Nr+2,
365 & myIter,myThid)
366 #endif
367 #ifdef INCLUDE_CD_CODE
368 IF ( permCheckPoint ) THEN
369 WRITE(fn,'(A,I10.10)') 'pickup_cd.',myIter
370 ELSE
371 WRITE(fn,'(A,A)') 'pickup_cd.',checkPtSuff(nCheckLev)
372 ENDIF
373 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVelD,1,myIter,myThid)
374 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVelD,2,myIter,myThid)
375 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uNM1, 3,myIter,myThid)
376 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vNM1, 4,myIter,myThid)
377 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,guCD, 5,myIter,myThid)
378 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gvCD, 6,myIter,myThid)
379 #ifndef NONLIN_FRSURF
380 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaNm1,6*Nr+1,
381 & myIter,myThid)
382 #endif
383 #endif /* INCLUDE_CD_CODE */
384 #ifdef ALLOW_NONHYDROSTATIC
385 IF ( nonHydrostatic ) THEN
386 IF ( permCheckPoint ) THEN
387 WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
388 ELSE
389 WRITE(fn,'(A,A)') 'pickup_nh.',checkPtSuff(nCheckLev)
390 ENDIF
391 WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
392 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,phi_nh,1,myIter,myThid)
393 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gW, 2,myIter,myThid)
394 c CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gWnm1,3,myIter,myThid)
395 ENDIF
396 #endif
397
398 #ifdef ALLOW_OBCS
399 C SPK 4/9/01: Open boundary checkpointing
400 IF (useOBCS) THEN
401 CALL OBCS_WRITE_CHECKPOINT(
402 & prec, lgf, permCheckPoint, myIter, myThid)
403 ENDIF
404 #endif /* ALLOW_OBCS */
405
406 #ifdef ALLOW_FLT
407 C-- Write restart file for floats
408 IF (useFLT) THEN
409 CALL FLT_RESTART(myCurrentTime, myIter, myThid)
410 ENDIF
411 #endif
412
413 IF ( .NOT. permCheckPoint ) THEN
414 nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
415 ENDIF
416
417 #endif /* OLD_STYLE_WITH_MANY_FILES */
418
419 C-- Reset binary precision
420 writeBinaryPrec = oldPrec
421
422 _END_MASTER( myThid )
423 _BARRIER
424
425 ENDIF
426
427 RETURN
428 END

  ViewVC Help
Powered by ViewVC 1.1.22