-
Notifications
You must be signed in to change notification settings - Fork 237
/
atm2d_write_pickup.F
172 lines (143 loc) · 5.56 KB
/
atm2d_write_pickup.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
#include "ctrparam.h"
#include "ATM2D_OPTIONS.h"
SUBROUTINE ATM2D_WRITE_PICKUP(
I modelEnd,
I myTime,
I myIter,
I myThid )
C *==========================================================*
C | Write pickup files for atm2d package which needs it to |
C |restart. It writes both "rolling-checkpoint" files (ckptA,|
C |ckptB) and permanent checkpoint files. NOT called from |
C |the usual MITGCM WRITE_PICKUP routine in forward step, as |
C |NORM_OCN_FLUXES must be done before these fluxes are ready|
C *==========================================================*
C Note this routine was pilfered from the MITGCM code prior to
C JMC's changes in 8/06.
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "RESTART.h"
LOGICAL DIFFERENT_MULTIPLE
EXTERNAL DIFFERENT_MULTIPLE
INTEGER IO_ERRCOUNT
EXTERNAL IO_ERRCOUNT
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C modelEnd :: Checkpoint call at end of model run.
C myThid :: Thread number for this instance of the routine.
C myIter :: Iteration number
C myTime :: Current time of simulation ( s )
LOGICAL modelEnd
INTEGER myThid
INTEGER myIter
_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)
LOGICAL permCheckPoint, tempCheckPoint
CEOP
permCheckPoint = .FALSE.
tempCheckPoint = .FALSE.
permCheckPoint=
& DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
tempCheckPoint=
& DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
#ifdef ALLOW_CAL
IF ( useCAL ) THEN
CALL CAL_TIME2DUMP( zeroRL, pChkPtFreq, deltaTClock,
U permCheckPoint,
I myTime, myIter, myThid )
CALL CAL_TIME2DUMP( zeroRL, chkPtFreq, deltaTClock,
U tempCheckPoint,
I myTime, myIter, myThid )
ENDIF
#endif /* ALLOW_CAL */
IF (
& ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
& .OR.
& ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
& ) THEN
IF (tempCheckPoint) !toggle was done prematurely...
& nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
CALL ATM2D_WRITE_PICKUP_NOW(
& permCheckPoint, myTime, myIter, myThid )
IF (tempCheckPoint) !note this works for A/B chpt only
& nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
ENDIF
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#include "ctrparam.h"
#include "ATM2D_OPTIONS.h"
CBOP
C !ROUTINE: ATM2D_WRITE_PICKUP_NOW
C !INTERFACE:
SUBROUTINE ATM2D_WRITE_PICKUP_NOW(
I permCheckPoint,
I myTime,
I myIter,
I myThid )
C !DESCRIPTION:
C Write pickup files for atm2d package which needs it to restart and
C do it NOW.
C !USES:
IMPLICIT NONE
#include "ATMSIZE.h"
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "RESTART.h"
#include "THSICE_VARS.h"
#include "ATM2D_VARS.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
INTEGER myIter
_RL myTime
C == Common blocks ==
COMMON /PCKP_GBLFLS/ globalFile
LOGICAL globalFile
C !LOCAL VARIABLES:
C == Local variables ==
C oldPrc :: Temp. for holding I/O precision
C fn :: Temp. for building file name string.
CHARACTER*(MAX_LEN_FNAM) fn
INTEGER prec, i,j
CEOP
prec = precFloat64
C Create suffix to pass on to package pickup routines
IF ( permCheckPoint ) THEN
WRITE(fn,'(A,I10.10)') 'pickup_atm2d.',myIter
ELSE
WRITE(fn,'(A,A)') 'pickup_atm2d.',checkPtSuff(nCheckLev)
ENDIF
CALL WRITE_REC_3D_RL( fn,prec,1,pass_slp, 1,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_qnet, 2,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_solarnet, 3,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_fu, 4,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_fv, 5,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_precip, 6,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_evap, 7,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_runoff, 8,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_wspeed, 9,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_pCO2, 10,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_sIceLoad,11,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,sHeating, 12,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,flxCndBt, 13,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,pass_prcAtm, 14,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,snowPrc, 15,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,icFrwAtm, 16,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,icFlxSw, 17,myIter,myThid )
CALL WRITE_REC_3D_RL( fn,prec,1,siceAlb, 18,myIter,myThid )
RETURN
END