model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.21 2006/03/20 15:11:18 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PACKAGES_WRITE_PICKUP

C     !INTERFACE:
      SUBROUTINE PACKAGES_WRITE_PICKUP(
     I     modelEnd,
     I     myTime,
     I     myIter,
     I     myThid )

C     !DESCRIPTION:
C     Write pickup files for each package which needs it to restart.
C     This routine (S/R PACKAGES_WRITE_PICKUP) calls per-package
C     write-pickup (or checkpoint) routines.  It writes both
C     "rolling-checkpoint" files (ckptA,ckptB) and permanent checkpoint
C     files.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE
      INTEGER  IO_ERRCOUNT
      EXTERNAL IO_ERRCOUNT

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     modelEnd    :: Checkpoint call at end of model run.
C     myTime :: Current time of simulation ( s )
C     myIter :: Iteration number
C     myThid :: Thread number for this instance of the routine.
      LOGICAL modelEnd
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     permCheckPoint :: Flag indicating whether a permanent checkpoint will
C                       be written.
C     tempCheckPoint :: Flag indicating if it is time to write a non-permanent
C                       checkpoint (that will be permanent if permCheckPoint=T)
C     oldPrc :: Temp. for holding I/O precision
C     fn     :: Temp. for building file name string.
C     lgf    :: Flag to indicate whether to use global file mode.
      LOGICAL permCheckPoint, tempCheckPoint
CEOP

      permCheckPoint = .FALSE.
      tempCheckPoint = .FALSE.
      permCheckPoint=
     &     DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
      tempCheckPoint=
     &     DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)

