/[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.4 by molod, Thu Jan 29 14:17:58 2004 UTC revision 1.23 by jmc, Thu Aug 24 01:10:35 2006 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    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, myTime, myIter, myThid )       I                    permPickup,
16  C     !DESCRIPTION: \bv       I                    myTime, myIter, myThid )
17  C     *==========================================================*  
18  C     | SUBROUTINE PACKAGES_WRITE_PICKUP                                C     !DESCRIPTION:
19  C     | o write pickup files for each package which needs it  C     Write pickup files for each package which needs it to restart.
20  C     |   to restart.  C     This routine (S/R PACKAGES_WRITE_PICKUP) calls per-package
21  C     *==========================================================*  C     write-pickup (or checkpoint) routines.  It writes both
22  C     | This routine (S/R PACKAGES_WRITE_PICKUP) calls  C     "rolling-pickup" files (ckptA,ckptB) and permanent pickup.
 C     | per-package write-pickup (or checkpoint) routines.  
 C     | o writes both "rolling-checkpoint" files (ckptA,ckptB)        
 C     |   and permanent checkpoint files.  
 C     *==========================================================*  
 C     \ev  
23    
24  C     !USES:  C     !USES:
25        IMPLICIT NONE        IMPLICIT NONE
 C     == Global variables ===  
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29    
       LOGICAL  DIFFERENT_MULTIPLE  
       EXTERNAL DIFFERENT_MULTIPLE  
       INTEGER  IO_ERRCOUNT  
       EXTERNAL IO_ERRCOUNT  
   
30  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
31  C     == Routine arguments ==  C     permPickup :: Is or is not a permanent pickup.
32  C     modelEnd    :: Checkpoint call at end of model run.  C     myTime     :: Current time of simulation ( s )
33  C     myThid :: Thread number for this instance of the routine.  C     myIter     :: Iteration number
34  C     myIter :: Iteration number  C     myThid     :: Thread number for this instance of the routine.
35  C     myTime :: Current time of simulation ( s )        LOGICAL permPickup
       LOGICAL modelEnd      
       INTEGER myThid  
       INTEGER myIter  
36        _RL     myTime        _RL     myTime
37          INTEGER myIter
38          INTEGER myThid
39    
40  C     == Common blocks ==  C     == Common blocks ==
41        COMMON /PCKP_GBLFLS/ globalFile        COMMON /PCKP_GBLFLS/ globalFile
# Line 51  C     == Common blocks == Line 43  C     == Common blocks ==
43    
44  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
45  C     == Local variables ==  C     == Local variables ==
46  C     permCheckPoint :: Flag indicating whether a permanent checkpoint will  C     prec   :: file precision
 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  
47  C     fn     :: Temp. for building file name string.  C     fn     :: Temp. for building file name string.
48  C     lgf    :: Flag to indicate whether to use global file mode.  C     lgf    :: Flag to indicate whether to use global file mode.
       LOGICAL permCheckPoint, tempCheckPoint    
49        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
50        INTEGER prec        INTEGER prec
51        LOGICAL lgf        LOGICAL lgf
52  CEOP  CEOP
53    
54        permCheckPoint = .FALSE.  C     Going to really do some IO. Make everyone except master thread wait.
55        tempCheckPoint = .FALSE.        _BARRIER
       permCheckPoint=  
      &  DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock)  
       tempCheckPoint=  
      &  DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock)  
56    
57  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|        prec = precFloat64
58        IF (        lgf = globalFile
59       &    ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )  
60       &   .OR.  C     Create suffix to pass on to package pickup routines
61       &    ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )        IF ( permPickup ) THEN
62       &   ) THEN          WRITE(fn,'(I10.10)') myIter
63          ELSE
64  C--    Going to really do some IO. Make everyone except master thread wait.          WRITE(fn,'(A)') checkPtSuff(nCheckLev)
65         _BARRIER        ENDIF
        _BEGIN_MASTER( myThid )  
   
         prec = precFloat64  
         lgf = globalFile  
   
 C Create suffix to pass on to package pickup routines  
          IF ( permCheckPoint ) THEN  
           WRITE(fn,'(I10.10)') myIter  
          ELSE  
           WRITE(fn,'(A)') checkPtSuff(nCheckLev)  
          ENDIF  
