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

Annotation 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 - (hide 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 mlosch 1.12 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.11 2008/09/09 19:58:26 jmc Exp $
2 mlosch 1.1 C $Name: $
3     #include "OBCS_OPTIONS.h"
4 jmc 1.8
5 mlosch 1.1 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 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD
12     C | o Control reading of fields from external source.
13 mlosch 1.1 C *==========================================================*
14 mlosch 1.5 C | External source field loading routine for open boundaries.
15 jmc 1.8 C | This routine is called every time we want to
16     C | load a a set of external open boundary fields.
17 mlosch 1.5 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 jmc 1.8 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 mlosch 1.1 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 jmc 1.8 C | directly in obcs_init_variables (which calls obcs_calc
39 mlosch 1.5 C | which in turn calls this routine)
40 mlosch 1.1 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 jmc 1.8
51 mlosch 1.1 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 jmc 1.8
60 mlosch 1.1 C if external forcing (exf) package is enabled, all loading of external
61     C fields is done by exf
62 mlosch 1.5 #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE && !defined ALLOW_EXF)
63     C
64 mlosch 1.1 #include "OBCS.h"
65 jmc 1.8 #ifdef ALLOW_PTRACERS
66 mlosch 1.5 #include "PTRACERS_SIZE.h"
67     #include "OBCS_PTRACERS.h"
68 jmc 1.9 #include "PTRACERS_PARAMS.h"
69     c#include "PTRACERS_FIELDS.h"
70 mlosch 1.5 #endif /* ALLOW_PTRACERS */
71 mlosch 1.1
72     C !LOCAL VARIABLES:
73     C === Local arrays ===
74     C aWght, bWght :: Interpolation weights
75 mlosch 1.5 C msgBuf :: Informational/error meesage buffer
76 mlosch 1.12 #ifdef NONLIN_FRSURF
77     INTEGER i,j,bi,bj
78     #endif /* NONLIN_FRSURF */
79 mlosch 1.5 INTEGER intime0,intime1,iTracer
80 mlosch 1.1 _RL aWght,bWght,rdt
81     INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
82 mlosch 1.5 CHARACTER*(MAX_LEN_MBUF) msgBuf
83 mlosch 1.1 CEOP
84    
85     IF ( periodicExternalForcing ) THEN
86    
87     C Now calculate whether it is time to update the forcing arrays
88 jmc 1.10 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 mlosch 1.1
103     IF (
104     & Iftm-Ifprd*(intime0-1) .EQ. 0
105     & .OR. myIter .EQ. nIter0
106     & ) THEN
107    
108 jmc 1.7 _BARRIER
109 mlosch 1.1
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 mlosch 1.5 WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
113     & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
114 mlosch 1.4 & intime0, intime1, myIter, myTime
115 mlosch 1.5 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
116     & SQUEEZE_RIGHT,myThid)
117 mlosch 1.1
118 jmc 1.8 #ifdef ALLOW_MDSIO
119 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
120 mlosch 1.1 C Eastern boundary
121     IF ( OBEuFile .NE. ' ' ) THEN
122     CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
123     & 'RL', Nr, OBEu0, intime0, myThid )
124 mlosch 1.5 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
125 mlosch 1.4 & 'RL', Nr, OBEu1, intime1, myThid )
126 mlosch 1.1 ENDIF
127     IF ( OBEvFile .NE. ' ' ) THEN
128     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
129     & 'RL', Nr, OBEv0, intime0, myThid )
130     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
131 mlosch 1.4 & 'RL', Nr, OBEv1, intime1, myThid )
132 mlosch 1.1 ENDIF
133 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
134 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
135     & 'RL', Nr, OBEt0, intime0, myThid )
136     CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
137 mlosch 1.4 & 'RL', Nr, OBEt1, intime1, myThid )
138 mlosch 1.1 ENDIF
139 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
140 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
141     & 'RL', Nr, OBEs0, intime0, myThid )
142     CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
143 mlosch 1.4 & 'RL', Nr, OBEs1, intime1, myThid )
144 mlosch 1.1 ENDIF
145 mlosch 1.12 # 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 mlosch 1.1 #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 mlosch 1.5 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
160 mlosch 1.4 & 'RL', Nr, OBWu1, intime1, myThid )
161 mlosch 1.1 ENDIF
162     IF ( OBWvFile .NE. ' ' ) THEN
163     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
164     & 'RL', Nr, OBWv0, intime0, myThid )
165     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
166 mlosch 1.4 & 'RL', Nr, OBWv1, intime1, myThid )
167 mlosch 1.1 ENDIF
168 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
169 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
170     & 'RL', Nr, OBWt0, intime0, myThid )
171     CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
172 mlosch 1.4 & 'RL', Nr, OBWt1, intime1, myThid )
173 mlosch 1.1 ENDIF
174 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
175 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
176     & 'RL', Nr, OBWs0, intime0, myThid )
177     CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
178 mlosch 1.4 & 'RL', Nr, OBWs1, intime1, myThid )
179 mlosch 1.1 ENDIF
180 mlosch 1.12 # 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 mlosch 1.1 #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 mlosch 1.5 CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
195 mlosch 1.4 & 'RL', Nr, OBNu1, intime1, myThid )
196 mlosch 1.1 ENDIF
197     IF ( OBNvFile .NE. ' ' ) THEN
198     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
199     & 'RL', Nr, OBNv0, intime0, myThid )
200     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
201 mlosch 1.4 & 'RL', Nr, OBNv1, intime1, myThid )
202 mlosch 1.1 ENDIF
203 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
204 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
205     & 'RL', Nr, OBNt0, intime0, myThid )
206     CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
207 mlosch 1.4 & 'RL', Nr, OBNt1, intime1, myThid )
208 mlosch 1.1 ENDIF
209 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
210 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
211     & 'RL', Nr, OBNs0, intime0, myThid )
212     CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
213 mlosch 1.4 & 'RL', Nr, OBNs1, intime1, myThid )
214 mlosch 1.1 ENDIF
215 mlosch 1.12 # 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 mlosch 1.1 #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 mlosch 1.5 CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
230 mlosch 1.4 & 'RL', Nr, OBSu1, intime1, myThid )
231 mlosch 1.1 ENDIF
232     IF ( OBSvFile .NE. ' ' ) THEN
233     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
234     & 'RL', Nr, OBSv0, intime0, myThid )
235     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
236 mlosch 1.4 & 'RL', Nr, OBSv1, intime1, myThid )
237 mlosch 1.1 ENDIF
238 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
239 mlosch 1.1 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
240     & 'RL', Nr, OBSt0, intime0, myThid )
241     CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
242 mlosch 1.4 & 'RL', Nr, OBSt1, intime1, myThid )
243 mlosch 1.1 ENDIF
244 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
245 mlosch 1.1 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
246     & 'RL', Nr, OBSs0, intime0, myThid )
247     CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
248 mlosch 1.4 & 'RL', Nr, OBSs1, intime1, myThid )
249 mlosch 1.1 ENDIF
250 mlosch 1.12 # 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 mlosch 1.1 #endif /* ALLOW_OBCS_SOUTH */
259 mlosch 1.5 #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 jmc 1.8 & 'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
268 mlosch 1.5 & intime0, myThid )
269     CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
270 jmc 1.8 & 'RL', Nr, OBEptr1(1-Oly,1,1,1,iTracer),
271 mlosch 1.5 & 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 jmc 1.8 & 'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
279 mlosch 1.5 & intime0, myThid )
280     CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
281 jmc 1.8 & 'RL', Nr, OBWptr1(1-Oly,1,1,1,iTracer),
282 mlosch 1.5 & 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 jmc 1.8 & 'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
290 mlosch 1.5 & intime0, myThid )
291     CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
292 jmc 1.8 & 'RL', Nr, OBNptr1(1-Olx,1,1,1,iTracer),
293 mlosch 1.5 & 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 jmc 1.8 & 'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
301 mlosch 1.5 & intime0, myThid )
302     CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
303 jmc 1.8 & 'RL', Nr, OBSptr1(1-Olx,1,1,1,iTracer),
304 mlosch 1.5 & 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 jmc 1.8 #else /* ALLOW_MDSIO */
313     STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
314     #endif /* ALLOW_MDSIO */
315    
316 mlosch 1.1 C
317     C At this point in external_fields_load the input fields are exchanged.
318 jmc 1.8 C However, we do not have exchange routines for vertical
319 mlosch 1.1 C slices and they are not planned, either, so the approriate fields
320 jmc 1.8 C are exchanged after the open boundary conditions have been
321 mlosch 1.1 C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
322 jmc 1.7 _BARRIER
323    
324     C end if time to read new data
325 mlosch 1.1 ENDIF
326    
327     C if not periodicForcing
328     ELSE
329 mlosch 1.5 aWght = 0. _d 0
330     bWght = 1. _d 0
331 mlosch 1.1 C read boundary values once and for all
332     IF ( myIter .EQ. nIter0 ) THEN
333 jmc 1.7 _BARRIER
334 mlosch 1.2 C Read constant boundary conditions only for myIter = nIter0
335 mlosch 1.5 WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
336 jmc 1.7 & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading initial data:',
337 mlosch 1.5 & myIter, myTime
338     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
339     & SQUEEZE_RIGHT,myThid)
340     inTime0 = 1
341 jmc 1.8 #ifdef ALLOW_MDSIO
342 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
343 mlosch 1.1 C Eastern boundary
344     IF ( OBEuFile .NE. ' ' ) THEN
345     CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
346 mlosch 1.2 & 'RL', Nr, OBEu0, inTime0, myThid )
347 mlosch 1.1 ENDIF
348     IF ( OBEvFile .NE. ' ' ) THEN
349     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
350 mlosch 1.2 & 'RL', Nr, OBEv0, inTime0, myThid )
351 mlosch 1.1 ENDIF
352 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
353 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
354 mlosch 1.2 & 'RL', Nr, OBEt0, inTime0, myThid )
355 mlosch 1.1 ENDIF
356 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
357 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
358 mlosch 1.2 & 'RL', Nr, OBEs0, inTime0, myThid )
359 mlosch 1.1 ENDIF
360 mlosch 1.12 # 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 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
367     #ifdef ALLOW_OBCS_WEST
368     C Western boundary
369     IF ( OBWuFile .NE. ' ' ) THEN
370     CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
371 mlosch 1.2 & 'RL', Nr, OBWu0, inTime0, myThid )
372 mlosch 1.1 ENDIF
373     IF ( OBWvFile .NE. ' ' ) THEN
374     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
375 mlosch 1.2 & 'RL', Nr, OBWv0, inTime0, myThid )
376 mlosch 1.1 ENDIF
377 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
378 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
379 mlosch 1.2 & 'RL', Nr, OBWt0, inTime0, myThid )
380 mlosch 1.1 ENDIF
381 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
382 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
383 mlosch 1.2 & 'RL', Nr, OBWs0, inTime0, myThid )
384 mlosch 1.1 ENDIF
385 mlosch 1.12 # 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 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
392     #ifdef ALLOW_OBCS_NORTH
393     C Northern boundary
394     IF ( OBNuFile .NE. ' ' ) THEN
395     CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
396 mlosch 1.2 & 'RL', Nr, OBNu0, inTime0, myThid )
397 mlosch 1.1 ENDIF
398     IF ( OBNvFile .NE. ' ' ) THEN
399     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
400 mlosch 1.2 & 'RL', Nr, OBNv0, inTime0, myThid )
401 mlosch 1.1 ENDIF
402 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
403 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
404 mlosch 1.2 & 'RL', Nr, OBNt0, inTime0, myThid )
405 mlosch 1.1 ENDIF
406 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
407 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
408 mlosch 1.2 & 'RL', Nr, OBNs0, inTime0, myThid )
409 mlosch 1.1 ENDIF
410 mlosch 1.12 # 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 mlosch 1.1 #endif /* ALLOW_OBCS_NORTH */
417     #ifdef ALLOW_OBCS_SOUTH
418     C Southern boundary
419     IF ( OBSuFile .NE. ' ' ) THEN
420     CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
421 mlosch 1.2 & 'RL', Nr, OBSu0, inTime0, myThid )
422 mlosch 1.1 ENDIF
423     IF ( OBSvFile .NE. ' ' ) THEN
424     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
425 mlosch 1.2 & 'RL', Nr, OBSv0, inTime0, myThid )
426 mlosch 1.1 ENDIF
427 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
428 mlosch 1.1 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
429 mlosch 1.2 & 'RL', Nr, OBSt0, inTime0, myThid )
430 mlosch 1.1 ENDIF
431 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
432 mlosch 1.1 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
433 mlosch 1.2 & 'RL', Nr, OBSs0, inTime0, myThid )
434 mlosch 1.1 ENDIF
435 mlosch 1.12 # 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 mlosch 1.1 #endif /* ALLOW_OBCS_SOUTH */
442 mlosch 1.5 #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 jmc 1.8 #else /* ALLOW_MDSIO */
484     STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
485     #endif /* ALLOW_MDSIO */
486 jmc 1.7 _BARRIER
487 mlosch 1.1 C endif myIter .EQ. nIter0
488     ENDIF
489 mlosch 1.5 C endif for periodicForcing
490     ENDIF
491    
492     C-- Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
493 jmc 1.8 C-- For periodicForcing, aWght = 0. and bWght = 1. so that the
494     C-- interpolation boilds down to copying the time-independent
495 mlosch 1.5 C-- forcing field OBSu0 to OBSu
496 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
497 jmc 1.8 IF ( OBEuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
498 mlosch 1.5 & OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
499 jmc 1.8 IF ( OBEvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
500 mlosch 1.5 & OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
501     IF ( OBEtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
502     & OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
503 jmc 1.8 IF ( OBEsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
504 mlosch 1.5 & OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
505 mlosch 1.12 # 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 mlosch 1.2 #endif /* ALLOW_OBCS_EAST */
518     #ifdef ALLOW_OBCS_WEST
519 jmc 1.8 IF ( OBWuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
520 mlosch 1.5 & OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
521 jmc 1.8 IF ( OBWvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
522 mlosch 1.5 & OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
523     IF ( OBWtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
524     & OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
525 jmc 1.8 IF ( OBWsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
526 mlosch 1.5 & OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
527 mlosch 1.12 # 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 mlosch 1.2 #endif /* ALLOW_OBCS_WEST */
540     #ifdef ALLOW_OBCS_NORTH
541 jmc 1.8 IF ( OBNuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
542 mlosch 1.5 & OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
543 jmc 1.8 IF ( OBNvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
544 mlosch 1.5 & OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
545     IF ( OBNtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
546     & OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
547 jmc 1.8 IF ( OBNsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
548 mlosch 1.5 & OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
549 mlosch 1.12 # 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 mlosch 1.2 #endif /* ALLOW_OBCS_NORTH */
562     #ifdef ALLOW_OBCS_SOUTH
563 jmc 1.8 IF ( OBSuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
564 mlosch 1.5 & OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
565 jmc 1.8 IF ( OBSvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
566 mlosch 1.5 & OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
567     IF ( OBStFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
568     & OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
569 jmc 1.8 IF ( OBSsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
570 mlosch 1.5 & OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
571 mlosch 1.12 # 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 mlosch 1.2 #endif /* ALLOW_OBCS_SOUTH */
584 mlosch 1.5 #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 jmc 1.8 & 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 mlosch 1.6 I OBEptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
594 mlosch 1.5 # endif /* ALLOW_OBCS_EAST */
595     # ifdef ALLOW_OBCS_WEST
596     IF ( OBWptrFile(iTracer) .NE. ' ' )
597 jmc 1.8 & 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 mlosch 1.5 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 jmc 1.8 & 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 mlosch 1.5 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 jmc 1.8 & 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 mlosch 1.5 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 jmc 1.8 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
629     O fld,
630 mlosch 1.5 I fld0, fld1, aWght, bWght, myThid )
631     C !DESCRIPTION: \bv
632     C *==========================================================*
633 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
634 mlosch 1.5 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 jmc 1.8
645 mlosch 1.5 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 jmc 1.8 fld(i,k,bi,bj) = bWght*fld0(i,k,bi,bj)
665 mlosch 1.5 & +aWght*fld1(i,k,bi,bj)
666 mlosch 1.2 ENDDO
667     ENDDO
668     ENDDO
669 jmc 1.7 ENDDO
670 mlosch 1.1
671     RETURN
672     END
673 mlosch 1.5 CBOP
674     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
675     C !INTERFACE:
676 jmc 1.8 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
677     O fld,
678 mlosch 1.5 I fld0, fld1, aWght, bWght, myThid )
679     C !DESCRIPTION: \bv
680     C *==========================================================*
681 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
682 mlosch 1.5 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 jmc 1.8
693 mlosch 1.5 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 jmc 1.8 fld(j,k,bi,bj) = bWght*fld0(j,k,bi,bj)
713 mlosch 1.5 & +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 mlosch 1.1
721 mlosch 1.5 RETURN
722     END
  ViewVC Help
Powered by ViewVC 1.1.22