#ifdef ALLOW_CAL
      IF ( useCAL ) THEN
         CALL CAL_TIME2DUMP( pChkPtFreq, deltaTClock,
     U                       permCheckPoint,
     I                       myTime, myIter, myThid )
         CALL CAL_TIME2DUMP( chkPtFreq,  deltaTClock,
     U                       tempCheckPoint,
     I                       myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_CAL */

      IF (
     &     ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
     &     .OR.
     &     ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
     &     ) THEN

        CALL PACKAGES_WRITE_PICKUP_NOW(
     &       permCheckPoint, myTime, myIter, myThid )

      ENDIF

      RETURN
      END


C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PACKAGES_WRITE_PICKUP_NOW

C     !INTERFACE:
      SUBROUTINE PACKAGES_WRITE_PICKUP_NOW(
     I     permCheckPoint,
     I     myTime,
     I     myIter,
     I     myThid )

C     !DESCRIPTION:
C     Write pickup files for each package which needs it to restart and
C     do it NOW.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"


C     !INPUT/OUTPUT PARAMETERS:
C     permCheckPoint  :: Checkpoint is permanent
C     myTime :: Current time of simulation ( s )
C     myIter :: Iteration number
C     myThid :: Thread number for this instance of the routine.
      LOGICAL permCheckPoint
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

C     == Common blocks ==
      COMMON /PCKP_GBLFLS/ globalFile
      LOGICAL globalFile

C     !LOCAL VARIABLES:
C     == Local variables ==
C     oldPrc :: Temp. for holding I/O precision
C     fn     :: Temp. for building file name string.
C     lgf    :: Flag to indicate whether to use global file mode.
      CHARACTER*(MAX_LEN_FNAM) fn
      INTEGER prec
      LOGICAL lgf
CEOP

C     Going to really do some IO. Make everyone except master thread wait.
      _BARRIER
C     _BEGIN_MASTER( myThid )

      prec = precFloat64
      lgf = globalFile

C     Create suffix to pass on to package pickup routines
      IF ( permCheckPoint ) THEN
        WRITE(fn,'(I10.10)') myIter
      ELSE
        WRITE(fn,'(A)') checkPtSuff(nCheckLev)
      ENDIF

#ifdef ALLOW_CD_CODE
      IF (useCDscheme) THEN
        CALL CD_CODE_WRITE_CHECKPOINT(
     &       prec, lgf, permCheckPoint, myIter, myThid)
      ENDIF
#endif /* ALLOW_CD_CODE */

#ifdef  ALLOW_OBCS
C     SPK 4/9/01: Open boundary checkpointing
      IF (useOBCS) THEN
        CALL OBCS_WRITE_CHECKPOINT(
     &       prec, lgf, permCheckPoint, myIter, myThid)
      ENDIF
#endif  /* ALLOW_OBCS */

#ifdef  ALLOW_SEAICE
      IF ( useSEAICE ) THEN
        CALL SEAICE_WRITE_PICKUP(
     &       prec, lgf, permCheckPoint, myIter, myThid)
      ENDIF
#endif  /* ALLOW_SEAICE */

#ifdef ALLOW_THSICE
      IF (useThSIce) THEN
        CALL THSICE_WRITE_PICKUP(
     &       prec, lgf, permCheckPoint, myIter, myThid)
      ENDIF
#endif /* ALLOW_THSICE */

#ifdef  COMPONENT_MODULE
      IF (useCoupler) THEN
        CALL CPL_WRITE_PICKUP(
     &       prec, lgf, permCheckPoint, myIter, myThid)
      ENDIF
#endif  /* COMPONENT_MODULE */

#ifdef ALLOW_FLT
C     Write restart file for floats
      IF (useFLT) THEN
        CALL FLT_RESTART(myTime, myIter, myThid)
      ENDIF
#endif

#ifdef ALLOW_LAND
C     Write pickup file for Land package:
      IF (useLand) THEN
        CALL LAND_WRITE_PICKUP(permCheckPoint,fn,
     &       myTime,myIter,myThid)
      ENDIF
#endif

#ifdef ALLOW_FIZHI
C     Write pickup file for fizhi package
      IF (usefizhi) THEN
        CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
        CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
        CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
      ENDIF
#endif

#ifdef ALLOW_DIAGNOSTICS
C     Write pickup file for diagnostics package
      IF (useDiagnostics) THEN
        CALL DIAGNOSTICS_WRITE_PICKUP(permCheckPoint,
     &       fn,myTime,myIter,myThid)
      ENDIF
#endif

#ifdef  ALLOW_GGL90
      IF ( useGGL90 ) THEN
        CALL GGL90_WRITE_CHECKPOINT(
     &       prec, lgf, permCheckPoint, myIter, myThid)
      ENDIF
#endif  /* ALLOW_GGL90 */

#ifdef ALLOW_PTRACERS
C     Write restart file for passive tracers
      IF (usePTRACERS) THEN
        CALL PTRACERS_WRITE_CHECKPOINT(permCheckPoint,
     &       fn,myIter,myTime,myThid)
      ENDIF
#endif /* ALLOW_PTRACERS */

C     _END_MASTER( myThid )
      _BARRIER

#ifdef ALLOW_OFFLINE
C     This is quick fix for A/B checkpoints since the main model
C     checkpoint routine will not be called in OFFLINE mode and will
C     thus not have the chance to set the alternating A/B suffix
      IF ( .NOT. permCheckPoint ) THEN
        _BEGIN_MASTER( myThid )
        nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
        _END_MASTER( myThid )
      ENDIF
#endif /* ALLOW_OFFLINE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.21 2006/03/20 15:11:18 jmc Exp $
2	C $Name: $
3
4	#include "PACKAGES_CONFIG.h"
5	#include "CPP_OPTIONS.h"
6
7	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
8	CBOP
9	C !ROUTINE: PACKAGES_WRITE_PICKUP
10
11	C !INTERFACE:
12	SUBROUTINE PACKAGES_WRITE_PICKUP(
13	I modelEnd,
14	I myTime,
15	I myIter,
16	I myThid )
17
18	C !DESCRIPTION:
19	C Write pickup files for each package which needs it to restart.
20	C This routine (S/R PACKAGES_WRITE_PICKUP) calls per-package
21	C write-pickup (or checkpoint) routines. It writes both
22	C "rolling-checkpoint" files (ckptA,ckptB) and permanent checkpoint
23	C files.
24
25	C !USES:
26	IMPLICIT NONE
27	#include "SIZE.h"
28	#include "EEPARAMS.h"
29	#include "PARAMS.h"
30
31	LOGICAL DIFFERENT_MULTIPLE
32	EXTERNAL DIFFERENT_MULTIPLE
33	INTEGER IO_ERRCOUNT
34	EXTERNAL IO_ERRCOUNT
35
36	C !INPUT/OUTPUT PARAMETERS:
37	C == Routine arguments ==
38	C modelEnd :: Checkpoint call at end of model run.
39	C myTime :: Current time of simulation ( s )
40	C myIter :: Iteration number
41	C myThid :: Thread number for this instance of the routine.
42	LOGICAL modelEnd
43	_RL myTime
44	INTEGER myIter
45	INTEGER myThid
46
47	C !LOCAL VARIABLES:
48	C == Local variables ==
49	C permCheckPoint :: Flag indicating whether a permanent checkpoint will
50	C be written.
51	C tempCheckPoint :: Flag indicating if it is time to write a non-permanent
52	C checkpoint (that will be permanent if permCheckPoint=T)
53	C oldPrc :: Temp. for holding I/O precision
54	C fn :: Temp. for building file name string.
55	C lgf :: Flag to indicate whether to use global file mode.
56	LOGICAL permCheckPoint, tempCheckPoint
57	CEOP
58
59	permCheckPoint = .FALSE.
60	tempCheckPoint = .FALSE.
61	permCheckPoint=
62	& DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
63	tempCheckPoint=
64	& DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
65
66	#ifdef ALLOW_CAL
67	IF ( useCAL ) THEN
68	CALL CAL_TIME2DUMP( pChkPtFreq, deltaTClock,
69	U permCheckPoint,
70	I myTime, myIter, myThid )
71	CALL CAL_TIME2DUMP( chkPtFreq, deltaTClock,
72	U tempCheckPoint,
73	I myTime, myIter, myThid )
74	ENDIF
75	#endif /* ALLOW_CAL */
76
77	IF (
78	& ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
79	& .OR.
80	& ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
81	& ) THEN
82
83	CALL PACKAGES_WRITE_PICKUP_NOW(
84	& permCheckPoint, myTime, myIter, myThid )
85
86	ENDIF
87
88	RETURN
89	END
90
91
92	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
93	CBOP
94	C !ROUTINE: PACKAGES_WRITE_PICKUP_NOW
95
96	C !INTERFACE:
97	SUBROUTINE PACKAGES_WRITE_PICKUP_NOW(
98	I permCheckPoint,
99	I myTime,
100	I myIter,
101	I myThid )
102
103	C !DESCRIPTION:
104	C Write pickup files for each package which needs it to restart and
105	C do it NOW.
106
107	C !USES:
108	IMPLICIT NONE
109	#include "SIZE.h"
110	#include "EEPARAMS.h"
111	#include "PARAMS.h"
112
113
114	C !INPUT/OUTPUT PARAMETERS:
115	C permCheckPoint :: Checkpoint is permanent
116	C myTime :: Current time of simulation ( s )
117	C myIter :: Iteration number
118	C myThid :: Thread number for this instance of the routine.
119	LOGICAL permCheckPoint
120	_RL myTime
121	INTEGER myIter
122	INTEGER myThid
123
124	C == Common blocks ==
125	COMMON /PCKP_GBLFLS/ globalFile
126	LOGICAL globalFile
127
128	C !LOCAL VARIABLES:
129	C == Local variables ==
130	C oldPrc :: Temp. for holding I/O precision
131	C fn :: Temp. for building file name string.
132	C lgf :: Flag to indicate whether to use global file mode.
133	CHARACTER*(MAX_LEN_FNAM) fn
134	INTEGER prec
135	LOGICAL lgf
136	CEOP
137
138	C Going to really do some IO. Make everyone except master thread wait.
139	_BARRIER
140	C _BEGIN_MASTER( myThid )
141
142	prec = precFloat64
143	lgf = globalFile
144
145	C Create suffix to pass on to package pickup routines
146	IF ( permCheckPoint ) THEN
147	WRITE(fn,'(I10.10)') myIter
148	ELSE
149	WRITE(fn,'(A)') checkPtSuff(nCheckLev)
150	ENDIF
151
152	#ifdef ALLOW_CD_CODE
153	IF (useCDscheme) THEN
154	CALL CD_CODE_WRITE_CHECKPOINT(
155	& prec, lgf, permCheckPoint, myIter, myThid)
156	ENDIF
157	#endif /* ALLOW_CD_CODE */
158
159	#ifdef ALLOW_OBCS
160	C SPK 4/9/01: Open boundary checkpointing
161	IF (useOBCS) THEN
162	CALL OBCS_WRITE_CHECKPOINT(
163	& prec, lgf, permCheckPoint, myIter, myThid)
164	ENDIF
165	#endif /* ALLOW_OBCS */
166
167	#ifdef ALLOW_SEAICE
168	IF ( useSEAICE ) THEN
169	CALL SEAICE_WRITE_PICKUP(
170	& prec, lgf, permCheckPoint, myIter, myThid)
171	ENDIF
172	#endif /* ALLOW_SEAICE */
173
174	#ifdef ALLOW_THSICE
175	IF (useThSIce) THEN
176	CALL THSICE_WRITE_PICKUP(
177	& prec, lgf, permCheckPoint, myIter, myThid)
178	ENDIF
179	#endif /* ALLOW_THSICE */
180
181	#ifdef COMPONENT_MODULE
182	IF (useCoupler) THEN
183	CALL CPL_WRITE_PICKUP(
184	& prec, lgf, permCheckPoint, myIter, myThid)
185	ENDIF
186	#endif /* COMPONENT_MODULE */
187
188	#ifdef ALLOW_FLT
189	C Write restart file for floats
190	IF (useFLT) THEN
191	CALL FLT_RESTART(myTime, myIter, myThid)
192	ENDIF
193	#endif
194
195	#ifdef ALLOW_LAND
196	C Write pickup file for Land package:
197	IF (useLand) THEN
198	CALL LAND_WRITE_PICKUP(permCheckPoint,fn,
199	& myTime,myIter,myThid)
200	ENDIF
201	#endif
202
203	#ifdef ALLOW_FIZHI
204	C Write pickup file for fizhi package
205	IF (usefizhi) THEN
206	CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
207	CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
208	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
209	ENDIF
210	#endif
211
212	#ifdef ALLOW_DIAGNOSTICS
213	C Write pickup file for diagnostics package
214	IF (useDiagnostics) THEN
215	CALL DIAGNOSTICS_WRITE_PICKUP(permCheckPoint,
216	& fn,myTime,myIter,myThid)
217	ENDIF
218	#endif
219
220	#ifdef ALLOW_GGL90
221	IF ( useGGL90 ) THEN
222	CALL GGL90_WRITE_CHECKPOINT(
223	& prec, lgf, permCheckPoint, myIter, myThid)
224	ENDIF
225	#endif /* ALLOW_GGL90 */
226
227	#ifdef ALLOW_PTRACERS
228	C Write restart file for passive tracers
229	IF (usePTRACERS) THEN
230	CALL PTRACERS_WRITE_CHECKPOINT(permCheckPoint,
231	& fn,myIter,myTime,myThid)
232	ENDIF
233	#endif /* ALLOW_PTRACERS */
234
235	C _END_MASTER( myThid )
236	_BARRIER
237
238	#ifdef ALLOW_OFFLINE
239	C This is quick fix for A/B checkpoints since the main model
240	C checkpoint routine will not be called in OFFLINE mode and will
241	C thus not have the chance to set the alternating A/B suffix
242	IF ( .NOT. permCheckPoint ) THEN
243	_BEGIN_MASTER( myThid )
244	nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
245	_END_MASTER( myThid )
246	ENDIF
247	#endif /* ALLOW_OFFLINE */
248
249	RETURN
250	END
251
252	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|