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

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

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

revision 1.1 by jmc, Thu Aug 24 01:08:34 2006 UTC revision 1.10 by jmc, Fri Mar 24 23:26:10 2017 UTC
# Line 32  C     !USES: Line 32  C     !USES:
32  #include "SIZE.h"  #include "SIZE.h"
33  #include "EEPARAMS.h"  #include "EEPARAMS.h"
34  #include "PARAMS.h"  #include "PARAMS.h"
35    #include "RESTART.h"
36        LOGICAL  DIFFERENT_MULTIPLE        LOGICAL  DIFFERENT_MULTIPLE
37        EXTERNAL DIFFERENT_MULTIPLE        EXTERNAL DIFFERENT_MULTIPLE
38    
# Line 51  C     permPickup :: Flag indicating whet Line 52  C     permPickup :: Flag indicating whet
52  C                       be written.  C                       be written.
53  C     tempPickup :: Flag indicating if it is time to write a non-permanent  C     tempPickup :: Flag indicating if it is time to write a non-permanent
54  C                       pickup (that will be permanent if permPickup=T)  C                       pickup (that will be permanent if permPickup=T)
55  C     fn         :: Temp. for building file name string.  C     suffix     :: pickup-name suffix
56  C     msgBuf     :: message buffer  C     msgBuf     :: message buffer
57        LOGICAL permPickup, tempPickup        LOGICAL permPickup, tempPickup
58        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(10) suffix
59        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
60    
61        permPickup = .FALSE.        permPickup = .FALSE.
# Line 66  C     msgBuf     :: message buffer Line 67  C     msgBuf     :: message buffer
67    
68  #ifdef ALLOW_CAL  #ifdef ALLOW_CAL
69        IF ( useCAL ) THEN        IF ( useCAL ) THEN
70           CALL CAL_TIME2DUMP( pChkPtFreq, deltaTClock,           CALL CAL_TIME2DUMP( zeroRL, pChkPtFreq, deltaTClock,
71       U                       permPickup,       U                       permPickup,
72       I                       myTime, myIter, myThid )       I                       myTime, myIter, myThid )
73           CALL CAL_TIME2DUMP( chkPtFreq,  deltaTClock,           CALL CAL_TIME2DUMP( zeroRL, chkPtFreq,  deltaTClock,
74       U                       tempPickup,       U                       tempPickup,
75       I                       myTime, myIter, myThid )       I                       myTime, myIter, myThid )
76        ENDIF        ENDIF
77  #endif  #endif
78    
79        IF (        IF ( (modelEnd.AND.writePickupAtEnd)
80       &     ( .NOT.modelEnd .AND. (permPickup.OR.tempPickup) )       &     .OR. permPickup .OR. tempPickup ) THEN
81       &     .OR.  C--   This is time to write pickup files
82       &     ( modelEnd .AND. .NOT.(permPickup.OR.tempPickup) )  
83       &    ) THEN  C-    Create suffix to pass on to main & package pickup routines
84  C--   this is time to write pickup files          IF ( permPickup .AND. rwSuffixType.EQ.0 ) THEN
85              WRITE(suffix,'(I10.10)') myIter
86            ELSEIF ( permPickup ) THEN
87              CALL RW_GET_SUFFIX( suffix, myTime, myIter, myThid )
88            ELSE
89              WRITE(suffix,'(A)') checkPtSuff(nCheckLev)
90            ENDIF
91    
92  C-    write a pickup for each package which need it to restart  C-    Write a pickup for each package which need it to restart
93          CALL PACKAGES_WRITE_PICKUP(          CALL PACKAGES_WRITE_PICKUP(
94       I                permPickup, myTime, myIter, myThid )       I                permPickup, suffix, myTime, myIter, myThid )
95    
96  C-    write main model pickup  C-    Write main model pickup
97          IF ( .NOT.useOffLine ) THEN          IF ( .NOT.useOffLine .OR. nonlinFreeSurf.GT.0 ) THEN
98             CALL WRITE_PICKUP(             CALL WRITE_PICKUP(
99       I                permPickup, myTime, myIter, myThid )       I                permPickup, suffix, myTime, myIter, myThid )
100          ENDIF          ENDIF
101    
102          _BEGIN_MASTER(myThid)          _BEGIN_MASTER(myThid)
 C-    Write suffix for stdout information  
         IF ( permPickup ) THEN  
           WRITE(fn,'(I10.10)') myIter  
         ELSE  
           WRITE(fn,'(A)') checkPtSuff(nCheckLev)  
         ENDIF  
   
103  C-    Write information to stdout so there is a record that  C-    Write information to stdout so there is a record that
104  C     writing the pickup was completed  C     writing the pickup was completed
105          WRITE(msgBuf,'(A11,I10,1X,A10)')          WRITE(msgBuf,'(A11,I10,1X,A10)')
106       &     "%CHECKPOINT ",myIter,fn       &     "%CHECKPOINT ", myIter, suffix
107          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
108       &                    SQUEEZE_RIGHT, myThid )       &                    SQUEEZE_RIGHT, myThid )
109    
# Line 113  C-    Update pickup level for the next t Line 113  C-    Update pickup level for the next t
113          ENDIF          ENDIF
114          _END_MASTER(myThid)          _END_MASTER(myThid)
115    
116          ELSEIF ( modelEnd ) THEN
117            WRITE(msgBuf,'(A)')
118         &     "Did not write pickup because writePickupAtEnd = FALSE"
119            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
120         &                    SQUEEZE_RIGHT, myThid )
121    
122  C--   time to write pickup files: end  C--   time to write pickup files: end
123        ENDIF        ENDIF
124    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22