/[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.7 - (hide annotations) (download)
Mon Mar 12 20:44:27 2001 UTC (23 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint38, pre38tag1, c37_adj, checkpoint37
Branch point for: pre38
Changes since 1.6: +13 -11 lines
correct Non-Hydrostatic pickup-file: cg3d_x replace wVel

1 jmc 1.7 C $Header: /u/gcmpack/models/MITgcmUV/model/src/checkpoint.F,v 1.6 2001/03/06 16:51:02 jmc Exp $
2 adcroft 1.1
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 jmc 1.5 SUBROUTINE READ_CHECKPOINT ( myIter, myThid )
32 adcroft 1.1 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     #ifdef ALLOW_NONHYDROSTATIC
46     #include "GW.h"
47 jmc 1.7 #include "CG3D.h"
48 adcroft 1.1 #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 jmc 1.5 C myIter - Iteration number
56 adcroft 1.1 INTEGER myThid
57 jmc 1.5 INTEGER myIter
58 adcroft 1.1 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 jmc 1.5 CALL READ_REC_XYZ_RL( 'guNm1', gUNm1, 1,myIter, myThid)
79 adcroft 1.1 CALL READ_REC_XYZ_RL( 'vVel', vVel, 1,myIter, myThid)
80     CALL READ_REC_XYZ_RL( 'gV', gV, 1,myIter, myThid)
81 jmc 1.5 CALL READ_REC_XYZ_RL( 'gvNm1', gVNm1, 1,myIter, myThid)
82 adcroft 1.1 CALL READ_REC_XYZ_RL( 'theta', theta, 1,myIter, myThid)
83     CALL READ_REC_XYZ_RL( 'gT', gT, 1,myIter, myThid)
84 jmc 1.5 CALL READ_REC_XYZ_RL( 'gtNm1', gTNm1, 1,myIter, myThid)
85 adcroft 1.1 CALL READ_REC_XYZ_RL( 'salt', salt, 1,myIter, myThid)
86     CALL READ_REC_XYZ_RL( 'gS', gS, 1,myIter, myThid)
87 jmc 1.5 CALL READ_REC_XYZ_RL( 'gsNm1', gSNm1, 1,myIter, myThid)
88 jmc 1.6 CALL READ_REC_XY_RL ('etaN', etaN, 1,myIter, myThid)
89 adcroft 1.1 #ifdef INCLUDE_CD_CODE
90     CALL READ_REC_XY_RL
91 jmc 1.6 & ( 'etaNm1', etaNm1, 1,myIter, myThid)
92 adcroft 1.1 CALL READ_REC_XYZ_RL( 'uVelD', uVelD, 1,myIter, myThid)
93     CALL READ_REC_XYZ_RL( 'vVelD', vVelD, 1,myIter, myThid)
94 jmc 1.5 CALL READ_REC_XYZ_RL( 'uNm1', uNM1, 1,myIter, myThid)
95     CALL READ_REC_XYZ_RL( 'vNm1', vNM1, 1,myIter, myThid)
96 adcroft 1.1 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 jmc 1.7 CALL READ_REC_XYZ_RL('cg3d_x',cg3d_x,1,myIter,myThid)
102 adcroft 1.1 CALL READ_REC_XYZ_RL( 'gW',gW, 1,myIter,myThid)
103 jmc 1.7 c CALL READ_REC_XYZ_RL( 'gWnm1',gWnm1, 1,myIter,myThid)
104 adcroft 1.1 ENDIF
105     #endif
106     #else
107    
108     prec = precFloat64
109    
110     C-- Read model fields
111 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup.',myIter
112 adcroft 1.1 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 jmc 1.6 CALL MDSREADFIELD(fn,prec,'RL', 1,etaN,12*Nr+1,myThid)
125 adcroft 1.1 #ifdef INCLUDE_CD_CODE
126 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup_cd.',myIter
127 adcroft 1.1 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 jmc 1.6 CALL MDSREADFIELD(fn,prec,'RL', 1,etaNm1,6*Nr+1,myThid)
134 adcroft 1.1 #endif
135     #ifdef ALLOW_NONHYDROSTATIC
136     IF ( nonHydrostatic ) THEN
137 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
138 jmc 1.7 CALL MDSREADFIELD(fn,prec,'RL',Nr,cg3d_x,1,myThid)
139 adcroft 1.1 CALL MDSREADFIELD(fn,prec,'RL',Nr,gW, 2,myThid)
140 jmc 1.7 c CALL MDSREADFIELD(fn,prec,'RL',Nr,gWnm1,3,myThid)
141 adcroft 1.1 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 jmc 1.6 _EXCH_XY_R8 (etaN, myThid )
166 adcroft 1.1 #ifdef INCLUDE_CD_CODE
167 jmc 1.6 _EXCH_XY_R8( etaNm1, myThid )
168 adcroft 1.1 _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 jmc 1.7 _EXCH_XYZ_R8(cg3d_x, myThid )
178 adcroft 1.1 _EXCH_XYZ_R8(gW , myThid )
179 jmc 1.7 c _EXCH_XYZ_R8(gWNM1 , myThid )
180 adcroft 1.1 ENDIF
181     #endif
182    
183     RETURN
184     END
185    
186     CStartofinterface
187     SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime,
188 jmc 1.5 & myIter, myThid )
189 adcroft 1.1 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     #ifdef ALLOW_NONHYDROSTATIC
214     #include "GW.h"
215 jmc 1.7 #include "CG3D.h"
216 adcroft 1.1 #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 jmc 1.5 C myIter - Iteration number
227 adcroft 1.1 C myCurrentTime - Current time of simulation ( s )
228     LOGICAL modelEnd
229     INTEGER myThid
230 jmc 1.5 INTEGER myIter
231 adcroft 1.2 _RL myCurrentTime
232 adcroft 1.1 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 jmc 1.6 CALL WRITE_REC_XY_RL ('etaN', etaN, 1,myIter, myThid)
295 adcroft 1.1 #ifdef INCLUDE_CD_CODE
296     CALL WRITE_REC_XY_RL
297 jmc 1.6 & ( 'etaNm1', etaNm1, 1,myIter, myThid)
298 adcroft 1.1 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 jmc 1.7 CALL WRITE_REC_XYZ_RL('cg3d_x',cg3d_x,1,myIter,myThid)
308 adcroft 1.1 CALL WRITE_REC_XYZ_RL( 'gW',gW, 1,myIter,myThid)
309 jmc 1.7 c CALL WRITE_REC_XYZ_RL( 'gWnm1',gWnm1, 1,myIter,myThid)
310 adcroft 1.1 ENDIF
311     #endif
312    
313     #else
314    
315     prec = precFloat64
316     lgf = globalFile
317    
318     C-- Write model fields
319     IF ( permCheckPoint ) THEN
320 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup.',myIter
321 adcroft 1.1 ELSE
322     WRITE(fn,'(A,A)') 'pickup.',checkPtSuff(nCheckLev)
323     ENDIF
324 jmc 1.5 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVel, 1,myIter,myThid)
325     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gU, 2,myIter,myThid)
326     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gUnm1, 3,myIter,myThid)
327     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVel, 4,myIter,myThid)
328     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gV, 5,myIter,myThid)
329     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gVnm1, 6,myIter,myThid)
330     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,theta, 7,myIter,myThid)
331     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gT, 8,myIter,myThid)
332     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gTnm1, 9,myIter,myThid)
333     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,salt, 10,myIter,myThid)
334     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gS, 11,myIter,myThid)
335     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gSnm1,12,myIter,myThid)
336 jmc 1.6 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaN,12*Nr+1,
337 jmc 1.5 & myIter,myThid)
338 adcroft 1.1 #ifdef INCLUDE_CD_CODE
339     IF ( permCheckPoint ) THEN
340 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup_cd.',myIter
341 adcroft 1.1 ELSE
342     WRITE(fn,'(A,A)') 'pickup_cd.',checkPtSuff(nCheckLev)
343     ENDIF
344 jmc 1.5 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uVelD,1,myIter,myThid)
345     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vVelD,2,myIter,myThid)
346     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,uNM1, 3,myIter,myThid)
347     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,vNM1, 4,myIter,myThid)
348     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,guCD, 5,myIter,myThid)
349     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gvCD, 6,myIter,myThid)
350 jmc 1.6 CALL MDSWRITEFIELD(fn,prec,lgf,'RL', 1,etaNm1,6*Nr+1,
351 jmc 1.5 & myIter,myThid)
352 adcroft 1.1 #endif
353     #ifdef ALLOW_NONHYDROSTATIC
354     IF ( nonHydrostatic ) THEN
355     IF ( permCheckPoint ) THEN
356 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
357 adcroft 1.1 ELSE
358     WRITE(fn,'(A,A)') 'pickup_nh.',checkPtSuff(nCheckLev)
359     ENDIF
360 jmc 1.5 WRITE(fn,'(A,I10.10)') 'pickup_nh.',myIter
361 jmc 1.7 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,cg3d_x,1,myIter,myThid)
362 jmc 1.5 CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gW, 2,myIter,myThid)
363 jmc 1.7 c CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nr,gWnm1,3,myIter,myThid)
364 adcroft 1.1 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