model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.12 2005/02/20 11:46:24 dimitri 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  DIFF_BASE_MULTIPLE
      EXTERNAL DIFF_BASE_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=
     &     DIFF_BASE_MULTIPLE(baseTime,pChkptFreq,myTime,deltaTClock)
      tempCheckPoint=
     &     DIFF_BASE_MULTIPLE(baseTime, 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 Lnad package:
      IF (useLand) THEN
        CALL LAND_WRITE_PICKUP(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(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(fn,myIter,myTime,myThid)
       ENDIF
#endif /* ALLOW_PTRACERS */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	jmc	1.13	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.12 2005/02/20 11:46:24 dimitri 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.13	LOGICAL DIFF_BASE_MULTIPLE
32			EXTERNAL DIFF_BASE_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.13	& DIFF_BASE_MULTIPLE(baseTime,pChkptFreq,myTime,deltaTClock)
64	jmc	1.1	tempCheckPoint=
65	jmc	1.13	& DIFF_BASE_MULTIPLE(baseTime, 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.6	C Write pickup file for Lnad package:
217			IF (useLand) THEN
218			CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)
219			ENDIF
220	jmc	1.1	#endif
221	molod	1.4
222			#ifdef ALLOW_FIZHI
223	edhill	1.6	C Write pickup file for fizhi package
224			IF (usefizhi) THEN
225			CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
226	molod	1.8	CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
227	molod	1.10	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
228	edhill	1.6	ENDIF
229	molod	1.4	#endif
230
231	edhill	1.11	#ifdef ALLOW_DIAGNOSTICS
232			C Write pickup file for diagnostics package
233			IF (useDiagnostics) THEN
234			CALL DIAGNOSTICS_WRITE_PICKUP(fn,myTime,myIter,myThid)
235			ENDIF
236			#endif
237
238	mlosch	1.9	#ifdef ALLOW_GGL90
239			IF ( useGGL90 ) THEN
240			CALL GGL90_WRITE_CHECKPOINT(
241			& prec, lgf, permCheckPoint, myIter, myThid)
242			ENDIF
243			#endif /* ALLOW_GGL90 */
244
245	jmc	1.1	_END_MASTER( myThid )
246			_BARRIER
247
248			#ifdef ALLOW_PTRACERS
249	edhill	1.6	C Write restart file for passive tracers
250	jmc	1.1	IF (usePTRACERS) THEN
251			CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)
252			ENDIF
253			#endif /* ALLOW_PTRACERS */
254
255			RETURN
256			END
257	edhill	1.6
258			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|