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

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

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

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