model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.17 2005/09/10 20:40:26 edhill 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  
      INTEGER thisdate(4), prevdate(4)
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
      _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 */

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