/[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.3 - (show annotations) (download)
Mon Mar 27 22:25:43 2000 UTC (24 years, 2 months ago) by adcroft
Branch: MAIN
CVS Tags: branch-atmos-merge-shapiro, checkpoint28, checkpoint29, checkpoint27, checkpoint26, checkpoint33, checkpoint32, checkpoint31, checkpoint30, checkpoint34, branch-atmos-merge-zonalfilt, branch-atmos-merge-phase5, branch-atmos-merge-phase4, branch-atmos-merge-phase7, branch-atmos-merge-phase6, branch-atmos-merge-phase1, branch-atmos-merge-phase3, branch-atmos-merge-phase2, branch-atmos-merge-start, branch-atmos-merge-freeze
Branch point for: branch-atmos-merge
Changes since 1.2: +2 -18 lines
Removed unused variables and fixed some unitialized variables.

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

  ViewVC Help
Powered by ViewVC 1.1.22