/[MITgcm]/MITgcm/model/src/packages_write_pickup.F
ViewVC logotype

Diff of /MITgcm/model/src/packages_write_pickup.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jmc, Sun Dec 14 23:18:49 2003 UTC revision 1.20 by cnh, Tue Nov 8 23:01:10 2005 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "PACKAGES_CONFIG.h"  #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8  CBOP  CBOP
9  C     !ROUTINE: PACKAGES_WRITE_PICKUP  C     !ROUTINE: PACKAGES_WRITE_PICKUP
10    
11  C     !INTERFACE:  C     !INTERFACE:
12        SUBROUTINE PACKAGES_WRITE_PICKUP(        SUBROUTINE PACKAGES_WRITE_PICKUP(
13       I                    modelEnd, myTime, myIter, myThid )       I     modelEnd,
14  C     !DESCRIPTION: \bv       I     myTime,
15  C     *==========================================================*       I     myIter,
16  C     | SUBROUTINE PACKAGES_WRITE_PICKUP                                     I     myThid )
17  C     | o write pickup files for each package which needs it  
18  C     |   to restart.  C     !DESCRIPTION:
19  C     *==========================================================*  C     Write pickup files for each package which needs it to restart.
20  C     | This routine (S/R PACKAGES_WRITE_PICKUP) calls  C     This routine (S/R PACKAGES_WRITE_PICKUP) calls per-package
21  C     | per-package write-pickup (or checkpoint) routines.  C     write-pickup (or checkpoint) routines.  It writes both
22  C     | o writes both "rolling-checkpoint" files (ckptA,ckptB)        C     "rolling-checkpoint" files (ckptA,ckptB) and permanent checkpoint
23  C     |   and permanent checkpoint files.  C     files.
 C     *==========================================================*  
 C     \ev  
24    
25  C     !USES:  C     !USES:
26        IMPLICIT NONE        IMPLICIT NONE
 C     == Global variables ===  
27  #include "SIZE.h"  #include "SIZE.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29  #include "PARAMS.h"  #include "PARAMS.h"
# Line 45  C     myTime :: Current time of simulati Line 44  C     myTime :: Current time of simulati
44        INTEGER myIter        INTEGER myIter
45        _RL     myTime        _RL     myTime
46    
 C     == Common blocks ==  
       COMMON /PCKP_GBLFLS/ globalFile  
       LOGICAL globalFile  
   
47  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
48  C     == Local variables ==  C     == Local variables ==
49  C     permCheckPoint :: Flag indicating whether a permanent checkpoint will  C     permCheckPoint :: Flag indicating whether a permanent checkpoint will
# Line 59  C     oldPrc :: Temp. for holding I/O pr Line 54  C     oldPrc :: Temp. for holding I/O pr
54  C     fn     :: Temp. for building file name string.  C     fn     :: Temp. for building file name string.
55  C     lgf    :: Flag to indicate whether to use global file mode.  C     lgf    :: Flag to indicate whether to use global file mode.
56        LOGICAL permCheckPoint, tempCheckPoint          LOGICAL permCheckPoint, tempCheckPoint  
57        CHARACTER*(MAX_LEN_FNAM) fn  #ifdef ALLOW_CAL
58        CHARACTER*(MAX_LEN_MBUF) msgBuf        INTEGER thisdate(4), prevdate(4)
59        INTEGER prec  #endif
       LOGICAL lgf  
