model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.4 2004/01/29 14:17:58 molod Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: PACKAGES_WRITE_PICKUP
C     !INTERFACE:
      SUBROUTINE PACKAGES_WRITE_PICKUP( 
     I                    modelEnd, myTime, myIter, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE PACKAGES_WRITE_PICKUP                               
C     | o write pickup files for each package which needs it
C     |   to restart.
C     *==========================================================*
C     | This routine (S/R PACKAGES_WRITE_PICKUP) calls 
C     | per-package write-pickup (or checkpoint) routines.
C     | o writes both "rolling-checkpoint" files (ckptA,ckptB)      
C     |   and permanent checkpoint files.
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global variables ===
#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     == Common blocks ==
      COMMON /PCKP_GBLFLS/ globalFile
      LOGICAL globalFile

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  
      CHARACTER*(MAX_LEN_FNAM) fn
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER prec
      LOGICAL lgf
CEOP

      permCheckPoint = .FALSE.
      tempCheckPoint = .FALSE.
      permCheckPoint=
     &  DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)
      tempCheckPoint=
     &  DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
      IF (
     &    ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
     &   .OR.
     &    ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
     &   ) THEN

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)
        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 */

      ENDIF

      RETURN
      END
1	jmc	1.5	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.4 2004/01/29 14:17:58 molod Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PACKAGES_CONFIG.h"
5			#include "CPP_OPTIONS.h"
6
7			CBOP
8			C !ROUTINE: PACKAGES_WRITE_PICKUP
9			C !INTERFACE:
10			SUBROUTINE PACKAGES_WRITE_PICKUP(
11			I modelEnd, myTime, myIter, myThid )
12			C !DESCRIPTION: \bv
13			C ==========================================================
14			C \| SUBROUTINE PACKAGES_WRITE_PICKUP
15			C \| o write pickup files for each package which needs it
16			C \| to restart.
17			C ==========================================================
18			C \| This routine (S/R PACKAGES_WRITE_PICKUP) calls
19			C \| per-package write-pickup (or checkpoint) routines.
20			C \| o writes both "rolling-checkpoint" files (ckptA,ckptB)
21			C \| and permanent checkpoint files.
22			C ==========================================================
23			C \ev
24
25			C !USES:
26			IMPLICIT NONE
27			C == Global variables ===
28			#include "SIZE.h"
29			#include "EEPARAMS.h"
30			#include "PARAMS.h"
31
32			LOGICAL DIFFERENT_MULTIPLE
33			EXTERNAL DIFFERENT_MULTIPLE
34			INTEGER IO_ERRCOUNT
35			EXTERNAL IO_ERRCOUNT
36
37			C !INPUT/OUTPUT PARAMETERS:
38			C == Routine arguments ==
39			C modelEnd :: Checkpoint call at end of model run.
40			C myThid :: Thread number for this instance of the routine.
41			C myIter :: Iteration number
42			C myTime :: Current time of simulation ( s )
43			LOGICAL modelEnd
44			INTEGER myThid
45			INTEGER myIter
46			_RL myTime
47
48			C == Common blocks ==
49			COMMON /PCKP_GBLFLS/ globalFile
50			LOGICAL globalFile
51
52			C !LOCAL VARIABLES:
53			C == Local variables ==
54			C permCheckPoint :: Flag indicating whether a permanent checkpoint will
55			C be written.
56			C tempCheckPoint :: Flag indicating if it is time to write a non-permanent
57			C checkpoint (that will be permanent if permCheckPoint=T)
58			C oldPrc :: Temp. for holding I/O precision
59			C fn :: Temp. for building file name string.
60			C lgf :: Flag to indicate whether to use global file mode.
61			LOGICAL permCheckPoint, tempCheckPoint
62			CHARACTER*(MAX_LEN_FNAM) fn
63			CHARACTER*(MAX_LEN_MBUF) msgBuf
64			INTEGER prec
65			LOGICAL lgf
66			CEOP
67
68			permCheckPoint = .FALSE.
69			tempCheckPoint = .FALSE.
70			permCheckPoint=
71			& DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)
72			tempCheckPoint=
73			& DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)
74
75			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
76			IF (
77			& ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
78			& .OR.
79			& ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
80			& ) THEN
81
82			C-- Going to really do some IO. Make everyone except master thread wait.
83			_BARRIER
84			_BEGIN_MASTER( myThid )
85
86			prec = precFloat64
87			lgf = globalFile
88
89			C Create suffix to pass on to package pickup routines
90			IF ( permCheckPoint ) THEN
91			WRITE(fn,'(I10.10)') myIter
92			ELSE
93			WRITE(fn,'(A)') checkPtSuff(nCheckLev)
94			ENDIF
95
96			#ifdef ALLOW_CD_CODE
97			IF (useCDscheme) THEN
98			CALL CD_CODE_WRITE_CHECKPOINT(
99			& prec, lgf, permCheckPoint, myIter, myThid)
100			ENDIF
101			#endif /* ALLOW_CD_CODE */
102
103			#ifdef ALLOW_OBCS
104			C SPK 4/9/01: Open boundary checkpointing
105			IF (useOBCS) THEN
106			CALL OBCS_WRITE_CHECKPOINT(
107			& prec, lgf, permCheckPoint, myIter, myThid)
108			ENDIF
109			#endif /* ALLOW_OBCS */
110	jmc	1.3
111			#ifdef ALLOW_SEAICE
112			IF ( useSEAICE ) THEN
113			CALL SEAICE_WRITE_PICKUP(
114			& prec, lgf, permCheckPoint, myIter, myThid)
115			ENDIF
116			#endif /* ALLOW_SEAICE */
117	jmc	1.1
118			#ifdef ALLOW_THSICE
119			IF (useThSIce) THEN
120	jmc	1.5	CALL THSICE_WRITE_PICKUP(
121	jmc	1.1	& prec, lgf, permCheckPoint, myIter, myThid)
122			ENDIF
123			#endif /* ALLOW_THSICE */
124	jmc	1.2
125			#ifdef COMPONENT_MODULE
126			IF (useCoupler) THEN
127			CALL CPL_WRITE_PICKUP(
128			& prec, lgf, permCheckPoint, myIter, myThid)
129			ENDIF
130			#endif /* COMPONENT_MODULE */
131	jmc	1.1
132			#ifdef ALLOW_FLT
133			C-- Write restart file for floats
134			IF (useFLT) THEN
135			CALL FLT_RESTART(myTime, myIter, myThid)
136			ENDIF
137			#endif
138
139			#ifdef ALLOW_LAND
140			C-- Write pickup file for Lnad package:
141			IF (useLand) THEN
142			CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)
143			ENDIF
144			#endif
145	molod	1.4
146			#ifdef ALLOW_FIZHI
147			C-- Write pickup file for fizhi package
148			IF (usefizhi) THEN
149			CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
150			ENDIF
151			#endif
152
153	jmc	1.1
154			_END_MASTER( myThid )
155			_BARRIER
156
157			#ifdef ALLOW_PTRACERS
158			C Write restart file for passive tracers
159			IF (usePTRACERS) THEN
160			CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)
161			ENDIF
162			#endif /* ALLOW_PTRACERS */
163
164			ENDIF
165
166			RETURN
167			END