/[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.20 by cnh, Tue Nov 8 23:01:10 2005 UTC revision 1.25 by jmc, Tue Jan 16 04:40:05 2007 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
# Line 28  C     !USES: Line 27  C     !USES:
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
   
 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    
 #ifdef ALLOW_CAL  
       INTEGER thisdate(4), prevdate(4)  
 #endif  
 CEOP  
   
       permCheckPoint = .FALSE.  
       tempCheckPoint = .FALSE.  
       permCheckPoint=  
      &     DIFFERENT_MULTIPLE(pChkptFreq,myTime,deltaTClock)  
       tempCheckPoint=  
      &     DIFFERENT_MULTIPLE( ChkptFreq,myTime,deltaTClock)  
   
 #ifdef ALLOW_CAL  
       IF ( calendarDumps ) THEN  
 C--   Convert approximate months (30-31 days) and years (360-372 days)  
 C     to exact calendar months and years.  
 C-    First determine calendar dates for this and previous time step.  
          call cal_GetDate( myiter  ,mytime            ,thisdate,mythid )  
          call cal_GetDate( myiter-1,mytime-deltaTClock,prevdate,mythid )  
 C-    Monthly pChkptFreq:  
          IF( pChkptFreq.GE. 2592000 .AND. pChkptFreq.LE. 2678400 ) THEN  
             permCheckPoint = .FALSE.  
             IF((thisdate(1)-prevdate(1)) .GT. 50  )permCheckPoint=.TRUE.  
          ENDIF  
 C-    Yearly  pChkptFreq:  
          IF( pChkptFreq.GE.31104000 .AND. pChkptFreq.LE.31968000 ) THEN  
             permCheckPoint = .FALSE.  
             IF((thisdate(1)-prevdate(1)) .GT. 5000)permCheckPoint=.TRUE.  
          ENDIF  
 C-    Monthly  ChkptFreq:  
          IF(  ChkptFreq.GE. 2592000 .AND.  ChkptFreq.LE. 2678400 ) THEN  
             tempCheckPoint = .FALSE.  
             IF((thisdate(1)-prevdate(1)) .GT. 50  )tempCheckPoint=.TRUE.  
          ENDIF  
 C-    Yearly   ChkptFreq:  
          IF(  ChkptFreq.GE.31104000 .AND.  ChkptFreq.LE.31968000 ) THEN  
             tempCheckPoint = .FALSE.  
             IF((thisdate(1)-prevdate(1)) .GT. 5000)tempCheckPoint=.TRUE.  
          ENDIF  
       ENDIF  
 #endif  
   
       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  
37        INTEGER myIter        INTEGER myIter
38        _RL     myTime        INTEGER myThid
39    
40  C     == Common blocks ==  C     == Common blocks ==
41        COMMON /PCKP_GBLFLS/ globalFile        COMMON /PCKP_GBLFLS/ globalFile
# Line 149  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     oldPrc :: Temp. for holding I/O precision  C     prec   :: file 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.
49        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
# Line 159  CEOP Line 53  CEOP
53    
54  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.
55        _BARRIER        _BARRIER
 C     _BEGIN_MASTER( myThid )  
56    
57        prec = precFloat64        prec = precFloat64
58        lgf = globalFile        lgf = globalFile
59          
60  C     Create suffix to pass on to package pickup routines  C     Create suffix to pass on to package pickup routines
61        IF ( permCheckPoint ) THEN        IF ( permPickup ) THEN
62          WRITE(fn,'(I10.10)') myIter          WRITE(fn,'(I10.10)') myIter
63        ELSE        ELSE
64          WRITE(fn,'(A)') checkPtSuff(nCheckLev)          WRITE(fn,'(A)') checkPtSuff(nCheckLev)
65        ENDIF        ENDIF
66    
67    #ifdef ALLOW_GENERIC_ADVDIFF
68    C     Write restart file for 2nd-Order moment (active) Tracers
69          IF ( useGAD ) THEN
70            CALL GAD_WRITE_PICKUP(
71         I                 fn, myTime, myIter, myThid )
72          ENDIF
73    #endif /* ALLOW_GENERIC_ADVDIFF */
74    
75  #ifdef ALLOW_CD_CODE  #ifdef ALLOW_CD_CODE
76        IF (useCDscheme) THEN        IF (useCDscheme) THEN
77          CALL CD_CODE_WRITE_CHECKPOINT(          CALL CD_CODE_WRITE_PICKUP(
78       &       prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
79        ENDIF        ENDIF
80  #endif /* ALLOW_CD_CODE */  #endif /* ALLOW_CD_CODE */
81    
# Line 182  C     Create suffix to pass on to packag Line 83  C     Create suffix to pass on to packag
83  C     SPK 4/9/01: Open boundary checkpointing  C     SPK 4/9/01: Open boundary checkpointing
84        IF (useOBCS) THEN        IF (useOBCS) THEN
85          CALL OBCS_WRITE_CHECKPOINT(          CALL OBCS_WRITE_CHECKPOINT(
86       &       prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
87        ENDIF        ENDIF
88  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
89          
90  #ifdef  ALLOW_SEAICE  #ifdef  ALLOW_SEAICE
91        IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
92          CALL SEAICE_WRITE_PICKUP(          CALL SEAICE_WRITE_PICKUP(
93       &       prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
94        ENDIF        ENDIF
95  #endif  /* ALLOW_SEAICE */  #endif  /* ALLOW_SEAICE */
96    
97  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
98        IF (useThSIce) THEN        IF (useThSIce) THEN
99          CALL THSICE_WRITE_PICKUP(          CALL THSICE_WRITE_PICKUP(
100       &       prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
101        ENDIF        ENDIF
102  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
103    
104  #ifdef  COMPONENT_MODULE  #ifdef  COMPONENT_MODULE
105        IF (useCoupler) THEN        IF (useCoupler) THEN
106          CALL CPL_WRITE_PICKUP(          CALL CPL_WRITE_PICKUP(
107       &       prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
108        ENDIF        ENDIF
109  #endif  /* COMPONENT_MODULE */  #endif  /* COMPONENT_MODULE */
110    
# Line 217  C     Write restart file for floats Line 118  C     Write restart file for floats
118  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
119  C     Write pickup file for Land package:  C     Write pickup file for Land package:
120        IF (useLand) THEN        IF (useLand) THEN
121          CALL LAND_WRITE_PICKUP(permCheckPoint,fn,          CALL LAND_WRITE_PICKUP(permPickup,fn,
122       &       myTime,myIter,myThid)       &       myTime,myIter,myThid)
123        ENDIF        ENDIF
124  #endif  #endif
# Line 234  C     Write pickup file for fizhi packag Line 135  C     Write pickup file for fizhi packag
135  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
136  C     Write pickup file for diagnostics package  C     Write pickup file for diagnostics package
137        IF (useDiagnostics) THEN        IF (useDiagnostics) THEN
138          CALL DIAGNOSTICS_WRITE_PICKUP(permCheckPoint,          CALL DIAGNOSTICS_WRITE_PICKUP(permPickup,
139       &       fn,myTime,myIter,myThid)       &       fn,myTime,myIter,myThid)
140        ENDIF        ENDIF
141  #endif  #endif
# Line 242  C     Write pickup file for diagnostics Line 143  C     Write pickup file for diagnostics
143  #ifdef  ALLOW_GGL90  #ifdef  ALLOW_GGL90
144        IF ( useGGL90 ) THEN        IF ( useGGL90 ) THEN
145          CALL GGL90_WRITE_CHECKPOINT(          CALL GGL90_WRITE_CHECKPOINT(
146       &       prec, lgf, permCheckPoint, myIter, myThid)       &       prec, lgf, permPickup, myIter, myThid)
147        ENDIF        ENDIF
148  #endif  /* ALLOW_GGL90 */  #endif  /* ALLOW_GGL90 */
149    
 C     _END_MASTER( myThid )  
       _BARRIER  
   
150  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
151  C     Write restart file for passive tracers  C     Write restart file for passive tracers
152        IF (usePTRACERS) THEN        IF (usePTRACERS) THEN
153          CALL PTRACERS_WRITE_CHECKPOINT(permCheckPoint,          CALL PTRACERS_WRITE_PICKUP(permPickup,
154       &       fn,myIter,myTime,myThid)       &       fn,myIter,myTime,myThid)
155        ENDIF        ENDIF
156  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
157    
158  #ifdef ALLOW_OFFLINE  C--   Every one else must wait until writing is done.
159  C     This is quick fix for A/B checkpoints since the main model        _BARRIER
 C     checkpoint routine will not be called in OFFLINE mode and will  
 C     thus not have the chance to set the alternating A/B suffix  
       IF ( .NOT. permCheckPoint ) THEN  
         nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1  
       ENDIF  
 #endif /* ALLOW_OFFLINE */  
160    
161        RETURN        RETURN
162        END        END
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22