/[MITgcm]/MITgcm/model/src/external_fields_load.F
ViewVC logotype

Contents of /MITgcm/model/src/external_fields_load.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.40 - (show annotations) (download)
Fri Apr 4 20:56:32 2014 UTC (10 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64w, checkpoint64v, HEAD
Changes since 1.39: +27 -27 lines
- Replace ALLOW_AUTODIFF_TAMC by ALLOW_AUTODIFF (except for tape/storage
  which are specific to TAF/TAMC).

1 C $Header: /u/gcmpack/MITgcm/model/src/external_fields_load.F,v 1.39 2011/06/08 01:21:14 jmc Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: EXTERNAL_FIELDS_LOAD
9 C !INTERFACE:
10 SUBROUTINE EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
11
12 C !DESCRIPTION: \bv
13 C *==========================================================*
14 C | SUBROUTINE EXTERNAL_FIELDS_LOAD
15 C | o Control reading of fields from external source.
16 C *==========================================================*
17 C | External source field loading routine.
18 C | This routine is called every time we want to
19 C | load a a set of external fields. The routine decides
20 C | which fields to load and then reads them in.
21 C | This routine needs to be customised for particular
22 C | experiments.
23 C | Notes
24 C | =====
25 C | Two-dimensional and three-dimensional I/O are handled in
26 C | the following way under MITgcmUV. A master thread
27 C | performs I/O using system calls. This threads reads data
28 C | into a temporary buffer. At present the buffer is loaded
29 C | with the entire model domain. This is probably OK for now
30 C | Each thread then copies data from the buffer to the
31 C | region of the proper array it is responsible for.
32 C | =====
33 C | Conversion of flux fields are described in FFIELDS.h
34 C *==========================================================*
35 C \ev
36
37 C !USES:
38 IMPLICIT NONE
39 C === Global variables ===
40 #include "SIZE.h"
41 #include "EEPARAMS.h"
42 #include "PARAMS.h"
43 #include "FFIELDS.h"
44 #include "GRID.h"
45 #include "DYNVARS.h"
46
47 C !INPUT/OUTPUT PARAMETERS:
48 C === Routine arguments ===
49 C myTime :: Simulation time
50 C myIter :: Simulation timestep number
51 C myThid :: Thread no. that called this routine.
52 _RL myTime
53 INTEGER myIter
54 INTEGER myThid
55
56 #ifndef EXCLUDE_FFIELDS_LOAD
57
58 C !LOCAL VARIABLES:
59 C === Local arrays ===
60 C aWght, bWght :: Interpolation weights
61 INTEGER bi, bj, i, j
62 INTEGER intimeP, intime0, intime1
63 _RL aWght, bWght
64 CEOP
65
66 IF ( periodicExternalForcing ) THEN
67
68 C-- First call requires that we initialize everything to zero for safety
69 cph has been shifted to ini_forcing.F
70
71 C-- Now calculate whether it is time to update the forcing arrays
72 CALL GET_PERIODIC_INTERVAL(
73 O intimeP, intime0, intime1, bWght, aWght,
74 I externForcingCycle, externForcingPeriod,
75 I deltaTClock, myTime, myThid )
76
77 bi = myBxLo(myThid)
78 bj = myByLo(myThid)
79 #ifdef ALLOW_DEBUG
80 IF ( debugLevel.GE.debLevB ) THEN
81 _BEGIN_MASTER(myThid)
82 WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
83 & ' EXTERNAL_FIELDS_LOAD,', myIter,
84 & ' : iP,iLd,i0,i1=', intimeP,loadedRec(bi,bj), intime0,intime1,
85 & ' ; Wght=', bWght, aWght
86 _END_MASTER(myThid)
87 ENDIF
88 #endif /* ALLOW_DEBUG */
89 #ifdef ALLOW_AUTODIFF
90 C- assuming that we call S/R EXTERNAL_FIELDS_LOAD at each time-step and
91 C with increasing time, this will catch when we need to load new records;
92 C But with Adjoint run, this is not always the case => might end-up using
93 C the wrong time-records
94 # ifndef STORE_LOADEDREC_TEST
95 IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
96 # else
97 IF ( intime1.NE.loadedRec(bi,bj) ) THEN
98 # endif
99 #else /* ALLOW_AUTODIFF */
100 C- Make no assumption on sequence of calls to EXTERNAL_FIELDS_LOAD ;
101 C This is the correct formulation (works in Adjoint run).
102 C Unfortunatly, produces many recomputations <== not used until it is fixed
103 IF ( intime1.NE.loadedRec(bi,bj) ) THEN
104 #endif /* ALLOW_AUTODIFF */
105
106 C-- If the above condition is met then we need to read in
107 C data for the period ahead and the period behind myTime.
108 IF ( debugLevel.GE.debLevZero ) THEN
109 _BEGIN_MASTER(myThid)
110 WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
111 & ' EXTERNAL_FIELDS_LOAD, it=', myIter,
112 & ' : Reading new data, i0,i1=', intime0, intime1,
113 & ' (prev=', intimeP, loadedRec(bi,bj), ' )'
114 _END_MASTER(myThid)
115 ENDIF
116
117 IF ( zonalWindFile .NE. ' ' ) THEN
118 CALL READ_REC_XY_RS( zonalWindFile, taux0,
119 & intime0, myIter, myThid )
120 CALL READ_REC_XY_RS( zonalWindFile, taux1,
121 & intime1, myIter, myThid )
122 ENDIF
123 IF ( meridWindFile .NE. ' ' ) THEN
124 CALL READ_REC_XY_RS( meridWindFile, tauy0,
125 & intime0, myIter, myThid )
126 CALL READ_REC_XY_RS( meridWindFile, tauy1,
127 & intime1, myIter, myThid )
128 ENDIF
129 IF ( surfQFile .NE. ' ' ) THEN
130 CALL READ_REC_XY_RS( surfQFile, Qnet0,
131 & intime0, myIter, myThid )
132 CALL READ_REC_XY_RS( surfQFile, Qnet1,
133 & intime1, myIter, myThid )
134 ELSEIF ( surfQnetFile .NE. ' ' ) THEN
135 CALL READ_REC_XY_RS( surfQnetFile, Qnet0,
136 & intime0, myIter, myThid )
137 CALL READ_REC_XY_RS( surfQnetFile, Qnet1,
138 & intime1, myIter, myThid )
139 ENDIF
140 IF ( EmPmRfile .NE. ' ' ) THEN
141 CALL READ_REC_XY_RS( EmPmRfile, EmPmR0,
142 & intime0, myIter, myThid )
143 CALL READ_REC_XY_RS( EmPmRfile, EmPmR1,
144 & intime1, myIter, myThid )
145 c IF ( convertEmP2rUnit.EQ.mass2rUnit ) THEN
146 C- EmPmR is now (after c59h) expressed in kg/m2/s (fresh water mass flux)
147 DO bj = myByLo(myThid), myByHi(myThid)
148 DO bi = myBxLo(myThid), myBxHi(myThid)
149 DO j=1-OLy,sNy+OLy
150 DO i=1-OLx,sNx+OLx
151 EmPmR0(i,j,bi,bj) = EmPmR0(i,j,bi,bj)*rhoConstFresh
152 EmPmR1(i,j,bi,bj) = EmPmR1(i,j,bi,bj)*rhoConstFresh
153 ENDDO
154 ENDDO
155 ENDDO
156 ENDDO
157 c ENDIF
158 ENDIF
159 IF ( saltFluxFile .NE. ' ' ) THEN
160 CALL READ_REC_XY_RS( saltFluxFile, saltFlux0,
161 & intime0, myIter, myThid )
162 CALL READ_REC_XY_RS( saltFluxFile, saltFlux1,
163 & intime1, myIter, myThid )
164 ENDIF
165 IF ( thetaClimFile .NE. ' ' ) THEN
166 CALL READ_REC_XY_RS( thetaClimFile, SST0,
167 & intime0, myIter, myThid )
168 CALL READ_REC_XY_RS( thetaClimFile, SST1,
169 & intime1, myIter, myThid )
170 ENDIF
171 IF ( saltClimFile .NE. ' ' ) THEN
172 CALL READ_REC_XY_RS( saltClimFile, SSS0,
173 & intime0, myIter, myThid )
174 CALL READ_REC_XY_RS( saltClimFile, SSS1,
175 & intime1, myIter, myThid )
176 ENDIF
177 #ifdef SHORTWAVE_HEATING
178 IF ( surfQswFile .NE. ' ' ) THEN
179 CALL READ_REC_XY_RS( surfQswFile, Qsw0,
180 & intime0, myIter, myThid )
181 CALL READ_REC_XY_RS( surfQswFile, Qsw1,
182 & intime1, myIter, myThid )
183 IF ( surfQFile .NE. ' ' ) THEN
184 C- Qnet is now (after c54) the net Heat Flux (including SW)
185 DO bj = myByLo(myThid), myByHi(myThid)
186 DO bi = myBxLo(myThid), myBxHi(myThid)
187 DO j=1-OLy,sNy+OLy
188 DO i=1-OLx,sNx+OLx
189 Qnet0(i,j,bi,bj) = Qnet0(i,j,bi,bj) + Qsw0(i,j,bi,bj)
190 Qnet1(i,j,bi,bj) = Qnet1(i,j,bi,bj) + Qsw1(i,j,bi,bj)
191 ENDDO
192 ENDDO
193 ENDDO
194 ENDDO
195 ENDIF
196 ENDIF
197 #endif
198 #ifdef ATMOSPHERIC_LOADING
199 IF ( pLoadFile .NE. ' ' ) THEN
200 CALL READ_REC_XY_RS( pLoadFile, pLoad0,
201 & intime0, myIter, myThid )
202 CALL READ_REC_XY_RS( pLoadFile, pLoad1,
203 & intime1, myIter, myThid )
204 ENDIF
205 #endif
206
207 C- thread synchronisation (barrier) is part of the EXCH S/R calls
208 _EXCH_XY_RS(SST0 , myThid )
209 _EXCH_XY_RS(SST1 , myThid )
210 _EXCH_XY_RS(SSS0 , myThid )
211 _EXCH_XY_RS(SSS1 , myThid )
212 CALL EXCH_UV_XY_RS(taux0,tauy0,.TRUE.,myThid)
213 CALL EXCH_UV_XY_RS(taux1,tauy1,.TRUE.,myThid)
214 _EXCH_XY_RS(Qnet0, myThid )
215 _EXCH_XY_RS(Qnet1, myThid )
216 _EXCH_XY_RS(EmPmR0, myThid )
217 _EXCH_XY_RS(EmPmR1, myThid )
218 _EXCH_XY_RS(saltFlux0, myThid )
219 _EXCH_XY_RS(saltFlux1, myThid )
220 #ifdef SHORTWAVE_HEATING
221 _EXCH_XY_RS(Qsw0, myThid )
222 _EXCH_XY_RS(Qsw1, myThid )
223 #endif
224 #ifdef ATMOSPHERIC_LOADING
225 _EXCH_XY_RS(pLoad0, myThid )
226 _EXCH_XY_RS(pLoad1, myThid )
227 #endif
228
229 C- save newly loaded time-record
230 DO bj = myByLo(myThid), myByHi(myThid)
231 DO bi = myBxLo(myThid), myBxHi(myThid)
232 loadedRec(bi,bj) = intime1
233 ENDDO
234 ENDDO
235
236 C-- end if-block for loading new time-records
237 ENDIF
238
239 C-- Interpolate fu,fv,Qnet,EmPmR,SST,SSS,Qsw
240 DO bj = myByLo(myThid), myByHi(myThid)
241 DO bi = myBxLo(myThid), myBxHi(myThid)
242 IF ( thetaClimFile .NE. ' ' ) THEN
243 DO j=1-OLy,sNy+OLy
244 DO i=1-OLx,sNx+OLx
245 SST(i,j,bi,bj) = bWght*SST0(i,j,bi,bj)
246 & + aWght*SST1(i,j,bi,bj)
247 ENDDO
248 ENDDO
249 ENDIF
250 IF ( saltClimFile .NE. ' ' ) THEN
251 DO j=1-OLy,sNy+OLy
252 DO i=1-OLx,sNx+OLx
253 SSS(i,j,bi,bj) = bWght*SSS0(i,j,bi,bj)
254 & + aWght*SSS1(i,j,bi,bj)
255 ENDDO
256 ENDDO
257 ENDIF
258 IF ( zonalWindFile .NE. ' ' ) THEN
259 DO j=1-OLy,sNy+OLy
260 DO i=1-OLx,sNx+OLx
261 fu(i,j,bi,bj) = bWght*taux0(i,j,bi,bj)
262 & + aWght*taux1(i,j,bi,bj)
263 ENDDO
264 ENDDO
265 ENDIF
266 IF ( meridWindFile .NE. ' ' ) THEN
267 DO j=1-OLy,sNy+OLy
268 DO i=1-OLx,sNx+OLx
269 fv(i,j,bi,bj) = bWght*tauy0(i,j,bi,bj)
270 & + aWght*tauy1(i,j,bi,bj)
271 ENDDO
272 ENDDO
273 ENDIF
274 IF ( surfQnetFile .NE. ' '
275 & .OR. surfQFile .NE. ' ' ) THEN
276 DO j=1-OLy,sNy+OLy
277 DO i=1-OLx,sNx+OLx
278 Qnet(i,j,bi,bj) = bWght*Qnet0(i,j,bi,bj)
279 & + aWght*Qnet1(i,j,bi,bj)
280 ENDDO
281 ENDDO
282 ENDIF
283 IF ( EmPmRfile .NE. ' ' ) THEN
284 DO j=1-OLy,sNy+OLy
285 DO i=1-OLx,sNx+OLx
286 EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)
287 & + aWght*EmPmR1(i,j,bi,bj)
288 ENDDO
289 ENDDO
290 ENDIF
291 IF ( saltFluxFile .NE. ' ' ) THEN
292 DO j=1-OLy,sNy+OLy
293 DO i=1-OLx,sNx+OLx
294 saltFlux(i,j,bi,bj) = bWght*saltFlux0(i,j,bi,bj)
295 & + aWght*saltFlux1(i,j,bi,bj)
296 ENDDO
297 ENDDO
298 ENDIF
299 #ifdef SHORTWAVE_HEATING
300 IF ( surfQswFile .NE. ' ' ) THEN
301 DO j=1-OLy,sNy+OLy
302 DO i=1-OLx,sNx+OLx
303 Qsw(i,j,bi,bj) = bWght*Qsw0(i,j,bi,bj)
304 & + aWght*Qsw1(i,j,bi,bj)
305 ENDDO
306 ENDDO
307 ENDIF
308 #endif
309 #ifdef ATMOSPHERIC_LOADING
310 IF ( pLoadFile .NE. ' ' ) THEN
311 DO j=1-OLy,sNy+OLy
312 DO i=1-OLx,sNx+OLx
313 pLoad(i,j,bi,bj) = bWght*pLoad0(i,j,bi,bj)
314 & + aWght*pLoad1(i,j,bi,bj)
315 ENDDO
316 ENDDO
317 ENDIF
318 #endif
319 ENDDO
320 ENDDO
321
322 C-- Print for checking:
323 #ifdef ALLOW_DEBUG
324 IF ( debugLevel.GE.debLevC ) THEN
325 _BEGIN_MASTER( myThid )
326 WRITE(standardMessageUnit,'(A,1P4E12.4)')
327 & ' EXTERNAL_FIELDS_LOAD: (fu0,1),fu,fv=',
328 & taux0(1,sNy,1,1), taux1(1,sNy,1,1),
329 & fu(1,sNy,1,1), fv(1,sNy,1,1)
330 WRITE(standardMessageUnit,'(A,1P4E12.4)')
331 & ' EXTERNAL_FIELDS_LOAD: SST,SSS,Q,E-P=',
332 & SST(1,sNy,1,1), SSS(1,sNy,1,1),
333 & Qnet(1,sNy,1,1), EmPmR(1,sNy,1,1)
334 _END_MASTER( myThid )
335 ENDIF
336 #endif /* ALLOW_DEBUG */
337
338 C endif for periodicForcing
339 ENDIF
340
341 #endif /* EXCLUDE_FFIELDS_LOAD */
342
343 RETURN
344 END

  ViewVC Help
Powered by ViewVC 1.1.22