/[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.5 by jmc, Wed Apr 7 23:45:24 2004 UTC revision 1.6 by edhill, Fri Aug 6 21:12:14 2004 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  
       CHARACTER*(MAX_LEN_FNAM) fn  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
       INTEGER prec  
       LOGICAL lgf  
57  CEOP  CEOP
58    
59        permCheckPoint = .FALSE.        permCheckPoint = .FALSE.
60        tempCheckPoint = .FALSE.        tempCheckPoint = .FALSE.
61        permCheckPoint=        permCheckPoint=
62       &  DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)       &     DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)
63        tempCheckPoint=        tempCheckPoint=
64       &  DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)       &     DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)
65          
66          IF (
67         &     ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
68         &     .OR.
69         &     ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
70         &     ) THEN
71    
72            CALL PACKAGES_WRITE_PICKUP_NOW(
73         &       permCheckPoint, myTime, myIter, myThid )
74    
75          ENDIF
76    
77          RETURN
78          END
79    
80    
81  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
82        IF (  CBOP
83       &    ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )  C     !ROUTINE: PACKAGES_WRITE_PICKUP_NOW
      &   .OR.  
      &    ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )  
      &   ) THEN  
84    
85  C--    Going to really do some IO. Make everyone except master thread wait.  C     !INTERFACE:
86         _BARRIER        SUBROUTINE PACKAGES_WRITE_PICKUP_NOW(
87         _BEGIN_MASTER( myThid )       I     permCheckPoint,
88         I     myTime,
89         I     myIter,
90         I     myThid )
91    
92    C     !DESCRIPTION:
93    C     Write pickup files for each package which needs it to restart and
94    C     do it NOW.
95    
96    C     !USES:
97          IMPLICIT NONE
98    #include "SIZE.h"
99    #include "EEPARAMS.h"
100    #include "PARAMS.h"
101    
102    
103    C     !INPUT/OUTPUT PARAMETERS:
104    C     permCheckPoint  :: Checkpoint is permanent
105    C     myThid :: Thread number for this instance of the routine.
106    C     myIter :: Iteration number
107    C     myTime :: Current time of simulation ( s )
108          LOGICAL permCheckPoint
109          INTEGER myThid
110          INTEGER myIter
111          _RL     myTime
112    
113    C     == Common blocks ==
114          COMMON /PCKP_GBLFLS/ globalFile
115          LOGICAL globalFile
116    
117          prec = precFloat64  C     !LOCAL VARIABLES:
118          lgf = globalFile  C     == Local variables ==
119    C     oldPrc :: Temp. for holding I/O precision
120    C     fn     :: Temp. for building file name string.
121    C     lgf    :: Flag to indicate whether to use global file mode.
122          CHARACTER*(MAX_LEN_FNAM) fn
123          INTEGER prec
124          LOGICAL lgf
125    CEOP
126    
127  C Create suffix to pass on to package pickup routines  C     Going to really do some IO. Make everyone except master thread wait.
128           IF ( permCheckPoint ) THEN        _BARRIER
129            WRITE(fn,'(I10.10)') myIter        _BEGIN_MASTER( myThid )
130           ELSE  
131            WRITE(fn,'(A)') checkPtSuff(nCheckLev)        prec = precFloat64
132           ENDIF        lgf = globalFile
133          
134    C     Create suffix to pass on to package pickup routines
135          IF ( permCheckPoint ) THEN
136            WRITE(fn,'(I10.10)') myIter
137          ELSE
138            WRITE(fn,'(A)') checkPtSuff(nCheckLev)
139          ENDIF
140    
141  #ifdef ALLOW_CD_CODE  #ifdef ALLOW_CD_CODE
142          IF (useCDscheme) THEN        IF (useCDscheme) THEN
143            CALL CD_CODE_WRITE_CHECKPOINT(          CALL CD_CODE_WRITE_CHECKPOINT(
144       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
145          ENDIF        ENDIF
146  #endif /* ALLOW_CD_CODE */  #endif /* ALLOW_CD_CODE */
147    
148  #ifdef  ALLOW_OBCS  #ifdef  ALLOW_OBCS
149  C SPK 4/9/01: Open boundary checkpointing  C     SPK 4/9/01: Open boundary checkpointing
150          IF (useOBCS) THEN        IF (useOBCS) THEN
151            CALL OBCS_WRITE_CHECKPOINT(          CALL OBCS_WRITE_CHECKPOINT(
152       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
153          ENDIF        ENDIF
154  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
155          
156  #ifdef  ALLOW_SEAICE  #ifdef  ALLOW_SEAICE
157          IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
158            CALL SEAICE_WRITE_PICKUP(          CALL SEAICE_WRITE_PICKUP(
159       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
160          ENDIF        ENDIF
161  #endif  /* ALLOW_SEAICE */  #endif  /* ALLOW_SEAICE */
162    
163  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
164          IF (useThSIce) THEN        IF (useThSIce) THEN
165            CALL THSICE_WRITE_PICKUP(          CALL THSICE_WRITE_PICKUP(
166       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
167          ENDIF        ENDIF
168  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
169    
170  #ifdef  COMPONENT_MODULE  #ifdef  COMPONENT_MODULE
171          IF (useCoupler) THEN        IF (useCoupler) THEN
172            CALL CPL_WRITE_PICKUP(          CALL CPL_WRITE_PICKUP(
173       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permCheckPoint, myIter, myThid)
174          ENDIF        ENDIF
175  #endif  /* COMPONENT_MODULE */  #endif  /* COMPONENT_MODULE */
176    
177  #ifdef ALLOW_FLT  #ifdef ALLOW_FLT
178  C--     Write restart file for floats  C     Write restart file for floats
179          IF (useFLT) THEN        IF (useFLT) THEN
180            CALL FLT_RESTART(myTime, myIter, myThid)          CALL FLT_RESTART(myTime, myIter, myThid)
181          ENDIF        ENDIF
182  #endif  #endif
183    
184  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
185  C--     Write pickup file for Lnad package:  C     Write pickup file for Lnad package:
186          IF (useLand) THEN        IF (useLand) THEN
187            CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)
188          ENDIF        ENDIF
189  #endif  #endif
190    
191  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
192  C--     Write pickup file for fizhi package  C     Write pickup file for fizhi package
193          IF (usefizhi) THEN        IF (usefizhi) THEN
194            CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
195          ENDIF  C        CALL FIZHI_WRITE_VEGTILES(fn,'D',myTime,myIter,myThid)
196          ENDIF
197  #endif  #endif
198    
   
199         _END_MASTER( myThid )         _END_MASTER( myThid )
200         _BARRIER         _BARRIER
201    
202  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
203  C Write restart file for passive tracers  C      Write restart file for passive tracers
204         IF (usePTRACERS) THEN         IF (usePTRACERS) THEN
205           CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)           CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)
206         ENDIF         ENDIF
207  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
208    
       ENDIF  
   
209        RETURN        RETURN
210        END        END
211    
212    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22