model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.19 2005/11/04 01:19:24 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     myThid :: Thread number for this instance of the routine.
C     myIter :: Iteration number
C     myTime :: Current time of simulation ( s )
      LOGICAL modelEnd    
      INTEGER myThid
      INTEGER myIter
      _RL     myTime

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  
#ifdef ALLOW_CAL
      INTEGER thisdate(4), prevdate(4)
#endif
CEOP

      permCheckPoint = .FALSE.
      tempCheckPoint = .FALSE.
      permCheckPoint=
     &     DIFFERENT_MULTIPLE(pChkptFreq,myTime,deltaTClock)
      tempCheckPoint=
     &     DIFFERENT_MULTIPLE( ChkptFreq,myTime,deltaTClock)

#ifdef ALLOW_CAL
      IF ( calendarDumps ) THEN
C--   Convert approximate months (30-31 days) and years (360-372 days)
C     to exact calendar months and years.
C-    First determine calendar dates for this and previous time step.
         call cal_GetDate( myiter  ,mytime            ,thisdate,mythid )
         call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )
C-    Monthly pChkptFreq:
         IF( pChkptFreq.GE. 2592000 .AND. pChkptFreq.LE. 2678400 ) THEN
            permCheckPoint = .FALSE.
            IF((thisdate(1)-prevdate(1)) .GT. 50  )permCheckPoint=.TRUE.
         ENDIF
C-    Yearly  pChkptFreq:
         IF( pChkptFreq.GE.31104000 .AND. pChkptFreq.LE.31968000 ) THEN
            permCheckPoint = .FALSE.
            IF((thisdate(1)-prevdate(1)) .GT. 5000)permCheckPoint=.TRUE.
         ENDIF
C-    Monthly  ChkptFreq:
         IF(  ChkptFreq.GE. 2592000 .AND.  ChkptFreq.LE. 2678400 ) THEN
            tempCheckPoint = .FALSE.
            IF((thisdate(1)-prevdate(1)) .GT. 50  )tempCheckPoint=.TRUE.
         ENDIF
C-    Yearly   ChkptFreq:
         IF(  ChkptFreq.GE.31104000 .AND.  ChkptFreq.LE.31968000 ) THEN
            tempCheckPoint = .FALSE.
            IF((thisdate(1)-prevdate(1)) .GT. 5000)tempCheckPoint=.TRUE.
         ENDIF
      ENDIF
#endif

      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     myThid :: Thread number for this instance of the routine.
C     myIter :: Iteration number
C     myTime :: Current time of simulation ( s )
      LOGICAL permCheckPoint
      INTEGER myThid
      INTEGER myIter
      _RL     myTime

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 */

C     _END_MASTER( myThid )
      _BARRIER

#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 */

#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
        nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
      ENDIF
