-
Notifications
You must be signed in to change notification settings - Fork 237
/
ctrl_get_gen_rec.F
237 lines (198 loc) · 7.04 KB
/
ctrl_get_gen_rec.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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
#include "CTRL_OPTIONS.h"
subroutine ctrl_get_gen_rec(
I xx_genstartdate,
I xx_genperiod,
O fac,
O first,
O changed,
O count0,
O count1,
I myTime, myIter, myThid )
C ==================================================================
C SUBROUTINE ctrl_get_gen_rec
C ==================================================================
C
C o Get flags, counters, and the linear interpolation factor for a
C given control vector contribution.
C o New, generic, for new routine ctrl_get_gen
C
C ==================================================================
C SUBROUTINE ctrl_get_gen_rec
C ==================================================================
implicit none
C == global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "CTRL_SIZE.h"
#include "CTRL.h"
#ifdef ALLOW_CAL
# include "cal.h"
#endif
C == routine arguments ==
integer xx_genstartdate(4)
_RL xx_genperiod
_RL fac
logical first
logical changed
integer count0
integer count1
_RL myTime
integer myIter
integer myThid
C == local variables ==
#ifdef ALLOW_CAL
integer mydate(4)
integer previousdate(4)
integer difftime(4)
integer fldcount
_RL fldsecs
integer prevfldcount
_RL prevfldsecs
integer flddate(4)
integer fldstartdate(4)
_RL fldperiod
c integer startrec
integer year0
integer year1
logical lArgErr
#else
C Declarations for code, adapted from external_fields_load,
C for simplied default model calendar without exf/cal
_RL myRelTime, tmpFac
INTEGER countP
#endif
#ifdef ECCO_VERBOSE
character*(max_len_mbuf) msgbuf
#endif
C == end of interface ==
#ifdef ALLOW_CAL
lArgErr = .true.
fldperiod = 0.
C Map the field parameters.
call cal_CopyDate(
I xx_genstartdate,
O fldstartdate,
I myThid
& )
fldperiod = xx_genperiod
lArgErr = .false.
C-- Check the field argument.
if ( lArgErr ) then
print*,' The subroutine *ctrl_get_gen_rec* has been called'
print*,' with an illegal field specification.'
stop ' ... stopped in ctrl_get_gen_rec.'
endif
if ( xx_genperiod .eq. -12. _d 0 ) then
C record numbers are assumed 1 to 12 corresponding to
C Jan. through Dec.
call cal_GetMonthsRec(
O fac, first, changed,
O count0, count1, year0, year1,
I myTime, myIter, myThid
& )
elseif ( fldperiod .eq. 0. _d 0 ) then
C Read field only once in the beginning. Hack: count1=count0 causes
C the model to read the first record twice, but since this this is
C done only the first time around it is not too much of an overhead.
first = ((myTime - modelstart) .lt. 0.5*modelstep)
changed = .false.
fac = 1. _d 0
count0 = 1
count1 = count0
else
C fldperiod .ne. 0
C-- Determine the current date.
call cal_GetDate( myIter, myTime, mydate, myThid )
C Determine first record:
c call cal_TimePassed( fldstartdate, modelstartdate,
c & difftime, myThid )
c call cal_ToSeconds ( difftime, fldsecs, myThid )
c startrec = int((modelstart - fldsecs)/fldperiod) + 1
C Determine the flux record just before mycurrentdate.
call cal_TimePassed( fldstartdate, mydate, difftime,
& myThid )
call cal_ToSeconds( difftime, fldsecs, myThid )
fldsecs = int((fldsecs+0.5)/fldperiod)*fldperiod
fldcount = int((fldsecs+0.5)/fldperiod) + 1
C Set switches for reading new records.
first = ((myTime - modelstart) .lt. 0.5*modelstep)
if ( first) then
changed = .false.
else
call cal_GetDate( myIter-1, myTime-modelstep,
& previousdate, myThid )
call cal_TimePassed( fldstartdate, previousdate,
& difftime, myThid )
call cal_ToSeconds( difftime, prevfldsecs, myThid )
prevfldsecs = int((prevfldsecs+0.5)/fldperiod)*fldperiod
prevfldcount = int((prevfldsecs+0.5)/fldperiod) + 1
if (fldcount .ne. prevfldcount) then
changed = .true.
else
changed = .false.
endif
endif
count0 = fldcount
count1 = fldcount + 1
call cal_TimeInterval( fldsecs, 'secs', difftime, myThid )
call cal_AddTime( fldstartdate, difftime, flddate, myThid )
call cal_TimePassed( flddate, mydate, difftime, myThid )
call cal_ToSeconds( difftime, fldsecs, myThid )
C Weight belonging to irec for linear interpolation purposes.
C Note: The weight as chosen here is 1. - fac of the "old"
C MITgcm estimation program.
fac = 1. - fldsecs/fldperiod
C fldperiod .ne. 0.
endif
#else /* not ALLOW_CAL */
C Code, adapted from external_fields_load, for simplied
C default model calendar without exf/cal, but
C based on myTime, myIter, deltaTClock, externForcingCycle, and startTime
myRelTime = myTime - startTime
first = (myRelTime .lt. 0.5*deltaTClock)
if ( xx_genperiod .eq. 0. _d 0
& .or. externForcingCycle .eq. 0. _d 0 ) then
C control parameter is constant in time and only needs to be updated
C once in the beginning
changed = .false.
count0 = 1
count1 = 1
fac = 1. _d 0
else
C-- Now calculate whether it is time to update the forcing arrays
CALL GET_PERIODIC_INTERVAL(
O countP, count0, count1, tmpFac, fac,
I externForcingCycle, xx_genperiod,
I deltaTClock, myTime, myThid )
IF ( count0.NE.countP ) THEN
changed = .true.
ELSE
changed = .false.
ENDIF
IF ( first ) changed = .false.
endif
#endif /* ALLOW_CAL */
#ifdef ECCO_VERBOSE
C Do some printing for the protocol.
_BEGIN_MASTER( myThid )
write(msgbuf,'(a)') ' '
call print_message( msgbuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
write(msgbuf,'(a,2x,l2,2x,l2,2x,D15.8)')
& ' first, changed, fac:',
& first, changed, fac
call print_message( msgbuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
write(msgbuf,'(a,i4,i4)')
& ' count0, count1:',
& count0, count1
call print_message( msgbuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
write(msgbuf,'(a)') ' '
call print_message( msgbuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER( myThid )
#endif
return
end