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	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.12 2005/02/20 11:46:24 dimitri 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 DIFF_BASE_MULTIPLE
32	EXTERNAL DIFF_BASE_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 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	INTEGER thisdate(4), prevdate(4)
58	CEOP
59
60	permCheckPoint = .FALSE.
61	tempCheckPoint = .FALSE.
62	permCheckPoint=
63	& DIFF_BASE_MULTIPLE(baseTime,pChkptFreq,myTime,deltaTClock)
64	tempCheckPoint=
65	& DIFF_BASE_MULTIPLE(baseTime, ChkptFreq,myTime,deltaTClock)
66
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	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
112	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
113	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
144	C == Common blocks ==
145	COMMON /PCKP_GBLFLS/ globalFile
146	LOGICAL globalFile
147
148	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
158	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
172	#ifdef ALLOW_CD_CODE
173	IF (useCDscheme) THEN
174	CALL CD_CODE_WRITE_CHECKPOINT(
175	& prec, lgf, permCheckPoint, myIter, myThid)
176	ENDIF
177	#endif /* ALLOW_CD_CODE */
178
179	#ifdef ALLOW_OBCS
180	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	#endif /* ALLOW_OBCS */
186
187	#ifdef ALLOW_SEAICE
188	IF ( useSEAICE ) THEN
189	CALL SEAICE_WRITE_PICKUP(
190	& prec, lgf, permCheckPoint, myIter, myThid)
191	ENDIF
192	#endif /* ALLOW_SEAICE */
193
194	#ifdef ALLOW_THSICE
195	IF (useThSIce) THEN
196	CALL THSICE_WRITE_PICKUP(
197	& prec, lgf, permCheckPoint, myIter, myThid)
198	ENDIF
199	#endif /* ALLOW_THSICE */
200
201	#ifdef COMPONENT_MODULE
202	IF (useCoupler) THEN
203	CALL CPL_WRITE_PICKUP(
204	& prec, lgf, permCheckPoint, myIter, myThid)
205	ENDIF
206	#endif /* COMPONENT_MODULE */
207
208	#ifdef ALLOW_FLT
209	C Write restart file for floats
210	IF (useFLT) THEN
211	CALL FLT_RESTART(myTime, myIter, myThid)
212	ENDIF
213	#endif
214
215	#ifdef ALLOW_LAND
216	C Write pickup file for Lnad package:
217	IF (useLand) THEN
218	CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)
219	ENDIF
220	#endif
221
222	#ifdef ALLOW_FIZHI
223	C Write pickup file for fizhi package
224	IF (usefizhi) THEN
225	CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
226	CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
227	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
228	ENDIF
229	#endif
230
231	#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	#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	_END_MASTER( myThid )
246	_BARRIER
247
248	#ifdef ALLOW_PTRACERS
249	C Write restart file for passive tracers
250	IF (usePTRACERS) THEN
251	CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)
252	ENDIF
253	#endif /* ALLOW_PTRACERS */
254
255	RETURN
256	END
257
258	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|