model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.6 2004/08/06 21:12:14 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  
CEOP

      permCheckPoint = .FALSE.
      tempCheckPoint = .FALSE.
      permCheckPoint=
     &     DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)
      tempCheckPoint=
     &     DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)
      
      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,'D',myTime,myIter,myThid)
      ENDIF
#endif

       _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	molod	1.7	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.6 2004/08/06 21:12:14 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			LOGICAL DIFFERENT_MULTIPLE
32			EXTERNAL DIFFERENT_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			CEOP
58
59			permCheckPoint = .FALSE.
60			tempCheckPoint = .FALSE.
61			permCheckPoint=
62	edhill	1.6	& DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)
63	jmc	1.1	tempCheckPoint=
64	edhill	1.6	& DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)
65
66			IF (
67			& ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
68			& .OR.
69			& ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
70			& ) THEN
71
72			CALL PACKAGES_WRITE_PICKUP_NOW(
73			& permCheckPoint, myTime, myIter, myThid )
74
75			ENDIF
76
77			RETURN
78			END
79
80	jmc	1.1
81			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
82	edhill	1.6	CBOP
83			C !ROUTINE: PACKAGES_WRITE_PICKUP_NOW
84
85			C !INTERFACE:
86			SUBROUTINE PACKAGES_WRITE_PICKUP_NOW(
87			I permCheckPoint,
88			I myTime,
89			I myIter,
90			I myThid )
91
92			C !DESCRIPTION:
93			C Write pickup files for each package which needs it to restart and
94			C do it NOW.
95
96			C !USES:
97			IMPLICIT NONE
98			#include "SIZE.h"
99			#include "EEPARAMS.h"
100			#include "PARAMS.h"
101
102
103			C !INPUT/OUTPUT PARAMETERS:
104			C permCheckPoint :: Checkpoint is permanent
105			C myThid :: Thread number for this instance of the routine.
106			C myIter :: Iteration number
107			C myTime :: Current time of simulation ( s )
108			LOGICAL permCheckPoint
109			INTEGER myThid
110			INTEGER myIter
111			_RL myTime
112	jmc	1.1
113	edhill	1.6	C == Common blocks ==
114			COMMON /PCKP_GBLFLS/ globalFile
115			LOGICAL globalFile
116	jmc	1.1
117	edhill	1.6	C !LOCAL VARIABLES:
118			C == Local variables ==
119			C oldPrc :: Temp. for holding I/O precision
120			C fn :: Temp. for building file name string.
121			C lgf :: Flag to indicate whether to use global file mode.
122			CHARACTER*(MAX_LEN_FNAM) fn
123			INTEGER prec
124			LOGICAL lgf
125			CEOP
126	jmc	1.1
127	edhill	1.6	C Going to really do some IO. Make everyone except master thread wait.
128			_BARRIER
129			_BEGIN_MASTER( myThid )
130
131			prec = precFloat64
132			lgf = globalFile
133
134			C Create suffix to pass on to package pickup routines
135			IF ( permCheckPoint ) THEN
136			WRITE(fn,'(I10.10)') myIter
137			ELSE
138			WRITE(fn,'(A)') checkPtSuff(nCheckLev)
139			ENDIF
140	jmc	1.1
141			#ifdef ALLOW_CD_CODE
142	edhill	1.6	IF (useCDscheme) THEN
143			CALL CD_CODE_WRITE_CHECKPOINT(
144			& prec, lgf, permCheckPoint, myIter, myThid)
145			ENDIF
146	jmc	1.1	#endif /* ALLOW_CD_CODE */
147
148			#ifdef ALLOW_OBCS
149	edhill	1.6	C SPK 4/9/01: Open boundary checkpointing
150			IF (useOBCS) THEN
151			CALL OBCS_WRITE_CHECKPOINT(
152			& prec, lgf, permCheckPoint, myIter, myThid)
153			ENDIF
154	jmc	1.1	#endif /* ALLOW_OBCS */
155	edhill	1.6
156	jmc	1.3	#ifdef ALLOW_SEAICE
157	edhill	1.6	IF ( useSEAICE ) THEN
158			CALL SEAICE_WRITE_PICKUP(
159			& prec, lgf, permCheckPoint, myIter, myThid)
160			ENDIF
161	jmc	1.3	#endif /* ALLOW_SEAICE */
162	jmc	1.1
163			#ifdef ALLOW_THSICE
164	edhill	1.6	IF (useThSIce) THEN
165			CALL THSICE_WRITE_PICKUP(
166			& prec, lgf, permCheckPoint, myIter, myThid)
167			ENDIF
168	jmc	1.1	#endif /* ALLOW_THSICE */
169	jmc	1.2
170			#ifdef COMPONENT_MODULE
171	edhill	1.6	IF (useCoupler) THEN
172			CALL CPL_WRITE_PICKUP(
173			& prec, lgf, permCheckPoint, myIter, myThid)
174			ENDIF
175	jmc	1.2	#endif /* COMPONENT_MODULE */
176	jmc	1.1
177			#ifdef ALLOW_FLT
178	edhill	1.6	C Write restart file for floats
179			IF (useFLT) THEN
180			CALL FLT_RESTART(myTime, myIter, myThid)
181			ENDIF
182	jmc	1.1	#endif
183
184			#ifdef ALLOW_LAND
185	edhill	1.6	C Write pickup file for Lnad package:
186			IF (useLand) THEN
187			CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)
188			ENDIF
189	jmc	1.1	#endif
190	molod	1.4
191			#ifdef ALLOW_FIZHI
192	edhill	1.6	C Write pickup file for fizhi package
193			IF (usefizhi) THEN
194			CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
195	molod	1.7	CALL FIZHI_WRITE_VEGTILES(fn,'D',myTime,myIter,myThid)
196	edhill	1.6	ENDIF
197	molod	1.4	#endif
198
199	jmc	1.1	_END_MASTER( myThid )
200			_BARRIER
201
202			#ifdef ALLOW_PTRACERS
203	edhill	1.6	C Write restart file for passive tracers
204	jmc	1.1	IF (usePTRACERS) THEN
205			CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)
206			ENDIF
207			#endif /* ALLOW_PTRACERS */
208
209			RETURN
210			END
211	edhill	1.6
212			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|