/[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.11 by edhill, Sun Feb 20 04:31:54 2005 UTC revision 1.38 by jmc, Thu Oct 1 21:28:09 2009 UTC
# Line 5  C $Name$ Line 5  C $Name$
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8    C     files.
9    
10  CBOP  CBOP
11  C     !ROUTINE: PACKAGES_WRITE_PICKUP  C     !ROUTINE: PACKAGES_WRITE_PICKUP
12    
13  C     !INTERFACE:  C     !INTERFACE:
14        SUBROUTINE PACKAGES_WRITE_PICKUP(        SUBROUTINE PACKAGES_WRITE_PICKUP(
15       I     modelEnd,       I                    permPickup,
16       I     myTime,       I                    myTime, myIter, myThid )
      I     myIter,  
      I     myThid )  
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
19  C     Write pickup files for each package which needs it to restart.  C     Write pickup files for each package which needs it to restart.
20  C     This routine (S/R PACKAGES_WRITE_PICKUP) calls per-package  C     This routine (S/R PACKAGES_WRITE_PICKUP) calls per-package
21  C     write-pickup (or checkpoint) routines.  It writes both  C     write-pickup (or checkpoint) routines.  It writes both
22  C     "rolling-checkpoint" files (ckptA,ckptB) and permanent checkpoint  C     "rolling-pickup" files (ckptA,ckptB) and permanent pickup.
 C     files.  
23    
24  C     !USES:  C     !USES:
25        IMPLICIT NONE        IMPLICIT NONE
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29    #include "RESTART.h"
       LOGICAL  DIFFERENT_MULTIPLE  
       EXTERNAL DIFFERENT_MULTIPLE  
       INTEGER  IO_ERRCOUNT  
       EXTERNAL IO_ERRCOUNT  
30    
31  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
32  C     == Routine arguments ==  C     permPickup :: Is or is not a permanent pickup.
33  C     modelEnd    :: Checkpoint call at end of model run.  C     myTime     :: Current time of simulation ( s )
34  C     myThid :: Thread number for this instance of the routine.  C     myIter     :: Iteration number
35  C     myIter :: Iteration number  C     myThid     :: Thread number for this instance of the routine.
36  C     myTime :: Current time of simulation ( s )        LOGICAL permPickup
       LOGICAL modelEnd      
       INTEGER myThid  
       INTEGER myIter  
37        _RL     myTime        _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  
38        INTEGER myIter        INTEGER myIter
39        _RL     myTime        INTEGER myThid
   
 C     == Common blocks ==  
       COMMON /PCKP_GBLFLS/ globalFile  
       LOGICAL globalFile  
40    
41  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
42  C     == Local variables ==  C     == Local variables ==
43  C     oldPrc :: Temp. for holding I/O precision  C     suffix :: pickup-name suffix
44  C     fn     :: Temp. for building file name string.        CHARACTER*(10) suffix
 C     lgf    :: Flag to indicate whether to use global file mode.  
       CHARACTER*(MAX_LEN_FNAM) fn  
       INTEGER prec  
       LOGICAL lgf  
45  CEOP  CEOP
46    
47  C     Going to really do some IO. Make everyone except master thread wait.  C     Going to really do some IO. Make everyone except master thread wait.
48        _BARRIER  C     this is done within IO routines => no longer needed
49        _BEGIN_MASTER( myThid )  c     _BARRIER
50    
       prec = precFloat64  
       lgf = globalFile  
         
51  C     Create suffix to pass on to package pickup routines  C     Create suffix to pass on to package pickup routines
52        IF ( permCheckPoint ) THEN        IF ( permPickup ) THEN
53          WRITE(fn,'(I10.10)') myIter          WRITE(suffix,'(I10.10)') myIter
54        ELSE        ELSE
55          WRITE(fn,'(A)') checkPtSuff(nCheckLev)          WRITE(suffix,'(A)') checkPtSuff(nCheckLev)
56        ENDIF        ENDIF
57    
58    #ifdef ALLOW_GENERIC_ADVDIFF
59    C     Write restart file for 2nd-Order moment (active) Tracers
60          IF ( useGAD ) THEN
61            CALL GAD_WRITE_PICKUP(
62         I                 suffix, myTime, myIter, myThid )
63          ENDIF
64    #endif /* ALLOW_GENERIC_ADVDIFF */
65    
66  #ifdef ALLOW_CD_CODE  #ifdef ALLOW_CD_CODE
67        IF (useCDscheme) THEN        IF (useCDscheme) THEN
68          CALL CD_CODE_WRITE_CHECKPOINT(          CALL CD_CODE_WRITE_PICKUP( permPickup,
69       &       prec, lgf, permCheckPoint, myIter, myThid)       I                     suffix, myTime, myIter, myThid )
70        ENDIF        ENDIF
71  #endif /* ALLOW_CD_CODE */  #endif /* ALLOW_CD_CODE */
72    
73  #ifdef  ALLOW_OBCS  #ifdef  ALLOW_OBCS
 C     SPK 4/9/01: Open boundary checkpointing  
74        IF (useOBCS) THEN        IF (useOBCS) THEN
75          CALL OBCS_WRITE_CHECKPOINT(          CALL OBCS_WRITE_PICKUP(
76       &       prec, lgf, permCheckPoint, myIter, myThid)       &                  suffix, myTime, myIter, myThid )
77        ENDIF        ENDIF
78  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
79          
80  #ifdef  ALLOW_SEAICE  #ifdef  ALLOW_SEAICE
81        IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
82          CALL SEAICE_WRITE_PICKUP(          CALL SEAICE_WRITE_PICKUP( permPickup,
83       &       prec, lgf, permCheckPoint, myIter, myThid)       I                    suffix, myTime, myIter, myThid )
84        ENDIF        ENDIF
85  #endif  /* ALLOW_SEAICE */  #endif  /* ALLOW_SEAICE */
86    
87  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
88        IF (useThSIce) THEN        IF (useThSIce) THEN
89          CALL THSICE_WRITE_PICKUP(          CALL THSICE_WRITE_PICKUP( permPickup,
90       &       prec, lgf, permCheckPoint, myIter, myThid)       I                    suffix, myTime, myIter, myThid )
91        ENDIF        ENDIF
92  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
93    
94  #ifdef  COMPONENT_MODULE  #ifdef  COMPONENT_MODULE
95        IF (useCoupler) THEN        IF (useCoupler) THEN
96          CALL CPL_WRITE_PICKUP(          CALL CPL_WRITE_PICKUP(
97       &       prec, lgf, permCheckPoint, myIter, myThid)       &                 suffix, myTime, myIter, myThid )
98        ENDIF        ENDIF
99  #endif  /* COMPONENT_MODULE */  #endif  /* COMPONENT_MODULE */
100    
101  #ifdef ALLOW_FLT  #ifdef ALLOW_FLT
102  C     Write restart file for floats  C     Write restart file for floats
103        IF (useFLT) THEN        IF (useFLT) THEN
104          CALL FLT_RESTART(myTime, myIter, myThid)          CALL FLT_WRITE_PICKUP(
105         &                  suffix, myTime, myIter, myThid )
106        ENDIF        ENDIF
107  #endif  #endif
108    
109  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
110  C     Write pickup file for Lnad package:  C     Write pickup file for Land package:
111        IF (useLand) THEN        IF (useLand) THEN
112          CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL LAND_WRITE_PICKUP( permPickup,
113         &                  suffix, myTime, myIter, myThid )
114        ENDIF        ENDIF
115  #endif  #endif
116    
117  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
118  C     Write pickup file for fizhi package  C     Write pickup file for fizhi package
119        IF (usefizhi) THEN        IF (usefizhi) THEN
120          CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL FIZHI_WRITE_PICKUP(suffix,myTime,myIter,myThid)
121          CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)          CALL FIZHI_WRITE_VEGTILES(suffix,0,myTime,myIter,myThid)
122          CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)          CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
123        ENDIF        ENDIF
124  #endif  #endif
# Line 200  C     Write pickup file for fizhi packag Line 126  C     Write pickup file for fizhi packag
126  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
127  C     Write pickup file for diagnostics package  C     Write pickup file for diagnostics package
128        IF (useDiagnostics) THEN        IF (useDiagnostics) THEN
129          CALL DIAGNOSTICS_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL DIAGNOSTICS_WRITE_PICKUP( permPickup,
130         I                         suffix, myTime, myIter, myThid )
131        ENDIF        ENDIF
132  #endif  #endif
133    
134  #ifdef  ALLOW_GGL90  #ifdef  ALLOW_GGL90
135        IF ( useGGL90 ) THEN        IF ( useGGL90 ) THEN
136          CALL GGL90_WRITE_CHECKPOINT(          CALL GGL90_WRITE_PICKUP( permPickup,
137       &       prec, lgf, permCheckPoint, myIter, myThid)       I                      suffix, myTime, myIter, myThid )
138        ENDIF        ENDIF
139  #endif  /* ALLOW_GGL90 */  #endif  /* ALLOW_GGL90 */
140    
        _END_MASTER( myThid )  
        _BARRIER  
   