60  CEOP  CEOP
61    
62        permCheckPoint = .FALSE.        permCheckPoint = .FALSE.
63        tempCheckPoint = .FALSE.        tempCheckPoint = .FALSE.
64        permCheckPoint=        permCheckPoint=
65       &  DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)       &     DIFFERENT_MULTIPLE(pChkptFreq,myTime,deltaTClock)
66        tempCheckPoint=        tempCheckPoint=
67       &  DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)       &     DIFFERENT_MULTIPLE( ChkptFreq,myTime,deltaTClock)
68    
69  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  #ifdef ALLOW_CAL
70        IF (        IF ( calendarDumps ) THEN
71       &    ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )  C--   Convert approximate months (30-31 days) and years (360-372 days)
72       &   .OR.  C     to exact calendar months and years.
73       &    ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )  C-    First determine calendar dates for this and previous time step.
74       &   ) THEN           call cal_GetDate( myiter  ,mytime            ,thisdate,mythid )
75             call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )
76  C--    Going to really do some IO. Make everyone except master thread wait.  C-    Monthly pChkptFreq:
77         _BARRIER           IF( pChkptFreq.GE. 2592000 .AND. pChkptFreq.LE. 2678400 ) THEN
78         _BEGIN_MASTER( myThid )              permCheckPoint = .FALSE.
79                IF((thisdate(1)-prevdate(1)) .GT. 50  )permCheckPoint=.TRUE.
80          prec = precFloat64           ENDIF
81          lgf = globalFile  C-    Yearly  pChkptFreq:
82             IF( pChkptFreq.GE.31104000 .AND. pChkptFreq.LE.31968000 ) THEN
83  C Create suffix to pass on to package pickup routines              permCheckPoint = .FALSE.
84           IF ( permCheckPoint ) THEN              IF((thisdate(1)-prevdate(1)) .GT. 5000)permCheckPoint=.TRUE.
85            WRITE(fn,'(I10.10)') myIter           ENDIF
86           ELSE  C-    Monthly  ChkptFreq:
87            WRITE(fn,'(A)') checkPtSuff(nCheckLev)           IF(  ChkptFreq.GE. 2592000 .AND.  ChkptFreq.LE. 2678400 ) THEN
88                tempCheckPoint = .FALSE.
89                IF((thisdate(1)-prevdate(1)) .GT. 50  )tempCheckPoint=.TRUE.
90           ENDIF           ENDIF
91    C-    Yearly   ChkptFreq:
92             IF(  ChkptFreq.GE.31104000 .AND.  ChkptFreq.LE.31968000 ) THEN
93                tempCheckPoint = .FALSE.
94                IF((thisdate(1)-prevdate(1)) .GT. 5000)tempCheckPoint=.TRUE.
95             ENDIF
96          ENDIF
97    #endif
98    
99          IF (
100         &     ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
101         &     .OR.
102         &     ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
103         &     ) THEN
104    
105            CALL PACKAGES_WRITE_PICKUP_NOW(
106         &       permCheckPoint, myTime, myIter, myThid )
107    
108          ENDIF
109    
110          RETURN
111          END
112    
113    
114    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115    CBOP
116    C     !ROUTINE: PACKAGES_WRITE_PICKUP_NOW
117    
118    C     !INTERFACE:
119          SUBROUTINE PACKAGES_WRITE_PICKUP_NOW(
120         I     permCheckPoint,
121         I     myTime,
122         I     myIter,
123         I     myThid )
124    
125    C     !DESCRIPTION:
126    C     Write pickup files for each package which needs it to restart and
127    C     do it NOW.
128    
129    C     !USES:
130          IMPLICIT NONE
131    #include "SIZE.h"
132    #include "EEPARAMS.h"
133    #include "PARAMS.h"
134    
135    
136    C     !INPUT/OUTPUT PARAMETERS:
137    C     permCheckPoint  :: Checkpoint is permanent
138    C     myThid :: Thread number for this instance of the routine.
139    C     myIter :: Iteration number
140    C     myTime :: Current time of simulation ( s )
141          LOGICAL permCheckPoint
142          INTEGER myThid
143          INTEGER myIter
144          _RL     myTime
145    
146    C     == Common blocks ==
147          COMMON /PCKP_GBLFLS/ globalFile
148          LOGICAL globalFile
149    
150    C     !LOCAL VARIABLES:
151    C     == Local variables ==
152    C     oldPrc :: Temp. for holding I/O precision
153    C     fn     :: Temp. for building file name string.
154    C     lgf    :: Flag to indicate whether to use global file mode.
155          CHARACTER*(MAX_LEN_FNAM) fn
156          INTEGER prec
157          LOGICAL lgf
158    CEOP
159    
160    C     Going to really do some IO. Make everyone except master thread wait.
161          _BARRIER
162    C     _BEGIN_MASTER( myThid )
163    
164          prec = precFloat64
165          lgf = globalFile
166          
167    C     Create suffix to pass on to package pickup routines
168          IF ( permCheckPoint ) THEN
169            WRITE(fn,'(I10.10)') myIter
170          ELSE
171            WRITE(fn,'(A)') checkPtSuff(nCheckLev)
172          ENDIF
173    
174  #ifdef ALLOW_CD_CODE  #ifdef ALLOW_CD_CODE
175          IF (useCDscheme) THEN        IF (useCDscheme) THEN
176            CALL CD_CODE_WRITE_CHECKPOINT(          CALL CD_CODE_WRITE_CHECKPOINT(
177       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
178          ENDIF        ENDIF
179  #endif /* ALLOW_CD_CODE */  #endif /* ALLOW_CD_CODE */
180    
181  #ifdef  ALLOW_OBCS  #ifdef  ALLOW_OBCS
182  C SPK 4/9/01: Open boundary checkpointing  C     SPK 4/9/01: Open boundary checkpointing
183          IF (useOBCS) THEN        IF (useOBCS) THEN
184            CALL OBCS_WRITE_CHECKPOINT(          CALL OBCS_WRITE_CHECKPOINT(
185       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
186          ENDIF        ENDIF
187  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
188          
189    #ifdef  ALLOW_SEAICE
190          IF ( useSEAICE ) THEN
191            CALL SEAICE_WRITE_PICKUP(
192         &       prec, lgf, permCheckPoint, myIter, myThid)
193          ENDIF
194    #endif  /* ALLOW_SEAICE */
195    
196  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
197          IF (useThSIce) THEN        IF (useThSIce) THEN
198            CALL THSICE_WRITE_CHECKPOINT(          CALL THSICE_WRITE_PICKUP(
199       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
200          ENDIF        ENDIF
201  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
202    
203    #ifdef  COMPONENT_MODULE
204          IF (useCoupler) THEN
205            CALL CPL_WRITE_PICKUP(
206         &       prec, lgf, permCheckPoint, myIter, myThid)
207          ENDIF
208    #endif  /* COMPONENT_MODULE */
209    
210  #ifdef ALLOW_FLT  #ifdef ALLOW_FLT
211  C--     Write restart file for floats  C     Write restart file for floats
212          IF (useFLT) THEN        IF (useFLT) THEN
213            CALL FLT_RESTART(myTime, myIter, myThid)          CALL FLT_RESTART(myTime, myIter, myThid)
214          ENDIF        ENDIF
215  #endif  #endif
216    
217  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
218  C--     Write pickup file for Lnad package:  C     Write pickup file for Land package:
219          IF (useLand) THEN        IF (useLand) THEN
220            CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL LAND_WRITE_PICKUP(permCheckPoint,fn,
221          ENDIF       &       myTime,myIter,myThid)
222          ENDIF
223    #endif
224    
225    #ifdef ALLOW_FIZHI
226    C     Write pickup file for fizhi package
227          IF (usefizhi) THEN
228            CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
229            CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
230            CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
231          ENDIF
232    #endif
233    
234    #ifdef ALLOW_DIAGNOSTICS
235    C     Write pickup file for diagnostics package
236          IF (useDiagnostics) THEN
237            CALL DIAGNOSTICS_WRITE_PICKUP(permCheckPoint,
238         &       fn,myTime,myIter,myThid)
239          ENDIF
240  #endif  #endif
241    
242         _END_MASTER( myThid )  #ifdef  ALLOW_GGL90
243         _BARRIER        IF ( useGGL90 ) THEN
244            CALL GGL90_WRITE_CHECKPOINT(
245         &       prec, lgf, permCheckPoint, myIter, myThid)
246          ENDIF
247    #endif  /* ALLOW_GGL90 */
248    
249    C     _END_MASTER( myThid )
250          _BARRIER
251    
252  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
253  C Write restart file for passive tracers  C     Write restart file for passive tracers
254         IF (usePTRACERS) THEN        IF (usePTRACERS) THEN
255           CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)          CALL PTRACERS_WRITE_CHECKPOINT(permCheckPoint,
256         ENDIF       &       fn,myIter,myTime,myThid)
257          ENDIF
258  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
259    
260    #ifdef ALLOW_OFFLINE
261    C     This is quick fix for A/B checkpoints since the main model
262    C     checkpoint routine will not be called in OFFLINE mode and will
263    C     thus not have the chance to set the alternating A/B suffix
264          IF ( .NOT. permCheckPoint ) THEN
265            nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
266        ENDIF        ENDIF
267    #endif /* ALLOW_OFFLINE */
268    
269        RETURN        RETURN
270        END        END
271    
272    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22