model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.24 2006/10/25 20:42:34 jmc Exp $
C $Name:  $

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

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C     files.

CBOP
C     !ROUTINE: PACKAGES_WRITE_PICKUP

C     !INTERFACE:
      SUBROUTINE PACKAGES_WRITE_PICKUP(
     I                    permPickup,
     I                    myTime, myIter, 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-pickup" files (ckptA,ckptB) and permanent pickup.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     permPickup :: Is or is not a permanent pickup.
C     myTime     :: Current time of simulation ( s )
C     myIter     :: Iteration number
C     myThid     :: Thread number for this instance of the routine.
      LOGICAL permPickup
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

C     == Common blocks ==
      COMMON /PCKP_GBLFLS/ globalFile
      LOGICAL globalFile

C     !LOCAL VARIABLES:
C     == Local variables ==
C     prec   :: file 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

      prec = precFloat64
      lgf = globalFile

C     Create suffix to pass on to package pickup routines
      IF ( permPickup ) THEN
        WRITE(fn,'(I10.10)') myIter
      ELSE
        WRITE(fn,'(A)') checkPtSuff(nCheckLev)
      ENDIF

#ifdef ALLOW_GENERIC_ADVDIFF
C     Write restart file for 2nd-Order moment (active) Tracers
      IF ( useGAD ) THEN
        CALL GAD_WRITE_PICKUP(
     I                 fn, myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_GENERIC_ADVDIFF */

#ifdef ALLOW_CD_CODE
      IF (useCDscheme) THEN
        CALL CD_CODE_WRITE_PICKUP(
     &       prec, lgf, permPickup, 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, permPickup, myIter, myThid)
      ENDIF
#endif  /* ALLOW_OBCS */

#ifdef  ALLOW_SEAICE
      IF ( useSEAICE ) THEN
        CALL SEAICE_WRITE_PICKUP(
     &       prec, lgf, permPickup, myIter, myThid)
      ENDIF
#endif  /* ALLOW_SEAICE */

#ifdef ALLOW_THSICE
      IF (useThSIce) THEN
        CALL THSICE_WRITE_PICKUP(
     &       prec, lgf, permPickup, myIter, myThid)
      ENDIF
#endif /* ALLOW_THSICE */

#ifdef  COMPONENT_MODULE
      IF (useCoupler) THEN
        CALL CPL_WRITE_PICKUP(
     &       prec, lgf, permPickup, 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(permPickup,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(permPickup,
     &       fn,myTime,myIter,myThid)
      ENDIF
#endif

#ifdef  ALLOW_GGL90
      IF ( useGGL90 ) THEN
        CALL GGL90_WRITE_CHECKPOINT(
     &       prec, lgf, permPickup, myIter, myThid)
      ENDIF
#endif  /* ALLOW_GGL90 */

#ifdef ALLOW_PTRACERS
C     Write restart file for passive tracers
      IF (usePTRACERS) THEN
        CALL PTRACERS_WRITE_PICKUP(permPickup,
     &       fn,myIter,myTime,myThid)
      ENDIF
#endif /* ALLOW_PTRACERS */

C--   Every one else must wait until writing is done.
      _BARRIER

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	jmc	1.25	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.24 2006/10/25 20:42:34 jmc 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.23	C files.
9
10	jmc	1.1	CBOP
11			C !ROUTINE: PACKAGES_WRITE_PICKUP
12	edhill	1.6
13	jmc	1.1	C !INTERFACE:
14	jmc	1.22	SUBROUTINE PACKAGES_WRITE_PICKUP(
15	jmc	1.23	I permPickup,
16			I myTime, myIter, myThid )
17	edhill	1.6
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	jmc	1.23	C "rolling-pickup" files (ckptA,ckptB) and permanent pickup.
23	jmc	1.1
24			C !USES:
25			IMPLICIT NONE
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "PARAMS.h"
29
30			C !INPUT/OUTPUT PARAMETERS:
31	jmc	1.23	C permPickup :: Is or is not a permanent pickup.
32			C myTime :: Current time of simulation ( s )
33			C myIter :: Iteration number
34			C myThid :: Thread number for this instance of the routine.
35			LOGICAL permPickup
36	jmc	1.22	_RL myTime
37			INTEGER myIter
38	edhill	1.6	INTEGER myThid
39	jmc	1.1
40	edhill	1.6	C == Common blocks ==
41			COMMON /PCKP_GBLFLS/ globalFile
42			LOGICAL globalFile
43	jmc	1.1
44	edhill	1.6	C !LOCAL VARIABLES:
45			C == Local variables ==
46	jmc	1.23	C prec :: file precision
47	edhill	1.6	C fn :: Temp. for building file name string.
48			C lgf :: Flag to indicate whether to use global file mode.
49			CHARACTER*(MAX_LEN_FNAM) fn
50			INTEGER prec
51			LOGICAL lgf
52			CEOP
53	jmc	1.1
54	edhill	1.6	C Going to really do some IO. Make everyone except master thread wait.
55			_BARRIER
56
57			prec = precFloat64
58			lgf = globalFile
59	jmc	1.22
60	edhill	1.6	C Create suffix to pass on to package pickup routines
61	jmc	1.23	IF ( permPickup ) THEN
62	edhill	1.6	WRITE(fn,'(I10.10)') myIter
63			ELSE
64			WRITE(fn,'(A)') checkPtSuff(nCheckLev)
65			ENDIF
66	jmc	1.1
67	jmc	1.25	#ifdef ALLOW_GENERIC_ADVDIFF
68			C Write restart file for 2nd-Order moment (active) Tracers
69			IF ( useGAD ) THEN
70			CALL GAD_WRITE_PICKUP(
71			I fn, myTime, myIter, myThid )
72			ENDIF
73			#endif /* ALLOW_GENERIC_ADVDIFF */
74
75	jmc	1.1	#ifdef ALLOW_CD_CODE
76	edhill	1.6	IF (useCDscheme) THEN
77	jmc	1.24	CALL CD_CODE_WRITE_PICKUP(
78	jmc	1.23	& prec, lgf, permPickup, myIter, myThid)
79	edhill	1.6	ENDIF
80	jmc	1.1	#endif /* ALLOW_CD_CODE */
81
82			#ifdef ALLOW_OBCS
83	edhill	1.6	C SPK 4/9/01: Open boundary checkpointing
84			IF (useOBCS) THEN
85			CALL OBCS_WRITE_CHECKPOINT(
86	jmc	1.23	& prec, lgf, permPickup, myIter, myThid)
87	edhill	1.6	ENDIF
88	jmc	1.1	#endif /* ALLOW_OBCS */
89	jmc	1.22
90	jmc	1.3	#ifdef ALLOW_SEAICE
91	edhill	1.6	IF ( useSEAICE ) THEN
92			CALL SEAICE_WRITE_PICKUP(
93	jmc	1.23	& prec, lgf, permPickup, myIter, myThid)
94	edhill	1.6	ENDIF
95	jmc	1.3	#endif /* ALLOW_SEAICE */
96	jmc	1.1
97			#ifdef ALLOW_THSICE
98	edhill	1.6	IF (useThSIce) THEN
99			CALL THSICE_WRITE_PICKUP(
100	jmc	1.23	& prec, lgf, permPickup, myIter, myThid)
101	edhill	1.6	ENDIF
102	jmc	1.1	#endif /* ALLOW_THSICE */
103	jmc	1.2
104			#ifdef COMPONENT_MODULE
105	edhill	1.6	IF (useCoupler) THEN
106			CALL CPL_WRITE_PICKUP(
107	jmc	1.23	& prec, lgf, permPickup, myIter, myThid)
108	edhill	1.6	ENDIF
109	jmc	1.2	#endif /* COMPONENT_MODULE */
110	jmc	1.1
111			#ifdef ALLOW_FLT
112	edhill	1.6	C Write restart file for floats
113			IF (useFLT) THEN
114			CALL FLT_RESTART(myTime, myIter, myThid)
115			ENDIF
116	jmc	1.1	#endif
117
118			#ifdef ALLOW_LAND
119	edhill	1.17	C Write pickup file for Land package:
120	edhill	1.6	IF (useLand) THEN
121	jmc	1.23	CALL LAND_WRITE_PICKUP(permPickup,fn,
122	edhill	1.17	& myTime,myIter,myThid)
123	edhill	1.6	ENDIF
124	jmc	1.1	#endif
125	molod	1.4
126			#ifdef ALLOW_FIZHI
127	edhill	1.6	C Write pickup file for fizhi package
128			IF (usefizhi) THEN
129			CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
130	molod	1.8	CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
131	molod	1.10	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
132	edhill	1.6	ENDIF
133	molod	1.4	#endif
134
135	edhill	1.11	#ifdef ALLOW_DIAGNOSTICS
136			C Write pickup file for diagnostics package
137			IF (useDiagnostics) THEN
138	jmc	1.23	CALL DIAGNOSTICS_WRITE_PICKUP(permPickup,
139	edhill	1.18	& fn,myTime,myIter,myThid)
140	edhill	1.11	ENDIF
141			#endif
142
143	mlosch	1.9	#ifdef ALLOW_GGL90
144			IF ( useGGL90 ) THEN
145			CALL GGL90_WRITE_CHECKPOINT(
146	jmc	1.23	& prec, lgf, permPickup, myIter, myThid)
147	mlosch	1.9	ENDIF
148			#endif /* ALLOW_GGL90 */
149
150	jmc	1.1	#ifdef ALLOW_PTRACERS
151	edhill	1.15	C Write restart file for passive tracers
152			IF (usePTRACERS) THEN
153	jmc	1.24	CALL PTRACERS_WRITE_PICKUP(permPickup,
154	edhill	1.16	& fn,myIter,myTime,myThid)
155	edhill	1.15	ENDIF
156	jmc	1.1	#endif /* ALLOW_PTRACERS */
157
158	jmc	1.23	C-- Every one else must wait until writing is done.
159	jmc	1.22	_BARRIER
160
161	jmc	1.1	RETURN
162			END
163	edhill	1.6
164			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|