/[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.2 - (hide annotations) (download)
Fri Jul 30 15:42:58 1999 UTC (24 years, 10 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 adcroft 1.2 C $Header: /u/gcmpack/models/MITgcmUV/model/src/checkpoint.F,v 1.1 1999/05/05 18:32:34 adcroft 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     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 adcroft 1.2 _RL myCurrentTime
241 adcroft 1.1 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