model/src/do_write_pickup.F

94852f2504 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP
                0006 C     !ROUTINE: DO_WRITE_PICKUP
                0007 C     !INTERFACE:
                0008       SUBROUTINE DO_WRITE_PICKUP(
                0009      I                    modelEnd,
                0010      I                    myTime, myIter, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     This is the controlling routine that decides when to write restart
                0014 C      (or "pickup" or "checkpoint" ) files. Then it calls 2 subroutines
                0015 C     to write the main-model pickup and each package pickup files.
                0016 C
                0017 C     Both ``rolling-pickup'' files and permanent pickup files
                0018 C     are written from here. A rolling pickup works through a circular
                0019 C     list of suffices. Generally the circular list has two entries so
                0020 C     that a rolling pickup will overwrite the last rolling
                0021 C     pickup but one. This is useful for running long jobs without
                0022 C     filling too much disk space.  In a permanent pickup, data is
                0023 C     written suffixed by the current timestep number. Permanent
                0024 C     pickups can be used to provide snap-shots from which the
                0025 C     model can be restarted.
                0026
                0027 C     !USES:
                0028       IMPLICIT NONE
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
9fafc42509 Jean*0032 #include "RESTART.h"
94852f2504 Jean*0033       LOGICAL  DIFFERENT_MULTIPLE
                0034       EXTERNAL DIFFERENT_MULTIPLE
                0035
                0036 C     !INPUT PARAMETERS:
                0037 C     modelEnd  :: true if call at end of model run.
                0038 C     myTime    :: Current time of simulation ( s )
                0039 C     myIter    :: Iteration number
                0040 C     myThid    :: Thread number for this instance of the routine.
                0041       LOGICAL modelEnd
                0042       INTEGER myThid
                0043       INTEGER myIter
                0044       _RL     myTime
                0045 CEOP
                0046
                0047 C     !LOCAL VARIABLES:
                0048 C     permPickup :: Flag indicating whether a permanent pickup will
                0049 C                       be written.
                0050 C     tempPickup :: Flag indicating if it is time to write a non-permanent
                0051 C                       pickup (that will be permanent if permPickup=T)
528fbbe5ca Jean*0052 C     suffix     :: pickup-name suffix
94852f2504 Jean*0053 C     msgBuf     :: message buffer
                0054       LOGICAL permPickup, tempPickup
528fbbe5ca Jean*0055       CHARACTER*(10) suffix
94852f2504 Jean*0056       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0057
                0058       permPickup = .FALSE.
                0059       tempPickup = .FALSE.
                0060       permPickup =
                0061      &     DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
                0062       tempPickup =
                0063      &     DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
                0064
                0065 #ifdef ALLOW_CAL
                0066       IF ( useCAL ) THEN
7a31080eb8 Jean*0067          CALL CAL_TIME2DUMP( zeroRL, pChkPtFreq, deltaTClock,
94852f2504 Jean*0068      U                       permPickup,
                0069      I                       myTime, myIter, myThid )
7a31080eb8 Jean*0070          CALL CAL_TIME2DUMP( zeroRL, chkPtFreq,  deltaTClock,
94852f2504 Jean*0071      U                       tempPickup,
                0072      I                       myTime, myIter, myThid )
                0073       ENDIF
                0074 #endif
                0075
8c73a5b228 Mart*0076       IF ( (modelEnd.AND.writePickupAtEnd)
                0077      &     .OR. permPickup .OR. tempPickup ) THEN
528fbbe5ca Jean*0078 C--   This is time to write pickup files
94852f2504 Jean*0079
528fbbe5ca Jean*0080 C-    Create suffix to pass on to main & package pickup routines
                0081         IF ( permPickup .AND. rwSuffixType.EQ.0 ) THEN
                0082           WRITE(suffix,'(I10.10)') myIter
                0083         ELSEIF ( permPickup ) THEN
                0084           CALL RW_GET_SUFFIX( suffix, myTime, myIter, myThid )
                0085         ELSE
                0086           WRITE(suffix,'(A)') checkPtSuff(nCheckLev)
                0087         ENDIF
                0088
                0089 C-    Write a pickup for each package which need it to restart
94852f2504 Jean*0090         CALL PACKAGES_WRITE_PICKUP(
528fbbe5ca Jean*0091      I                permPickup, suffix, myTime, myIter, myThid )
94852f2504 Jean*0092
528fbbe5ca Jean*0093 C-    Write main model pickup
b8c40edd31 Jean*0094         IF ( .NOT.useOffLine .OR. nonlinFreeSurf.GT.0 ) THEN
94852f2504 Jean*0095            CALL WRITE_PICKUP(
528fbbe5ca Jean*0096      I                permPickup, suffix, myTime, myIter, myThid )
94852f2504 Jean*0097         ENDIF
                0098
                0099         _BEGIN_MASTER(myThid)
                0100 C-    Write information to stdout so there is a record that
                0101 C     writing the pickup was completed
                0102         WRITE(msgBuf,'(A11,I10,1X,A10)')
528fbbe5ca Jean*0103      &     "%CHECKPOINT ", myIter, suffix
94852f2504 Jean*0104         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0105      &                    SQUEEZE_RIGHT, myThid )
                0106
                0107 C-    Update pickup level for the next time we write pickup
                0108         IF ( .NOT. permPickup ) THEN
                0109           nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
                0110         ENDIF
                0111         _END_MASTER(myThid)
                0112
8c73a5b228 Mart*0113       ELSEIF ( modelEnd ) THEN
                0114         WRITE(msgBuf,'(A)')
                0115      &     "Did not write pickup because writePickupAtEnd = FALSE"
                0116         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0117      &                    SQUEEZE_RIGHT, myThid )
                0118
94852f2504 Jean*0119 C--   time to write pickup files: end
                0120       ENDIF
                0121
                0122       RETURN
                0123       END