model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.20 2005/11/08 23:01:10 cnh 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  
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     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	jmc	1.21	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.20 2005/11/08 23:01:10 cnh 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			CEOP
58
59			permCheckPoint = .FALSE.
60			tempCheckPoint = .FALSE.
61			permCheckPoint=
62	jmc	1.21	& DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
63	jmc	1.1	tempCheckPoint=
64	jmc	1.21	& DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
65	dimitri	1.12
66			#ifdef ALLOW_CAL
67	jmc	1.21	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	dimitri	1.12	ENDIF
75	jmc	1.21	#endif /* ALLOW_CAL */
76	dimitri	1.12
77	edhill	1.6	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	jmc	1.1
92			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
93	edhill	1.6	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 myThid :: Thread number for this instance of the routine.
117			C myIter :: Iteration number
118			C myTime :: Current time of simulation ( s )
119			LOGICAL permCheckPoint
120			INTEGER myThid
121			INTEGER myIter
122			_RL myTime
123	jmc	1.1
124	edhill	1.6	C == Common blocks ==
125			COMMON /PCKP_GBLFLS/ globalFile
126			LOGICAL globalFile
127	jmc	1.1
128	edhill	1.6	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	jmc	1.1
138	edhill	1.6	C Going to really do some IO. Make everyone except master thread wait.
139			_BARRIER
140	cnh	1.20	C _BEGIN_MASTER( myThid )
141	edhill	1.6
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	jmc	1.1
152			#ifdef ALLOW_CD_CODE
153	edhill	1.6	IF (useCDscheme) THEN
154			CALL CD_CODE_WRITE_CHECKPOINT(
155			& prec, lgf, permCheckPoint, myIter, myThid)
156			ENDIF
157	jmc	1.1	#endif /* ALLOW_CD_CODE */
158
159			#ifdef ALLOW_OBCS
160	edhill	1.6	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	jmc	1.1	#endif /* ALLOW_OBCS */
166	edhill	1.6
167	jmc	1.3	#ifdef ALLOW_SEAICE
168	edhill	1.6	IF ( useSEAICE ) THEN
169			CALL SEAICE_WRITE_PICKUP(
170			& prec, lgf, permCheckPoint, myIter, myThid)
171			ENDIF
172	jmc	1.3	#endif /* ALLOW_SEAICE */
173	jmc	1.1
174			#ifdef ALLOW_THSICE
175	edhill	1.6	IF (useThSIce) THEN
176			CALL THSICE_WRITE_PICKUP(
177			& prec, lgf, permCheckPoint, myIter, myThid)
178			ENDIF
179	jmc	1.1	#endif /* ALLOW_THSICE */
180	jmc	1.2
181			#ifdef COMPONENT_MODULE
182	edhill	1.6	IF (useCoupler) THEN
183			CALL CPL_WRITE_PICKUP(
184			& prec, lgf, permCheckPoint, myIter, myThid)
185			ENDIF
186	jmc	1.2	#endif /* COMPONENT_MODULE */
187	jmc	1.1
188			#ifdef ALLOW_FLT
189	edhill	1.6	C Write restart file for floats
190			IF (useFLT) THEN
191			CALL FLT_RESTART(myTime, myIter, myThid)
192			ENDIF
193	jmc	1.1	#endif
194
195			#ifdef ALLOW_LAND
196	edhill	1.17	C Write pickup file for Land package:
197	edhill	1.6	IF (useLand) THEN
198	edhill	1.17	CALL LAND_WRITE_PICKUP(permCheckPoint,fn,
199			& myTime,myIter,myThid)
200	edhill	1.6	ENDIF
201	jmc	1.1	#endif
202	molod	1.4
203			#ifdef ALLOW_FIZHI
204	edhill	1.6	C Write pickup file for fizhi package
205			IF (usefizhi) THEN
206			CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
207	molod	1.8	CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
208	molod	1.10	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
209	edhill	1.6	ENDIF
210	molod	1.4	#endif
211
212	edhill	1.11	#ifdef ALLOW_DIAGNOSTICS
213			C Write pickup file for diagnostics package
214			IF (useDiagnostics) THEN
215	edhill	1.18	CALL DIAGNOSTICS_WRITE_PICKUP(permCheckPoint,
216			& fn,myTime,myIter,myThid)
217	edhill	1.11	ENDIF
218			#endif
219
220	mlosch	1.9	#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	cnh	1.20	C _END_MASTER( myThid )
228	edhill	1.15	_BARRIER
229	jmc	1.1
230			#ifdef ALLOW_PTRACERS
231	edhill	1.15	C Write restart file for passive tracers
232			IF (usePTRACERS) THEN
233	edhill	1.16	CALL PTRACERS_WRITE_CHECKPOINT(permCheckPoint,
234			& fn,myIter,myTime,myThid)
235	edhill	1.15	ENDIF
236	jmc	1.1	#endif /* ALLOW_PTRACERS */
237
238	edhill	1.15	#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			nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
244			ENDIF
245			#endif /* ALLOW_OFFLINE */
246
247	jmc	1.1	RETURN
248			END
249	edhill	1.6
250			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|