model/src/packages_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.35 2009/01/04 01:00:19 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"
#include "RESTART.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     !LOCAL VARIABLES:
C     == Local variables ==
C     prec   :: file precision
C     suffix :: pickup-name suffix
C     lgf    :: Flag to indicate whether to use global file mode.
      CHARACTER*(10) suffix
      INTEGER prec
      LOGICAL lgf
CEOP

C     Going to really do some IO. Make everyone except master thread wait.
C     this is done within IO routines => no longer needed
c     _BARRIER

      prec = precFloat64
      lgf = globalFiles

C     Create suffix to pass on to package pickup routines
      IF ( permPickup ) THEN
        WRITE(suffix,'(I10.10)') myIter
      ELSE
        WRITE(suffix,'(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                 suffix, myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_GENERIC_ADVDIFF */

#ifdef ALLOW_CD_CODE
      IF (useCDscheme) THEN
        CALL CD_CODE_WRITE_PICKUP( permPickup,
     I                     suffix, myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_CD_CODE */

#ifdef  ALLOW_OBCS
C     SPK 4/9/01: Open boundary checkpointing
c      IF (useOBCS) THEN
c        CALL OBCS_WRITE_CHECKPOINT(
c     &       prec, lgf, permPickup, myIter, myThid)
c      ENDIF
#endif  /* ALLOW_OBCS */

#ifdef  ALLOW_SEAICE
      IF ( useSEAICE ) THEN
        CALL SEAICE_WRITE_PICKUP( permPickup,
     I                    suffix, myTime, myIter, myThid )
      ENDIF
#endif  /* ALLOW_SEAICE */

#ifdef ALLOW_THSICE
      IF (useThSIce) THEN
        CALL THSICE_WRITE_PICKUP( permPickup,
     I                    suffix, myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_THSICE */

#ifdef  COMPONENT_MODULE
      IF (useCoupler) THEN
        CALL CPL_WRITE_PICKUP(
     &                 suffix, myTime, myIter, myThid )
      ENDIF
#endif  /* COMPONENT_MODULE */

#ifdef ALLOW_FLT
C     Write restart file for floats
      IF (useFLT) THEN
        CALL FLT_WRITE_PICKUP(
     &                  suffix, myTime, myIter, myThid )
      ENDIF
#endif

#ifdef ALLOW_LAND
C     Write pickup file for Land package:
      IF (useLand) THEN
        CALL LAND_WRITE_PICKUP( permPickup,
     &                  suffix, myTime, myIter, myThid )
      ENDIF
#endif

#ifdef ALLOW_FIZHI
C     Write pickup file for fizhi package
      IF (usefizhi) THEN
        CALL FIZHI_WRITE_PICKUP(suffix,myTime,myIter,myThid)
        CALL FIZHI_WRITE_VEGTILES(suffix,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,
     I                         suffix, myTime, myIter, myThid )
      ENDIF
#endif

#ifdef  ALLOW_GGL90
      IF ( useGGL90 ) THEN
        CALL GGL90_WRITE_PICKUP( permPickup,
     I                      suffix, myTime, myIter, myThid )
      ENDIF
#endif  /* ALLOW_GGL90 */

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

#ifdef ALLOW_GCHEM
C     Write restart file for GCHEM pkg & GCHEM sub-packages
      IF ( useGCHEM ) THEN
        CALL GCHEM_WRITE_PICKUP( permPickup,
     I                      suffix, myTime, myIter, myThid )
      ENDIF
#endif

#ifdef ALLOW_CHEAPAML
C     Write restart file for CHEAPAML pkg
      IF ( useCheapAML ) THEN
         CALL CHEAPAML_WRITE_PICKUP( permPickup,
     I                      suffix, myTime, myIter, myThid)
       ENDIF
#endif /* ALLOW_CHEAPAML */

#ifdef ALLOW_MYPACKAGE
      IF (useMYPACKAGE) THEN
        CALL MYPACKAGE_WRITE_PICKUP( permPickup,
     I                      suffix, myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_MYPACKAGE */

C--   Every one else must wait until writing is done.
C     this is done within IO routines => no longer needed
c     _BARRIER

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	jmc	1.36	C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.35 2009/01/04 01:00:19 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	jmc	1.27	#include "RESTART.h"
30	jmc	1.1
31			C !INPUT/OUTPUT PARAMETERS:
32	jmc	1.23	C permPickup :: Is or is not a permanent pickup.
33			C myTime :: Current time of simulation ( s )
34			C myIter :: Iteration number
35			C myThid :: Thread number for this instance of the routine.
36			LOGICAL permPickup
37	jmc	1.22	_RL myTime
38			INTEGER myIter
39	edhill	1.6	INTEGER myThid
40	jmc	1.1
41	edhill	1.6	C !LOCAL VARIABLES:
42			C == Local variables ==
43	jmc	1.23	C prec :: file precision
44	jmc	1.26	C suffix :: pickup-name suffix
45	edhill	1.6	C lgf :: Flag to indicate whether to use global file mode.
46	jmc	1.26	CHARACTER*(10) suffix
47	edhill	1.6	INTEGER prec
48			LOGICAL lgf
49			CEOP
50	jmc	1.1
51	edhill	1.6	C Going to really do some IO. Make everyone except master thread wait.
52	jmc	1.36	C this is done within IO routines => no longer needed
53			c _BARRIER
54	edhill	1.6
55			prec = precFloat64
56	jmc	1.26	lgf = globalFiles
57	jmc	1.22
58	edhill	1.6	C Create suffix to pass on to package pickup routines
59	jmc	1.23	IF ( permPickup ) THEN
60	jmc	1.26	WRITE(suffix,'(I10.10)') myIter
61	edhill	1.6	ELSE
62	jmc	1.26	WRITE(suffix,'(A)') checkPtSuff(nCheckLev)
63	edhill	1.6	ENDIF
64	jmc	1.1
65	jmc	1.25	#ifdef ALLOW_GENERIC_ADVDIFF
66			C Write restart file for 2nd-Order moment (active) Tracers
67			IF ( useGAD ) THEN
68			CALL GAD_WRITE_PICKUP(
69	jmc	1.26	I suffix, myTime, myIter, myThid )
70	jmc	1.25	ENDIF
71			#endif /* ALLOW_GENERIC_ADVDIFF */
72
73	jmc	1.1	#ifdef ALLOW_CD_CODE
74	edhill	1.6	IF (useCDscheme) THEN
75	jmc	1.26	CALL CD_CODE_WRITE_PICKUP( permPickup,
76			I suffix, myTime, myIter, myThid )
77	edhill	1.6	ENDIF
78	jmc	1.1	#endif /* ALLOW_CD_CODE */
79
80			#ifdef ALLOW_OBCS
81	edhill	1.6	C SPK 4/9/01: Open boundary checkpointing
82	dimitri	1.28	c IF (useOBCS) THEN
83			c CALL OBCS_WRITE_CHECKPOINT(
84			c & prec, lgf, permPickup, myIter, myThid)
85			c ENDIF
86	jmc	1.1	#endif /* ALLOW_OBCS */
87	jmc	1.22
88	jmc	1.3	#ifdef ALLOW_SEAICE
89	edhill	1.6	IF ( useSEAICE ) THEN
90	jmc	1.26	CALL SEAICE_WRITE_PICKUP( permPickup,
91			I suffix, myTime, myIter, myThid )
92	edhill	1.6	ENDIF
93	jmc	1.3	#endif /* ALLOW_SEAICE */
94	jmc	1.1
95			#ifdef ALLOW_THSICE
96	edhill	1.6	IF (useThSIce) THEN
97	jmc	1.26	CALL THSICE_WRITE_PICKUP( permPickup,
98			I suffix, myTime, myIter, myThid )
99	edhill	1.6	ENDIF
100	jmc	1.1	#endif /* ALLOW_THSICE */
101	jmc	1.2
102			#ifdef COMPONENT_MODULE
103	edhill	1.6	IF (useCoupler) THEN
104			CALL CPL_WRITE_PICKUP(
105	jmc	1.26	& suffix, myTime, myIter, myThid )
106	edhill	1.6	ENDIF
107	jmc	1.2	#endif /* COMPONENT_MODULE */
108	jmc	1.1
109			#ifdef ALLOW_FLT
110	edhill	1.6	C Write restart file for floats
111			IF (useFLT) THEN
112	jmc	1.35	CALL FLT_WRITE_PICKUP(
113			& suffix, myTime, myIter, myThid )
114	edhill	1.6	ENDIF
115	jmc	1.1	#endif
116
117			#ifdef ALLOW_LAND
118	edhill	1.17	C Write pickup file for Land package:
119	edhill	1.6	IF (useLand) THEN
120	jmc	1.26	CALL LAND_WRITE_PICKUP( permPickup,
121			& suffix, myTime, myIter, myThid )
122	edhill	1.6	ENDIF
123	jmc	1.1	#endif
124	molod	1.4
125			#ifdef ALLOW_FIZHI
126	edhill	1.6	C Write pickup file for fizhi package
127			IF (usefizhi) THEN
128	jmc	1.26	CALL FIZHI_WRITE_PICKUP(suffix,myTime,myIter,myThid)
129			CALL FIZHI_WRITE_VEGTILES(suffix,0,myTime,myIter,myThid)
130	molod	1.10	CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
131	edhill	1.6	ENDIF
132	molod	1.4	#endif
133
134	edhill	1.11	#ifdef ALLOW_DIAGNOSTICS
135			C Write pickup file for diagnostics package
136			IF (useDiagnostics) THEN
137	jmc	1.26	CALL DIAGNOSTICS_WRITE_PICKUP( permPickup,
138			I suffix, myTime, myIter, myThid )
139	edhill	1.11	ENDIF
140			#endif
141
142	mlosch	1.9	#ifdef ALLOW_GGL90
143			IF ( useGGL90 ) THEN
144	jmc	1.26	CALL GGL90_WRITE_PICKUP( permPickup,
145	jmc	1.31	I suffix, myTime, myIter, myThid )
146	mlosch	1.9	ENDIF
147			#endif /* ALLOW_GGL90 */
148
149	jmc	1.1	#ifdef ALLOW_PTRACERS
150	edhill	1.15	C Write restart file for passive tracers
151			IF (usePTRACERS) THEN
152	jmc	1.26	CALL PTRACERS_WRITE_PICKUP( permPickup,
153	jmc	1.31	I suffix, myTime, myIter, myThid )
154	edhill	1.15	ENDIF
155	jmc	1.1	#endif /* ALLOW_PTRACERS */
156
157	jmc	1.32	#ifdef ALLOW_GCHEM
158			C Write restart file for GCHEM pkg & GCHEM sub-packages
159			IF ( useGCHEM ) THEN
160	jmc	1.33	CALL GCHEM_WRITE_PICKUP( permPickup,
161	jmc	1.32	I suffix, myTime, myIter, myThid )
162			ENDIF
163	dfer	1.30	#endif
164
165	jmc	1.34	#ifdef ALLOW_CHEAPAML
166			C Write restart file for CHEAPAML pkg
167			IF ( useCheapAML ) THEN
168			CALL CHEAPAML_WRITE_PICKUP( permPickup,
169			I suffix, myTime, myIter, myThid)
170			ENDIF
171			#endif /* ALLOW_CHEAPAML */
172
173	jmc	1.29	#ifdef ALLOW_MYPACKAGE
174			IF (useMYPACKAGE) THEN
175			CALL MYPACKAGE_WRITE_PICKUP( permPickup,
176	jmc	1.31	I suffix, myTime, myIter, myThid )
177	jmc	1.29	ENDIF
178			#endif /* ALLOW_MYPACKAGE */
179
180	jmc	1.23	C-- Every one else must wait until writing is done.
181	jmc	1.36	C this is done within IO routines => no longer needed
182			c _BARRIER
183	jmc	1.22
184	jmc	1.1	RETURN
185			END
186	edhill	1.6
187			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|