/[MITgcm]/MITgcm/pkg/obcs/obcs_external_fields_load.F
ViewVC logotype

Contents of /MITgcm/pkg/obcs/obcs_external_fields_load.F

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

Revision 1.12 - (show annotations) (download)
Tue Aug 11 15:46:27 2009 UTC (14 years, 10 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint61u
Changes since 1.11: +109 -4 lines 
  - add code to read OB?eta from a file via obcs_prescribe_read: the code
    compiles and does not destroy any other experiments, the data is read
    properly, and the values show up properly in the results, but the
    code is not tested in actual applications, so handle with care
1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.11 2008/09/09 19:58:26 jmc Exp $
2 C $Name: $
3 #include "OBCS_OPTIONS.h"
4
5 CBOP
6 C !ROUTINE: OBCS_EXTERNAL_FIELDS_LOAD
7 C !INTERFACE:
8 SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
9 C !DESCRIPTION: \bv
10 C *==========================================================*
11 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD
12 C | o Control reading of fields from external source.
13 C *==========================================================*
14 C | External source field loading routine for open boundaries.
15 C | This routine is called every time we want to
16 C | load a a set of external open boundary fields.
17 C | Only if there are fields available (file names are not empty)
18 C | the open boundary fields are overwritten.
19 C | The routine decides which fields to load and then reads them in.
20 C | This routine needs to be customised for particular
21 C | experiments.
22 C | Notes
23 C | =====
24 C | Two-dimensional and three-dimensional I/O are handled in
25 C | the following way under MITgcmUV. A master thread
26 C | performs I/O using system calls. This threads reads data
27 C | into a temporary buffer. At present the buffer is loaded
28 C | with the entire model domain. This is probably OK for now
29 C | Each thread then copies data from the buffer to the
30 C | region of the proper array it is responsible for.
31 C | =====
32 C | This routine is the complete analogue to external_fields_load,
33 C | except for exchanges of forcing fields. These are done in
34 C | obcs_precribe_exchanges, which is called from dynamics.
35 C | - Forcing period and cycle are the same as for other fields
36 C | in external forcing.
37 C | - constant boundary values are also read here and not
38 C | directly in obcs_init_variables (which calls obcs_calc
39 C | which in turn calls this routine)
40 C *==========================================================*
41 C \ev
42
43 C !USES:
44 IMPLICIT NONE
45 C === Global variables ===
46 #include "SIZE.h"
47 #include "EEPARAMS.h"
48 #include "PARAMS.h"
49 #include "GRID.h"
50
51 C !INPUT/OUTPUT PARAMETERS:
52 C === Routine arguments ===
53 C myThid - Thread no. that called this routine.
54 C myTime - Simulation time
55 C myIter - Simulation timestep number
56 INTEGER myThid
57 _RL myTime
58 INTEGER myIter
59
60 C if external forcing (exf) package is enabled, all loading of external
61 C fields is done by exf
62 #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE && !defined ALLOW_EXF)
63 C
64 #include "OBCS.h"
65 #ifdef ALLOW_PTRACERS
66 #include "PTRACERS_SIZE.h"
67 #include "OBCS_PTRACERS.h"
68 #include "PTRACERS_PARAMS.h"
69 c#include "PTRACERS_FIELDS.h"
70 #endif /* ALLOW_PTRACERS */
71
72 C !LOCAL VARIABLES:
73 C === Local arrays ===
74 C aWght, bWght :: Interpolation weights
75 C msgBuf :: Informational/error meesage buffer
76 #ifdef NONLIN_FRSURF
77 INTEGER i,j,bi,bj
78 #endif /* NONLIN_FRSURF */
79 INTEGER intime0,intime1,iTracer
80 _RL aWght,bWght,rdt
81 INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
82 CHARACTER*(MAX_LEN_MBUF) msgBuf
83 CEOP
84
85 IF ( periodicExternalForcing ) THEN
86
87 C Now calculate whether it is time to update the forcing arrays
88 rdt = 1. _d 0 / deltaTclock
89 nForcingPeriods = NINT(externForcingCycle/externForcingPeriod)
90 Imytm = NINT(myTime*rdt)
91 Ifprd = NINT(externForcingPeriod*rdt)
92 Ifcyc = NINT(externForcingCycle*rdt)
93 Iftm = MOD( Imytm+Ifcyc-Ifprd/2, Ifcyc)
94
95 intime0 = 1 + INT(Iftm/Ifprd)
96 intime1 = 1 + MOD(intime0,nForcingPeriods)
97 c aWght = DFLOAT( Iftm-Ifprd*(intime0 - 1) ) / DFLOAT( Ifprd )
98 aWght = FLOAT( Iftm-Ifprd*(intime0 - 1) )
99 bWght = FLOAT( Ifprd )
100 aWght = aWght / bWght
101 bWght = 1. _d 0 - aWght
102
103 IF (
104 & Iftm-Ifprd*(intime0-1) .EQ. 0
105 & .OR. myIter .EQ. nIter0
106 & ) THEN
107
108 _BARRIER
109
110 C If the above condition is met then we need to read in
111 C data for the period ahead and the period behind myTime.
112 WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
113 & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
114 & intime0, intime1, myIter, myTime
115 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
116 & SQUEEZE_RIGHT,myThid)
117
118 #ifdef ALLOW_MDSIO
119 #ifdef ALLOW_OBCS_EAST
120 C Eastern boundary
121 IF ( OBEuFile .NE. ' ' ) THEN
122 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
123 & 'RL', Nr, OBEu0, intime0, myThid )
124 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
125 & 'RL', Nr, OBEu1, intime1, myThid )
126 ENDIF
127 IF ( OBEvFile .NE. ' ' ) THEN
128 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
129 & 'RL', Nr, OBEv0, intime0, myThid )
130 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
131 & 'RL', Nr, OBEv1, intime1, myThid )
132 ENDIF
133 IF ( OBEtFile .NE. ' ' ) THEN
134 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
135 & 'RL', Nr, OBEt0, intime0, myThid )
136 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
137 & 'RL', Nr, OBEt1, intime1, myThid )
138 ENDIF
139 IF ( OBEsFile .NE. ' ' ) THEN
140 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
141 & 'RL', Nr, OBEs0, intime0, myThid )
142 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
143 & 'RL', Nr, OBEs1, intime1, myThid )
144 ENDIF
145 # ifdef NONLIN_FRSURF
146 IF ( OBEetaFile .NE. ' ' ) THEN
147 CALL MDSREADFIELDYZ ( OBEetaFile, readBinaryPrec,
148 & 'RL', 1, OBEeta0, intime0, myThid )
149 CALL MDSREADFIELDYZ ( OBEetaFile, readBinaryPrec,
150 & 'RL', 1, OBEeta1, intime1, myThid )
151 ENDIF
152 # endif /* NONLIN_FRSURF */
153 #endif /* ALLOW_OBCS_EAST */
154 #ifdef ALLOW_OBCS_WEST
155 C Western boundary
156 IF ( OBWuFile .NE. ' ' ) THEN
157 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
158 & 'RL', Nr, OBWu0, intime0, myThid )
159 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
160 & 'RL', Nr, OBWu1, intime1, myThid )
161 ENDIF
162 IF ( OBWvFile .NE. ' ' ) THEN
163 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
164 & 'RL', Nr, OBWv0, intime0, myThid )
165 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
166 & 'RL', Nr, OBWv1, intime1, myThid )
167 ENDIF
168 IF ( OBWtFile .NE. ' ' ) THEN
169 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
170 & 'RL', Nr, OBWt0, intime0, myThid )
171 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
172 & 'RL', Nr, OBWt1, intime1, myThid )
173 ENDIF
174 IF ( OBWsFile .NE. ' ' ) THEN
175 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
176 & 'RL', Nr, OBWs0, intime0, myThid )
177 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
178 & 'RL', Nr, OBWs1, intime1, myThid )
179 ENDIF
180 # ifdef NONLIN_FRSURF
181 IF ( OBWetaFile .NE. ' ' ) THEN
182 CALL MDSREADFIELDYZ ( OBWetaFile, readBinaryPrec,
183 & 'RL', 1, OBWeta0, intime0, myThid )
184 CALL MDSREADFIELDYZ ( OBWetaFile, readBinaryPrec,
185 & 'RL', 1, OBWeta1, intime1, myThid )
186 ENDIF
187 # endif /* NONLIN_FRSURF */
188 #endif /* ALLOW_OBCS_WEST */
189 #ifdef ALLOW_OBCS_NORTH
190 C Northern boundary
191 IF ( OBNuFile .NE. ' ' ) THEN
192 CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
193 & 'RL', Nr, OBNu0, intime0, myThid )
194 CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
195 & 'RL', Nr, OBNu1, intime1, myThid )
196 ENDIF
197 IF ( OBNvFile .NE. ' ' ) THEN
198 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
199 & 'RL', Nr, OBNv0, intime0, myThid )
200 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
201 & 'RL', Nr, OBNv1, intime1, myThid )
202 ENDIF
203 IF ( OBNtFile .NE. ' ' ) THEN
204 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
205 & 'RL', Nr, OBNt0, intime0, myThid )
206 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
207 & 'RL', Nr, OBNt1, intime1, myThid )
208 ENDIF
209 IF ( OBNsFile .NE. ' ' ) THEN
210 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
211 & 'RL', Nr, OBNs0, intime0, myThid )
212 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
213 & 'RL', Nr, OBNs1, intime1, myThid )
214 ENDIF
215 # ifdef NONLIN_FRSURF
216 IF ( OBNetaFile .NE. ' ' ) THEN
217 CALL MDSREADFIELDXZ ( OBNetaFile, readBinaryPrec,
218 & 'RL', 1, OBNeta0, intime0, myThid )
219 CALL MDSREADFIELDXZ ( OBNetaFile, readBinaryPrec,
220 & 'RL', 1, OBNeta1, intime1, myThid )
221 ENDIF
222 # endif /* NONLIN_FRSURF */
223 #endif /* ALLOW_OBCS_NORTH */
224 #ifdef ALLOW_OBCS_SOUTH
225 C Southern boundary
226 IF ( OBSuFile .NE. ' ' ) THEN
227 CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
228 & 'RL', Nr, OBSu0, intime0, myThid )
229 CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
230 & 'RL', Nr, OBSu1, intime1, myThid )
231 ENDIF
232 IF ( OBSvFile .NE. ' ' ) THEN
233 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
234 & 'RL', Nr, OBSv0, intime0, myThid )
235 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
236 & 'RL', Nr, OBSv1, intime1, myThid )
237 ENDIF
238 IF ( OBStFile .NE. ' ' ) THEN
239 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
240 & 'RL', Nr, OBSt0, intime0, myThid )
241 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
242 & 'RL', Nr, OBSt1, intime1, myThid )
243 ENDIF
244 IF ( OBSsFile .NE. ' ' ) THEN
245 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
246 & 'RL', Nr, OBSs0, intime0, myThid )
247 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
248 & 'RL', Nr, OBSs1, intime1, myThid )
249 ENDIF
250 # ifdef NONLIN_FRSURF
251 IF ( OBSetaFile .NE. ' ' ) THEN
252 CALL MDSREADFIELDXZ ( OBSetaFile, readBinaryPrec,
253 & 'RL', 1, OBSeta0, intime0, myThid )
254 CALL MDSREADFIELDXZ ( OBSetaFile, readBinaryPrec,
255 & 'RL', 1, OBSeta1, intime1, myThid )
256 ENDIF
257 # endif /* NONLIN_FRSURF */
258 #endif /* ALLOW_OBCS_SOUTH */
259 #ifdef ALLOW_PTRACERS
260 IF (usePTRACERS) THEN
261 C read boundary values for passive tracers
262 DO iTracer = 1, PTRACERS_numInUse
263 # ifdef ALLOW_OBCS_EAST
264 C Eastern boundary
265 IF ( OBEptrFile(iTracer) .NE. ' ' ) THEN
266 CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
267 & 'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
268 & intime0, myThid )
269 CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
270 & 'RL', Nr, OBEptr1(1-Oly,1,1,1,iTracer),
271 & intime1, myThid )
272 ENDIF
273 # endif /* ALLOW_OBCS_WEST */
274 # ifdef ALLOW_OBCS_WEST
275 C Western boundary
276 IF ( OBWptrFile(iTracer) .NE. ' ' ) THEN
277 CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
278 & 'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
279 & intime0, myThid )
280 CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
281 & 'RL', Nr, OBWptr1(1-Oly,1,1,1,iTracer),
282 & intime1, myThid )
283 ENDIF
284 # endif /* ALLOW_OBCS_WEST */
285 # ifdef ALLOW_OBCS_NORTH
286 C Northern boundary
287 IF ( OBNptrFile(iTracer) .NE. ' ' ) THEN
288 CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
289 & 'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
290 & intime0, myThid )
291 CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
292 & 'RL', Nr, OBNptr1(1-Olx,1,1,1,iTracer),
293 & intime1, myThid )
294 ENDIF
295 # endif /* ALLOW_OBCS_NORTH */
296 # ifdef ALLOW_OBCS_SOUTH
297 C Southern boundary
298 IF ( OBSptrFile(iTracer) .NE. ' ' ) THEN
299 CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
300 & 'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
301 & intime0, myThid )
302 CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
303 & 'RL', Nr, OBSptr1(1-Olx,1,1,1,iTracer),
304 & intime1, myThid )
305 ENDIF
306 # endif /* ALLOW_OBCS_SOUTH */
307 C end do iTracer
308 ENDDO
309 C end if (usePTRACERS)
310 ENDIF
311 #endif /* ALLOW_PTRACERS */
312 #else /* ALLOW_MDSIO */
313 STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
314 #endif /* ALLOW_MDSIO */
315
316 C
317 C At this point in external_fields_load the input fields are exchanged.
318 C However, we do not have exchange routines for vertical
319 C slices and they are not planned, either, so the approriate fields
320 C are exchanged after the open boundary conditions have been
321 C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
322 _BARRIER
323
324 C end if time to read new data
325 ENDIF
326
327 C if not periodicForcing
328 ELSE
329 aWght = 0. _d 0
330 bWght = 1. _d 0
331 C read boundary values once and for all
332 IF ( myIter .EQ. nIter0 ) THEN
333 _BARRIER
334 C Read constant boundary conditions only for myIter = nIter0
335 WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
336 & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading initial data:',
337 & myIter, myTime
338 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
339 & SQUEEZE_RIGHT,myThid)
340 inTime0 = 1
341 #ifdef ALLOW_MDSIO
342 #ifdef ALLOW_OBCS_EAST
343 C Eastern boundary
344 IF ( OBEuFile .NE. ' ' ) THEN
345 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
346 & 'RL', Nr, OBEu0, inTime0, myThid )
347 ENDIF
348 IF ( OBEvFile .NE. ' ' ) THEN
349 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
350 & 'RL', Nr, OBEv0, inTime0, myThid )
351 ENDIF
352 IF ( OBEtFile .NE. ' ' ) THEN
353 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
354 & 'RL', Nr, OBEt0, inTime0, myThid )
355 ENDIF
356 IF ( OBEsFile .NE. ' ' ) THEN
357 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
358 & 'RL', Nr, OBEs0, inTime0, myThid )
359 ENDIF
360 # ifdef NONLIN_FRSURF
361 IF ( OBEetaFile .NE. ' ' ) THEN
362 CALL MDSREADFIELDYZ ( OBEetaFile, readBinaryPrec,
363 & 'RL', 1, OBEeta0, intime0, myThid )
364 ENDIF
365 # endif /* NONLIN_FRSURF */
366 #endif /* ALLOW_OBCS_WEST */
367 #ifdef ALLOW_OBCS_WEST
368 C Western boundary
369 IF ( OBWuFile .NE. ' ' ) THEN
370 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
371 & 'RL', Nr, OBWu0, inTime0, myThid )
372 ENDIF
373 IF ( OBWvFile .NE. ' ' ) THEN
374 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
375 & 'RL', Nr, OBWv0, inTime0, myThid )
376 ENDIF
377 IF ( OBWtFile .NE. ' ' ) THEN
378 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
379 & 'RL', Nr, OBWt0, inTime0, myThid )
380 ENDIF
381 IF ( OBWsFile .NE. ' ' ) THEN
382 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
383 & 'RL', Nr, OBWs0, inTime0, myThid )
384 ENDIF
385 # ifdef NONLIN_FRSURF
386 IF ( OBWetaFile .NE. ' ' ) THEN
387 CALL MDSREADFIELDYZ ( OBWetaFile, readBinaryPrec,
388 & 'RL', 1, OBWeta0, intime0, myThid )
389 ENDIF
390 # endif /* NONLIN_FRSURF */
391 #endif /* ALLOW_OBCS_WEST */
392 #ifdef ALLOW_OBCS_NORTH
393 C Northern boundary
394 IF ( OBNuFile .NE. ' ' ) THEN
395 CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
396 & 'RL', Nr, OBNu0, inTime0, myThid )
397 ENDIF
398 IF ( OBNvFile .NE. ' ' ) THEN
399 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
400 & 'RL', Nr, OBNv0, inTime0, myThid )
401 ENDIF
402 IF ( OBNtFile .NE. ' ' ) THEN
403 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
404 & 'RL', Nr, OBNt0, inTime0, myThid )
405 ENDIF
406 IF ( OBNsFile .NE. ' ' ) THEN
407 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
408 & 'RL', Nr, OBNs0, inTime0, myThid )
409 ENDIF
410 # ifdef NONLIN_FRSURF
411 IF ( OBNetaFile .NE. ' ' ) THEN
412 CALL MDSREADFIELDXZ ( OBNetaFile, readBinaryPrec,
413 & 'RL', 1, OBNeta0, intime0, myThid )
414 ENDIF
415 # endif /* NONLIN_FRSURF */
416 #endif /* ALLOW_OBCS_NORTH */
417 #ifdef ALLOW_OBCS_SOUTH
418 C Southern boundary
419 IF ( OBSuFile .NE. ' ' ) THEN
420 CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
421 & 'RL', Nr, OBSu0, inTime0, myThid )
422 ENDIF
423 IF ( OBSvFile .NE. ' ' ) THEN
424 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
425 & 'RL', Nr, OBSv0, inTime0, myThid )
426 ENDIF
427 IF ( OBStFile .NE. ' ' ) THEN
428 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
429 & 'RL', Nr, OBSt0, inTime0, myThid )
430 ENDIF
431 IF ( OBSsFile .NE. ' ' ) THEN
432 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
433 & 'RL', Nr, OBSs0, inTime0, myThid )
434 ENDIF
435 # ifdef NONLIN_FRSURF
436 IF ( OBSetaFile .NE. ' ' ) THEN
437 CALL MDSREADFIELDXZ ( OBSetaFile, readBinaryPrec,
438 & 'RL', 1, OBSeta0, intime0, myThid )
439 ENDIF
440 # endif /* NONLIN_FRSURF */
441 #endif /* ALLOW_OBCS_SOUTH */
442 #ifdef ALLOW_PTRACERS
443 IF (usePTRACERS) THEN
444 C read passive tracer boundary values
445 DO iTracer = 1, PTRACERS_numInUse
446 # ifdef ALLOW_OBCS_EAST
447 C Eastern boundary
448 IF ( OBEptrFile(iTracer) .NE. ' ' ) THEN
449 CALL MDSREADFIELDYZ ( OBEptrFile(iTracer), readBinaryPrec,
450 & 'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
451 & inTime0, myThid )
452 ENDIF
453 # endif /* ALLOW_OBCS_WEST */
454 # ifdef ALLOW_OBCS_WEST
455 C Western boundary
456 IF ( OBWptrFile(iTracer) .NE. ' ' ) THEN
457 CALL MDSREADFIELDYZ ( OBWptrFile(iTracer), readBinaryPrec,
458 & 'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
459 & inTime0, myThid )
460 ENDIF
461 # endif /* ALLOW_OBCS_WEST */
462 # ifdef ALLOW_OBCS_NORTH
463 C Northern boundary
464 IF ( OBNptrFile(iTracer) .NE. ' ' ) THEN
465 CALL MDSREADFIELDXZ ( OBNptrFile(iTracer), readBinaryPrec,
466 & 'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
467 & inTime0, myThid )
468 ENDIF
469 # endif /* ALLOW_OBCS_NORTH */
470 # ifdef ALLOW_OBCS_SOUTH
471 C Southern boundary
472 IF ( OBSptrFile(iTracer) .NE. ' ' ) THEN
473 CALL MDSREADFIELDXZ ( OBSptrFile(iTracer), readBinaryPrec,
474 & 'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
475 & inTime0, myThid )
476 ENDIF
477 # endif /* ALLOW_OBCS_SOUTH */
478 C end do iTracer
479 ENDDO
480 C end if (usePTRACERS)
481 ENDIF
482 #endif /* ALLOW_PTRACERS */
483 #else /* ALLOW_MDSIO */
484 STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
485 #endif /* ALLOW_MDSIO */
486 _BARRIER
487 C endif myIter .EQ. nIter0
488 ENDIF
489 C endif for periodicForcing
490 ENDIF
491
492 C-- Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
493 C-- For periodicForcing, aWght = 0. and bWght = 1. so that the
494 C-- interpolation boilds down to copying the time-independent
495 C-- forcing field OBSu0 to OBSu
496 #ifdef ALLOW_OBCS_EAST
497 IF ( OBEuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
498 & OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
499 IF ( OBEvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
500 & OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
501 IF ( OBEtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
502 & OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
503 IF ( OBEsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
504 & OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
505 # ifdef NONLIN_FRSURF
506 IF ( OBEetaFile .NE. ' ' ) THEN
507 DO bj = myByLo(myThid), myByHi(myThid)
508 DO bi = myBxLo(myThid), myBxHi(myThid)
509 DO j=1-Oly,sNy+Oly
510 OBEeta(j,bi,bj) = bWght*OBEeta0(j,bi,bj)
511 & +aWght*OBEeta1(j,bi,bj)
512 ENDDO
513 ENDDO
514 ENDDO
515 ENDIF
516 # endif /* NONLIN_FRSURF */
517 #endif /* ALLOW_OBCS_EAST */
518 #ifdef ALLOW_OBCS_WEST
519 IF ( OBWuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
520 & OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
521 IF ( OBWvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
522 & OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
523 IF ( OBWtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
524 & OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
525 IF ( OBWsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
526 & OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
527 # ifdef NONLIN_FRSURF
528 IF ( OBWetaFile .NE. ' ' ) THEN
529 DO bj = myByLo(myThid), myByHi(myThid)
530 DO bi = myBxLo(myThid), myBxHi(myThid)
531 DO j=1-Oly,sNy+Oly
532 OBWeta(j,bi,bj) = bWght*OBWeta0(j,bi,bj)
533 & +aWght*OBWeta1(j,bi,bj)
534 ENDDO
535 ENDDO
536 ENDDO
537 ENDIF
538 # endif /* NONLIN_FRSURF */
539 #endif /* ALLOW_OBCS_WEST */
540 #ifdef ALLOW_OBCS_NORTH
541 IF ( OBNuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
542 & OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
543 IF ( OBNvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
544 & OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
545 IF ( OBNtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
546 & OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
547 IF ( OBNsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
548 & OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
549 # ifdef NONLIN_FRSURF
550 IF ( OBNetaFile .NE. ' ' ) THEN
551 DO bj = myByLo(myThid), myByHi(myThid)
552 DO bi = myBxLo(myThid), myBxHi(myThid)
553 DO i=1-Olx,sNx+Olx
554 OBNeta(i,bi,bj) = bWght*OBNeta0(i,bi,bj)
555 & +aWght*OBNeta1(i,bi,bj)
556 ENDDO
557 ENDDO
558 ENDDO
559 ENDIF
560 # endif /* NONLIN_FRSURF */
561 #endif /* ALLOW_OBCS_NORTH */
562 #ifdef ALLOW_OBCS_SOUTH
563 IF ( OBSuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
564 & OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
565 IF ( OBSvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
566 & OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
567 IF ( OBStFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
568 & OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
569 IF ( OBSsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
570 & OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
571 # ifdef NONLIN_FRSURF
572 IF ( OBSetaFile .NE. ' ' ) THEN
573 DO bj = myByLo(myThid), myByHi(myThid)
574 DO bi = myBxLo(myThid), myBxHi(myThid)
575 DO i=1-Olx,sNx+Olx
576 OBSeta(i,bi,bj) = bWght*OBSeta0(i,bi,bj)
577 & +aWght*OBSeta1(i,bi,bj)
578 ENDDO
579 ENDDO
580 ENDDO
581 ENDIF
582 # endif /* NONLIN_FRSURF */
583 #endif /* ALLOW_OBCS_SOUTH */
584 #ifdef ALLOW_PTRACERS
585 IF (usePTRACERS) THEN
586 C "interpolate" passive tracer boundary values
587 DO iTracer = 1, PTRACERS_numInUse
588 # ifdef ALLOW_OBCS_EAST
589 IF ( OBEptrFile(iTracer) .NE. ' ' )
590 & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
591 O OBEptr (1-Oly,1,1,1,iTracer),
592 I OBEptr0(1-Oly,1,1,1,iTracer),
593 I OBEptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
594 # endif /* ALLOW_OBCS_EAST */
595 # ifdef ALLOW_OBCS_WEST
596 IF ( OBWptrFile(iTracer) .NE. ' ' )
597 & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
598 O OBWptr (1-Oly,1,1,1,iTracer),
599 I OBWptr0(1-Oly,1,1,1,iTracer),
600 I OBWptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
601 # endif /* ALLOW_OBCS_WEST */
602 # ifdef ALLOW_OBCS_NORTH
603 IF ( OBNptrFile(iTracer) .NE. ' ' )
604 & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
605 O OBNptr (1-Olx,1,1,1,iTracer),
606 I OBNptr0(1-Olx,1,1,1,iTracer),
607 I OBNptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
608 # endif /* ALLOW_OBCS_NORTH */
609 # ifdef ALLOW_OBCS_SOUTH
610 IF ( OBSptrFile(iTracer) .NE. ' ' )
611 & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
612 O OBSptr (1-Olx,1,1,1,iTracer),
613 I OBSptr0(1-Olx,1,1,1,iTracer),
614 I OBSptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
615 # endif /* ALLOW_OBCS_SOUTH */
616 C end do iTracer
617 ENDDO
618 C end if (usePTRACERS)
619 ENDIF
620 #endif /* ALLOW_PTRACERS */
621
622 RETURN
623 END
624
625 CBOP
626 C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
627 C !INTERFACE:
628 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
629 O fld,
630 I fld0, fld1, aWght, bWght, myThid )
631 C !DESCRIPTION: \bv
632 C *==========================================================*
633 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
634 C | o Interpolate between to records
635 C *==========================================================*
636 C \ev
637
638 C !USES:
639 IMPLICIT NONE
640 C === Global variables ===
641 #include "SIZE.h"
642 #include "EEPARAMS.h"
643 #include "PARAMS.h"
644
645 C !INPUT/OUTPUT PARAMETERS:
646 C === Routine arguments ===
647 C myThid - Thread no. that called this routine.
648 C aWght, bWght :: Interpolation weights
649 INTEGER myThid
650 _RL aWght,bWght
651 _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
652 _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
653 _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
654
655 C !LOCAL VARIABLES:
656 C === Local arrays ===
657 C bi,bj,i,j :: loop counters
658 INTEGER bi,bj,i,k
659 CEOP
660 DO bj = myByLo(myThid), myByHi(myThid)
661 DO bi = myBxLo(myThid), myBxHi(myThid)
662 DO K = 1, Nr
663 DO i=1-Olx,sNx+Olx
664 fld(i,k,bi,bj) = bWght*fld0(i,k,bi,bj)
665 & +aWght*fld1(i,k,bi,bj)
666 ENDDO
667 ENDDO
668 ENDDO
669 ENDDO
670
671 RETURN
672 END
673 CBOP
674 C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
675 C !INTERFACE:
676 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
677 O fld,
678 I fld0, fld1, aWght, bWght, myThid )
679 C !DESCRIPTION: \bv
680 C *==========================================================*
681 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
682 C | o Interpolate between to records
683 C *==========================================================*
684 C \ev
685
686 C !USES:
687 IMPLICIT NONE
688 C === Global variables ===
689 #include "SIZE.h"
690 #include "EEPARAMS.h"
691 #include "PARAMS.h"
692
693 C !INPUT/OUTPUT PARAMETERS:
694 C === Routine arguments ===
695 C myThid - Thread no. that called this routine.
696 C aWght, bWght :: Interpolation weights
697 INTEGER myThid
698 _RL aWght,bWght
699 _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
700 _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
701 _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
702
703 C !LOCAL VARIABLES:
704 C === Local arrays ===
705 C bi,bj,i,j :: loop counters
706 INTEGER bi,bj,j,k
707 CEOP
708 DO bj = myByLo(myThid), myByHi(myThid)
709 DO bi = myBxLo(myThid), myBxHi(myThid)
710 DO K = 1, Nr
711 DO j=1-Oly,sNy+Oly
712 fld(j,k,bi,bj) = bWght*fld0(j,k,bi,bj)
713 & +aWght*fld1(j,k,bi,bj)
714 ENDDO
715 ENDDO
716 ENDDO
717 ENDDO
718
719 #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE AND .NOT. ALLOW_EXF */
720
721 RETURN
722 END
  ViewVC Help
Powered by ViewVC 1.1.22