66    
67  #ifdef ALLOW_CD_CODE  #ifdef ALLOW_CD_CODE
68          IF (useCDscheme) THEN        IF (useCDscheme) THEN
69            CALL CD_CODE_WRITE_CHECKPOINT(          CALL CD_CODE_WRITE_CHECKPOINT(
70       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
71          ENDIF        ENDIF
72  #endif /* ALLOW_CD_CODE */  #endif /* ALLOW_CD_CODE */
73    
74  #ifdef  ALLOW_OBCS  #ifdef  ALLOW_OBCS
75  C SPK 4/9/01: Open boundary checkpointing  C     SPK 4/9/01: Open boundary checkpointing
76          IF (useOBCS) THEN        IF (useOBCS) THEN
77            CALL OBCS_WRITE_CHECKPOINT(          CALL OBCS_WRITE_CHECKPOINT(
78       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
79          ENDIF        ENDIF
80  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
81    
82  #ifdef  ALLOW_SEAICE  #ifdef  ALLOW_SEAICE
83          IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
84            CALL SEAICE_WRITE_PICKUP(          CALL SEAICE_WRITE_PICKUP(
85       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
86          ENDIF        ENDIF
87  #endif  /* ALLOW_SEAICE */  #endif  /* ALLOW_SEAICE */
88    
89  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
90          IF (useThSIce) THEN        IF (useThSIce) THEN
91            CALL THSICE_WRITE_CHECKPOINT(          CALL THSICE_WRITE_PICKUP(
92       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
93          ENDIF        ENDIF
94  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
95    
96  #ifdef  COMPONENT_MODULE  #ifdef  COMPONENT_MODULE
97          IF (useCoupler) THEN        IF (useCoupler) THEN
98            CALL CPL_WRITE_PICKUP(          CALL CPL_WRITE_PICKUP(
99       &               prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
100          ENDIF        ENDIF
101  #endif  /* COMPONENT_MODULE */  #endif  /* COMPONENT_MODULE */
102    
103  #ifdef ALLOW_FLT  #ifdef ALLOW_FLT
104  C--     Write restart file for floats  C     Write restart file for floats
105          IF (useFLT) THEN        IF (useFLT) THEN
106            CALL FLT_RESTART(myTime, myIter, myThid)          CALL FLT_RESTART(myTime, myIter, myThid)
107          ENDIF        ENDIF
108  #endif  #endif
109    
110  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
111  C--     Write pickup file for Lnad package:  C     Write pickup file for Land package:
112          IF (useLand) THEN        IF (useLand) THEN
113            CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL LAND_WRITE_PICKUP(permPickup,fn,
114          ENDIF       &       myTime,myIter,myThid)
115          ENDIF
116  #endif  #endif
117    
118  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
119  C--     Write pickup file for fizhi package  C     Write pickup file for fizhi package
120          IF (usefizhi) THEN        IF (usefizhi) THEN
121            CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)          CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid)
122          ENDIF          CALL FIZHI_WRITE_VEGTILES(fn,0,myTime,myIter,myThid)
123            CALL FIZHI_WRITE_DATETIME(myTime,myIter,myThid)
124          ENDIF
125  #endif  #endif
126    
127    #ifdef ALLOW_DIAGNOSTICS
128    C     Write pickup file for diagnostics package
129          IF (useDiagnostics) THEN
130            CALL DIAGNOSTICS_WRITE_PICKUP(permPickup,
131         &       fn,myTime,myIter,myThid)
132          ENDIF
133    #endif
134    
135         _END_MASTER( myThid )  #ifdef  ALLOW_GGL90
136         _BARRIER        IF ( useGGL90 ) THEN
137            CALL GGL90_WRITE_CHECKPOINT(
138         &       prec, lgf, permPickup, myIter, myThid)
139          ENDIF
140    #endif  /* ALLOW_GGL90 */
141    
142  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
143  C Write restart file for passive tracers  C     Write restart file for passive tracers
144         IF (usePTRACERS) THEN        IF (usePTRACERS) THEN
145           CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid)          CALL PTRACERS_WRITE_CHECKPOINT(permPickup,
146         ENDIF       &       fn,myIter,myTime,myThid)
147          ENDIF
148  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
149    
150        ENDIF  C--   Every one else must wait until writing is done.
151          _BARRIER
152    
153        RETURN        RETURN
154        END        END
155    
156    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22