/[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.2 - (show annotations) (download)
Fri Jul 30 15:42:58 1999 UTC (24 years, 11 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint24, checkpoint25
Changes since 1.1: +2 -2 lines
Changed some erroneous declarations of myCurrentTime (sometimes myTime)
from REAL to _RL. This probably was caught before because most people
are using -r8 compile option in conjuction with REAL4_IS_SLOW which
converts everything to real*8.  Spotted by C.E.

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

  ViewVC Help
Powered by ViewVC 1.1.22