-
Notifications
You must be signed in to change notification settings - Fork 237
/
bling_fields_load.F
295 lines (267 loc) · 8.97 KB
/
bling_fields_load.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
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
#include "BLING_OPTIONS.h"
#ifdef ALLOW_EXF
# include "EXF_OPTIONS.h"
#endif
CBOP
SUBROUTINE BLING_FIELDS_LOAD (
I myTime, myIter, myThid )
C *========================================================*
C | subroutine bling_fields_load
C | o Read in fields needed for CO2, O2 flux terms, silica
C | for pH calculation
C | o Update fields from EXF package
C *========================================================*
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#ifdef ALLOW_EXF
# include "EXF_PARAM.h"
# include "EXF_INTERP_SIZE.h"
# include "EXF_FIELDS.h"
#endif
#include "BLING_VARS.h"
#include "BLING_LOAD.h"
#ifdef ALLOW_THSICE
# include "THSICE_VARS.h"
#endif
#ifdef ALLOW_SEAICE
# include "SEAICE_SIZE.h"
# include "SEAICE.h"
#endif
C !INPUT PARAMETERS: ===================================================
C myThid :: thread number
C myIter :: current timestep
C myTime :: current time
INTEGER myIter
_RL myTime
INTEGER myThid
#ifdef ALLOW_BLING
C !LOCAL VARIABLES: ===================================================
INTEGER bi, bj, i, j
INTEGER intimeP, intime0, intime1
_RL aWght,bWght
CEOP
IF ( BLING_forcingCycle.gt.0. _d 0 ) THEN
C-- Now calculate whether it is time to update the forcing arrays
CALL GET_PERIODIC_INTERVAL(
O intimeP, intime0, intime1, bWght, aWght,
I BLING_forcingCycle, BLING_forcingPeriod,
I deltaTClock, myTime, myThid )
bi = myBxLo(myThid)
bj = myByLo(myThid)
#ifdef ALLOW_DEBUG
IF ( debugLevel.GE.debLevB ) THEN
_BEGIN_MASTER(myThid)
WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
& ' BLING_FIELDS_LOAD,', myIter,
& ' : iP,iLd,i0,i1=', intimeP,BLING_ldRec(bi,bj), intime0,
& intime1,
& ' ; Wght=', bWght, aWght
_END_MASTER(myThid)
ENDIF
#endif /* ALLOW_DEBUG */
#ifdef ALLOW_AUTODIFF
C- assuming that we call S/R BLING_FIELDS_LOAD at each time-step and
C with increasing time, this will catch when we need to load new records;
C But with Adjoint run, this is not always the case => might end-up using
C the wrong time-records
IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
#else /* ALLOW_AUTODIFF */
C- Make no assumption on sequence of calls to BLING_FIELDS_LOAD ;
C This is the correct formulation (works in Adjoint run).
C Unfortunatly, produces many recomputations <== not used until it is fixed
IF ( intime1.NE.BLING_ldRec(bi,bj) ) THEN
#endif /* ALLOW_AUTODIFF */
C-- If the above condition is met then we need to read in
C data for the period ahead and the period behind myTime.
IF ( debugLevel.GE.debLevZero ) THEN
_BEGIN_MASTER(myThid)
WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
& ' BLING_FIELDS_LOAD, it=', myIter,
& ' : Reading new data, i0,i1=', intime0, intime1,
& ' (prev=', intimeP, BLING_ldRec(bi,bj), ' )'
_END_MASTER(myThid)
ENDIF
_BARRIER
IF ( BLING_windFile .NE. ' ' ) THEN
CALL READ_REC_XY_RS( BLING_windFile,dicwind0,intime0,
& myIter,myThid )
CALL READ_REC_XY_RS( BLING_windFile,dicwind1,intime1,
& myIter,myThid )
ENDIF
IF ( BLING_atmospFile .NE. ' ' ) THEN
CALL READ_REC_XY_RS( BLING_atmospFile,atmosp0,intime0,
& myIter,myThid )
CALL READ_REC_XY_RS( BLING_atmospFile,atmosp1,intime1,
& myIter,myThid )
ENDIF
IF ( BLING_silicaFile .NE. ' ' ) THEN
CALL READ_REC_XY_RS( BLING_silicaFile,silica0,intime0,
& myIter,myThid )
CALL READ_REC_XY_RS( BLING_silicaFile,silica1,intime1,
& myIter,myThid )
ENDIF
IF ( BLING_iceFile .NE. ' ' ) THEN
CALL READ_REC_XY_RS( BLING_iceFile,ice0,intime0,
& myIter,myThid )
CALL READ_REC_XY_RS( BLING_iceFile,ice1,intime1,
& myIter,myThid )
ENDIF
IF ( BLING_ironFile .NE. ' ' ) THEN
CALL READ_REC_XY_RS( BLING_ironFile,feinput0,intime0,
& myIter,myThid )
CALL READ_REC_XY_RS( BLING_ironFile,feinput1,intime1,
& myIter,myThid )
ENDIF
C-- fill-in overlap after loading temp arrays:
_EXCH_XY_RS(dicwind0, myThid )
_EXCH_XY_RS(dicwind1, myThid )
_EXCH_XY_RS(atmosp0, myThid )
_EXCH_XY_RS(atmosp1, myThid )
_EXCH_XY_RS(ice0, myThid )
_EXCH_XY_RS(ice1, myThid )
_EXCH_XY_RS(feinput0, myThid )
_EXCH_XY_RS(feinput1, myThid )
_EXCH_XY_RS(silica0, myThid )
_EXCH_XY_RS(silica1, myThid )
C- save newly loaded time-record
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
BLING_ldRec(bi,bj) = intime1
ENDDO
ENDDO
C- end if-bloc (time to load new fields)
ENDIF
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
IF ( BLING_windFile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
wind(i,j,bi,bj) = bWght*dicwind0(i,j,bi,bj)
& + aWght*dicwind1(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
IF ( BLING_atmospFile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
atmosP(i,j,bi,bj) = bWght*atmosp0(i,j,bi,bj)
& + aWght*atmosp1(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
IF ( BLING_silicaFile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
silica(i,j,bi,bj) = bWght*silica0(i,j,bi,bj)
& + aWght*silica1(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
IF ( BLING_iceFile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
fIce(i,j,bi,bj) = bWght*ice0(i,j,bi,bj)
& + aWght*ice1(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
IF ( BLING_ironFile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
InputFe(i,j,bi,bj) = bWght*feinput0(i,j,bi,bj)
& + aWght*feinput1(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
ENDDO
ENDDO
C endif for BLING_forcingCycle
ENDIF
C-----------------------------------------------------------
C Get ice fraction from PKG/SEAICE or PKG/THSICE
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
#ifdef ALLOW_SEAICE
IF ( useSEAICE ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
fIce(i,j,bi,bj) = AREA(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
#endif
#ifdef ALLOW_THSICE
IF ( useThSIce ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
fIce(i,j,bi,bj) = iceMask(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
#endif
ENDDO
ENDDO
C-----------------------------------------------------------
C Get winds from PKG/EXF
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
#ifdef ALLOW_EXF
IF ( useEXF ) THEN
IF ( uwindfile .NE. ' ' ) THEN
IF ( vwindfile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
wind(i,j,bi,bj) = wspeed(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
ENDIF
ENDIF
#endif
ENDDO
ENDDO
C-----------------------------------------------------------
C Get atmospheric pressure from PKG/EXF
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
#ifdef ALLOW_EXF
IF ( useEXF ) THEN
IF ( apressurefile .NE. ' ' ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
C Atm pressure in Pascals, convert to atm
AtmosP(i,j,bi,bj) = apressure(i,j,bi,bj)/Pa2atm
ENDDO
ENDDO
ENDIF
ENDIF
#endif
ENDDO
ENDDO
C-----------------------------------------------------------
C Get Atmospheric carbon dioxide concentration from PKG/EXF
#ifdef ALLOW_EXF
C Atmospheric carbon dioxide concentration
IF ( useEXF ) THEN
IF ( apco2file .NE. ' ' ) THEN
CALL EXF_SET_FLD(
I 'apco2', apco2file, apco2mask,
I apco2StartTime, apco2period, apco2RepCycle,
I exf_inscal_apco2,
I apco2_exfremo_intercept, apco2_exfremo_slope,
U apco2, apco20, apco21,
# ifdef USE_EXF_INTERPOLATION
I apco2_lon0, apco2_lon_inc, apco2_lat0, apco2_lat_inc,
I apco2_nlon, apco2_nlat, xC, yC, apco2_interpMethod,
# endif
I myTime, myIter, myThid )
ENDIF
ENDIF
#endif
#endif /* ALLOW_BLING */
RETURN
END