141  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
142  C      Write restart file for passive tracers  C     Write restart file for passive tracers
143         IF (usePTRACERS) THEN        IF (usePTRACERS) THEN
144           CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)          CALL PTRACERS_WRITE_PICKUP( permPickup,
145         ENDIF       I                      suffix, myTime, myIter, myThid )
146          ENDIF
147  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
148    
149    #ifdef ALLOW_GCHEM
150    C     Write restart file for GCHEM pkg & GCHEM sub-packages
151          IF ( useGCHEM ) THEN
152            CALL GCHEM_WRITE_PICKUP( permPickup,
153         I                      suffix, myTime, myIter, myThid )
154          ENDIF
155    #endif
156    
157    #ifdef ALLOW_CHEAPAML
158    C     Write restart file for CHEAPAML pkg
159          IF ( useCheapAML ) THEN
160             CALL CHEAPAML_WRITE_PICKUP( permPickup,
161         I                      suffix, myTime, myIter, myThid)
162           ENDIF
163    #endif /* ALLOW_CHEAPAML */
164    
165    #ifdef ALLOW_MYPACKAGE
166          IF (useMYPACKAGE) THEN
167            CALL MYPACKAGE_WRITE_PICKUP( permPickup,
168         I                      suffix, myTime, myIter, myThid )
169          ENDIF
170    #endif /* ALLOW_MYPACKAGE */
171    
172    C--   Every one else must wait until writing is done.
173    C     this is done within IO routines => no longer needed
174    c     _BARRIER
175    
176        RETURN        RETURN
177        END        END
178    
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.38
  ViewVC Help
Powered by ViewVC 1.1.22