#endif /* ALLOW_OFFLINE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	cnh	1.20	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.19 2005/11/04 01:19:24 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PACKAGES_CONFIG.h"
5			#include "CPP_OPTIONS.h"
6
7	edhill	1.6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
8	jmc	1.1	CBOP
9			C !ROUTINE: PACKAGES_WRITE_PICKUP
10	edhill	1.6
11	jmc	1.1	C !INTERFACE:
12			SUBROUTINE PACKAGES_WRITE_PICKUP(
13	edhill	1.6	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	jmc	1.1
25			C !USES:
26			IMPLICIT NONE
27			#include "SIZE.h"
28			#include "EEPARAMS.h"
29			#include "PARAMS.h"
30
31	jmc	1.14	LOGICAL DIFFERENT_MULTIPLE
32			EXTERNAL DIFFERENT_MULTIPLE
33	jmc	1.1	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 myThid :: Thread number for this instance of the routine.
40			C myIter :: Iteration number
41			C myTime :: Current time of simulation ( s )
42			LOGICAL modelEnd
43			INTEGER myThid
44			INTEGER myIter
45			_RL myTime
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	jmc	1.19	#ifdef ALLOW_CAL
58	dimitri	1.12	INTEGER thisdate(4), prevdate(4)
59	jmc	1.19	#endif
60	jmc	1.1	CEOP
61
62			permCheckPoint = .FALSE.
63			tempCheckPoint = .FALSE.
64			permCheckPoint=
65	jmc	1.14	& DIFFERENT_MULTIPLE(pChkptFreq,myTime,deltaTClock)
66	jmc	1.1	tempCheckPoint=
67	jmc	1.14	& DIFFERENT_MULTIPLE( ChkptFreq,myTime,deltaTClock)
68	dimitri	1.12
69			#ifdef ALLOW_CAL
70			IF ( calendarDumps ) THEN
71			C-- Convert approximate months (30-31 days) and years (360-372 days)
72			C to exact calendar months and years.
73			C- First determine calendar dates for this and previous time step.
74			call cal_GetDate( myiter ,mytime ,thisdate,mythid )
75			call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )
76			C- Monthly pChkptFreq:
77			IF( pChkptFreq.GE. 2592000 .AND. pChkptFreq.LE. 2678400 ) THEN
78			permCheckPoint = .FALSE.
79			IF((thisdate(1)-prevdate(1)) .GT. 50 )permCheckPoint=.TRUE.
80			ENDIF
81			C- Yearly pChkptFreq:
82			IF( pChkptFreq.GE.31104000 .AND. pChkptFreq.LE.31968000 ) THEN
83			permCheckPoint = .FALSE.
84			IF((thisdate(1)-prevdate(1)) .GT. 5000)permCheckPoint=.TRUE.
85			ENDIF
86			C- Monthly ChkptFreq:
87			IF( ChkptFreq.GE. 2592000 .AND. ChkptFreq.LE. 2678400 ) THEN
88			tempCheckPoint = .FALSE.
89			IF((thisdate(1)-prevdate(1)) .GT. 50 )tempCheckPoint=.TRUE.
90			ENDIF
91			C- Yearly ChkptFreq:
92			IF( ChkptFreq.GE.31104000 .AND. ChkptFreq.LE.31968000 ) THEN
93			tempCheckPoint = .FALSE.
94			IF((thisdate(1)-prevdate(1)) .GT. 5000)tempCheckPoint=.TRUE.
95			ENDIF
96			ENDIF
97			#endif
98
99	edhill	1.6	IF (
100			& ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
101			& .OR.
102			& ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
103			& ) THEN
104
105			CALL PACKAGES_WRITE_PICKUP_NOW(
106			& permCheckPoint, myTime, myIter, myThid )
107
108			ENDIF
109
110			RETURN
111			END
112
113	jmc	1.1
114			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
115	edhill	1.6	CBOP
116			C !ROUTINE: PACKAGES_WRITE_PICKUP_NOW
117
118			C !INTERFACE:
119			SUBROUTINE PACKAGES_WRITE_PICKUP_NOW(
120			I permCheckPoint,
121			I myTime,
122			I myIter,
123			I myThid )
124
125			C !DESCRIPTION:
126			C Write pickup files for each package which needs it to restart and
127			C do it NOW.
128
129			C !USES:
130			IMPLICIT NONE
131			#include "SIZE.h"
132			#include "EEPARAMS.h"
133			#include "PARAMS.h"
134
135
136			C !INPUT/OUTPUT PARAMETERS:
137			C permCheckPoint :: Checkpoint is permanent
138			C myThid :: Thread number for this instance of the routine.
139			C myIter :: Iteration number
140			C myTime :: Current time of simulation ( s )
141			LOGICAL permCheckPoint
142			INTEGER myThid
143			INTEGER myIter
144			_RL myTime
145	jmc	1.1
146	edhill	1.6	C == Common blocks ==
147			COMMON /PCKP_GBLFLS/ globalFile
148			LOGICAL globalFile
149	jmc	1.1
150	edhill	1.6	C !LOCAL VARIABLES:
151			C == Local variables ==
152			C oldPrc :: Temp. for holding I/O precision
153			C fn :: Temp. for building file name string.
154			C lgf :: Flag to indicate whether to use global file mode.
155			CHARACTER*(MAX_LEN_FNAM) fn
156			INTEGER prec
157			LOGICAL lgf
158			CEOP
159	jmc	1.1
160	edhill	1.6	C Going to really do some IO. Make everyone except master thread wait.
161			_BARRIER
162	cnh	1.20	C _BEGIN_MASTER( myThid )
163	edhill	1.6
164			prec = precFloat64
165			lgf = globalFile
166
167			C Create suffix to pass on to package pickup routines
168			IF ( permCheckPoint ) THEN
169			WRITE(fn,'(I10.10)') myIter
170			ELSE
171			WRITE(fn,'(A)') checkPtSuff(nCheckLev)
172			ENDIF
173	jmc	1.1
174			#ifdef ALLOW_CD_CODE
175	edhill	1.6	IF (useCDscheme) THEN
176			CALL CD_CODE_WRITE_CHECKPOINT(
177			& prec, lgf, permCheckPoint, myIter, myThid)
178			ENDIF
179	jmc	1.1	#endif /* ALLOW_CD_CODE */
180
181			#ifdef ALLOW_OBCS
182	edhill	1.6	C SPK 4/9/01: Open boundary checkpointing
183			IF (useOBCS) THEN
184			CALL OBCS_WRITE_CHECKPOINT(
185			& prec, lgf, permCheckPoint, myIter, myThid)
186			ENDIF
187	jmc	1.1	#endif /* ALLOW_OBCS */
188	edhill	1.6
189	jmc	1.3	#ifdef ALLOW_SEAICE
190	edhill	1.6	IF ( useSEAICE ) THEN
191			CALL SEAICE_WRITE_PICKUP(
192			& prec, lgf, permCheckPoint, myIter, myThid)
193			ENDIF
194	jmc	1.3	#endif /* ALLOW_SEAICE */
195	jmc	1.1
196			#ifdef ALLOW_THSICE
197	edhill	1.6	IF (useThSIce) THEN
198			CALL THSICE_WRITE_PICKUP(
199			& prec, lgf, permCheckPoint, myIter, myThid)
200			ENDIF
201	jmc	1.1	#endif /* ALLOW_THSICE */
202	jmc	1.2
203			#ifdef COMPONENT_MODULE
204	edhill	1.6	IF (useCoupler) THEN
205			CALL CPL_WRITE_PICKUP(
206			& prec, lgf, permCheckPoint, myIter, myThid)
207			ENDIF
208	jmc	1.2	#endif /* COMPONENT_MODULE */
209	jmc	1.1
210			#ifdef ALLOW_FLT
211	edhill	1.6	C Write restart file for floats
212			IF (useFLT) THEN
213			CALL FLT_RESTART(myTime, myIter, myThid)
214			ENDIF
215	jmc	1.1	#endif
216
217			#ifdef ALLOW_LAND
218	edhill	1.17	C Write pickup file for Land package:
219	edhill	1.6	IF (useLand) THEN
220	edhill	1.17	CALL LAND_WRITE_PICKUP(permCheckPoint,fn,
221			& myTime,myIter,myThid)
222	edhill	1.6	ENDIF
223	jmc	1.1	#endif
224	molod	1.4
225			#ifdef ALLOW_FIZHI
226	edhill	1.6	C Write pickup file for fizhi package
227			IF (usefizhi) THEN
228			CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
229	molod	1.8	CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
230	molod	1.10	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
231	edhill	1.6	ENDIF
232	molod	1.4	#endif
233
234	edhill	1.11	#ifdef ALLOW_DIAGNOSTICS
235			C Write pickup file for diagnostics package
236			IF (useDiagnostics) THEN
237	edhill	1.18	CALL DIAGNOSTICS_WRITE_PICKUP(permCheckPoint,
238			& fn,myTime,myIter,myThid)
239	edhill	1.11	ENDIF
240			#endif
241
242	mlosch	1.9	#ifdef ALLOW_GGL90
243			IF ( useGGL90 ) THEN
244			CALL GGL90_WRITE_CHECKPOINT(
245			& prec, lgf, permCheckPoint, myIter, myThid)
246			ENDIF
247			#endif /* ALLOW_GGL90 */
248
249	cnh	1.20	C _END_MASTER( myThid )
250	edhill	1.15	_BARRIER
251	jmc	1.1
252			#ifdef ALLOW_PTRACERS
253	edhill	1.15	C Write restart file for passive tracers
254			IF (usePTRACERS) THEN
255	edhill	1.16	CALL PTRACERS_WRITE_CHECKPOINT(permCheckPoint,
256			& fn,myIter,myTime,myThid)
257	edhill	1.15	ENDIF
258	jmc	1.1	#endif /* ALLOW_PTRACERS */
259
260	edhill	1.15	#ifdef ALLOW_OFFLINE
261			C This is quick fix for A/B checkpoints since the main model
262			C checkpoint routine will not be called in OFFLINE mode and will
263			C thus not have the chance to set the alternating A/B suffix
264			IF ( .NOT. permCheckPoint ) THEN
265			nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
266			ENDIF
267			#endif /* ALLOW_OFFLINE */
268
269	jmc	1.1	RETURN
270			END
271	edhill	1.6
272			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|