File indexing completed on 2018-03-02 18:36:39 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
94852f2504 Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_OPTIONS.h"
0003
0004
0005
0006
0007
0008 SUBROUTINE DO_WRITE_PICKUP(
0009 I modelEnd,
0010 I myTime, myIter, myThid )
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
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
0037
0038
0039
0040
0041 LOGICAL modelEnd
0042 INTEGER myThid
0043 INTEGER myIter
0044 _RL myTime
0045
0046
0047
0048
0049
0050
0051
528fbbe5ca Jean*0052
94852f2504 Jean*0053
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
94852f2504 Jean*0079
528fbbe5ca Jean*0080
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
94852f2504 Jean*0090 CALL PACKAGES_WRITE_PICKUP(
528fbbe5ca Jean*0091 I permPickup, suffix, myTime, myIter, myThid )
94852f2504 Jean*0092
528fbbe5ca Jean*0093
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
0101
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
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
0120 ENDIF
0121
0122 RETURN
0123 END