/[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.6 - (hide annotations) (download)
Wed Dec 14 16:42:08 2005 UTC (18 years, 6 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58b_post, checkpoint58m_post, checkpoint58g_post, checkpoint58h_post, checkpoint58j_post, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58a_post, checkpoint58i_post, checkpoint57z_post, checkpoint58k_post
Changes since 1.5: +4 -4 lines
o fix bug (eastern obc were overwritten with western values in the
case of constant obcs)

1 mlosch 1.6 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.5 2005/10/10 05:53:48 mlosch Exp $
2 mlosch 1.1 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 mlosch 1.5 C | External source field loading routine for open boundaries.
15 mlosch 1.1 C | This routine is called every time we want to
16 mlosch 1.5 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 mlosch 1.1 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 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    
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 mlosch 1.5 #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE && !defined ALLOW_EXF)
63     C
64 mlosch 1.1 #include "OBCS.h"
65 mlosch 1.5 #ifdef ALLOW_PTRACERS.h
66     #include "PTRACERS_SIZE.h"
67     #include "OBCS_PTRACERS.h"
68     #include "PTRACERS.h"
69     #endif /* ALLOW_PTRACERS */
70 mlosch 1.1
71     C !LOCAL VARIABLES:
72     C === Local arrays ===
73     C aWght, bWght :: Interpolation weights
74 mlosch 1.5 C msgBuf :: Informational/error meesage buffer
75     INTEGER intime0,intime1,iTracer
76 mlosch 1.1 _RL aWght,bWght,rdt
77     INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
78 mlosch 1.5 CHARACTER*(MAX_LEN_MBUF) msgBuf
79 mlosch 1.1 CEOP
80    
81     IF ( periodicExternalForcing ) THEN
82    
83     C Now calculate whether it is time to update the forcing arrays
84     rdt=1. _d 0 / deltaTclock
85     nForcingPeriods=int(externForcingCycle/externForcingPeriod+0.5)
86     Imytm=int(myTime*rdt+0.5)
87     Ifprd=int(externForcingPeriod*rdt+0.5)
88     Ifcyc=int(externForcingCycle*rdt+0.5)
89     Iftm=mod( Imytm+Ifcyc-Ifprd/2 ,Ifcyc)
90    
91     intime0=int(Iftm/Ifprd)
92     intime1=mod(intime0+1,nForcingPeriods)
93     aWght=float( Iftm-Ifprd*intime0 )/float( Ifprd )
94     bWght=1.-aWght
95    
96     intime0=intime0+1
97     intime1=intime1+1
98    
99     IF (
100     & Iftm-Ifprd*(intime0-1) .EQ. 0
101     & .OR. myIter .EQ. nIter0
102     & ) THEN
103    
104     _BEGIN_MASTER(myThid)
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 mlosch 1.5 WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
109     & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
110 mlosch 1.4 & intime0, intime1, myIter, myTime
111 mlosch 1.5 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
112     & SQUEEZE_RIGHT,myThid)
113 mlosch 1.1
114 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
115 mlosch 1.1 C Eastern boundary
116     IF ( OBEuFile .NE. ' ' ) THEN
117     CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
118     & 'RL', Nr, OBEu0, intime0, myThid )
119 mlosch 1.5 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
120 mlosch 1.4 & 'RL', Nr, OBEu1, intime1, myThid )
121 mlosch 1.1 ENDIF
122     IF ( OBEvFile .NE. ' ' ) THEN
123     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
124     & 'RL', Nr, OBEv0, intime0, myThid )
125     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
126 mlosch 1.4 & 'RL', Nr, OBEv1, intime1, myThid )
127 mlosch 1.1 ENDIF
128 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
129 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
130     & 'RL', Nr, OBEt0, intime0, myThid )
131     CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
132 mlosch 1.4 & 'RL', Nr, OBEt1, intime1, myThid )
133 mlosch 1.1 ENDIF
134 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
135 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
136     & 'RL', Nr, OBEs0, intime0, myThid )
137     CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
138 mlosch 1.4 & 'RL', Nr, OBEs1, intime1, myThid )
139 mlosch 1.1 ENDIF
140     #endif /* ALLOW_OBCS_WEST */
141     #ifdef ALLOW_OBCS_WEST
142     C Western boundary
143     IF ( OBWuFile .NE. ' ' ) THEN
144     CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
145     & 'RL', Nr, OBWu0, intime0, myThid )
146 mlosch 1.5 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
147 mlosch 1.4 & 'RL', Nr, OBWu1, intime1, myThid )
148 mlosch 1.1 ENDIF
149     IF ( OBWvFile .NE. ' ' ) THEN
150     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
151     & 'RL', Nr, OBWv0, intime0, myThid )
152     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
153 mlosch 1.4 & 'RL', Nr, OBWv1, intime1, myThid )
154 mlosch 1.1 ENDIF
155 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
156 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
157     & 'RL', Nr, OBWt0, intime0, myThid )
158     CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
159 mlosch 1.4 & 'RL', Nr, OBWt1, intime1, myThid )
160 mlosch 1.1 ENDIF
161 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
162 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
163     & 'RL', Nr, OBWs0, intime0, myThid )
164     CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
165 mlosch 1.4 & 'RL', Nr, OBWs1, intime1, myThid )
166 mlosch 1.1 ENDIF
167     #endif /* ALLOW_OBCS_WEST */
168     #ifdef ALLOW_OBCS_NORTH
169     C Northern boundary
170     IF ( OBNuFile .NE. ' ' ) THEN
171     CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
172     & 'RL', Nr, OBNu0, intime0, myThid )
173 mlosch 1.5 CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
174 mlosch 1.4 & 'RL', Nr, OBNu1, intime1, myThid )
175 mlosch 1.1 ENDIF
176     IF ( OBNvFile .NE. ' ' ) THEN
177     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
178     & 'RL', Nr, OBNv0, intime0, myThid )
179     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
180 mlosch 1.4 & 'RL', Nr, OBNv1, intime1, myThid )
181 mlosch 1.1 ENDIF
182 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
183 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
184     & 'RL', Nr, OBNt0, intime0, myThid )
185     CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
186 mlosch 1.4 & 'RL', Nr, OBNt1, intime1, myThid )
187 mlosch 1.1 ENDIF
188 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
189 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
190     & 'RL', Nr, OBNs0, intime0, myThid )
191     CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
192 mlosch 1.4 & 'RL', Nr, OBNs1, intime1, myThid )
193 mlosch 1.1 ENDIF
194     #endif /* ALLOW_OBCS_NORTH */
195     #ifdef ALLOW_OBCS_SOUTH
196     C Southern boundary
197     IF ( OBSuFile .NE. ' ' ) THEN
198     CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
199     & 'RL', Nr, OBSu0, intime0, myThid )
200 mlosch 1.5 CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
201 mlosch 1.4 & 'RL', Nr, OBSu1, intime1, myThid )
202 mlosch 1.1 ENDIF
203     IF ( OBSvFile .NE. ' ' ) THEN
204     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
205     & 'RL', Nr, OBSv0, intime0, myThid )
206     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
207 mlosch 1.4 & 'RL', Nr, OBSv1, intime1, myThid )
208 mlosch 1.1 ENDIF
209 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
210 mlosch 1.1 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
211     & 'RL', Nr, OBSt0, intime0, myThid )
212     CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
213 mlosch 1.4 & 'RL', Nr, OBSt1, intime1, myThid )
214 mlosch 1.1 ENDIF
215 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
216 mlosch 1.1 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
217     & 'RL', Nr, OBSs0, intime0, myThid )
218     CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
219 mlosch 1.4 & 'RL', Nr, OBSs1, intime1, myThid )
220 mlosch 1.1 ENDIF
221     #endif /* ALLOW_OBCS_SOUTH */
222 mlosch 1.5 #ifdef ALLOW_PTRACERS
223     IF (usePTRACERS) THEN
224     C read boundary values for passive tracers
225     DO iTracer = 1, PTRACERS_numInUse
226     # ifdef ALLOW_OBCS_EAST
227     C Eastern boundary
228     IF ( OBEptrFile(iTracer) .NE. ' ' ) THEN
229     CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
230     & 'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
231     & intime0, myThid )
232     CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
233     & 'RL', Nr, OBEptr1(1-Oly,1,1,1,iTracer),
234     & intime1, myThid )
235     ENDIF
236     # endif /* ALLOW_OBCS_WEST */
237     # ifdef ALLOW_OBCS_WEST
238     C Western boundary
239     IF ( OBWptrFile(iTracer) .NE. ' ' ) THEN
240     CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
241     & 'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
242     & intime0, myThid )
243     CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
244     & 'RL', Nr, OBWptr1(1-Oly,1,1,1,iTracer),
245     & intime1, myThid )
246     ENDIF
247     # endif /* ALLOW_OBCS_WEST */
248     # ifdef ALLOW_OBCS_NORTH
249     C Northern boundary
250     IF ( OBNptrFile(iTracer) .NE. ' ' ) THEN
251     CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
252     & 'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
253     & intime0, myThid )
254     CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
255     & 'RL', Nr, OBNptr1(1-Olx,1,1,1,iTracer),
256     & intime1, myThid )
257     ENDIF
258     # endif /* ALLOW_OBCS_NORTH */
259     # ifdef ALLOW_OBCS_SOUTH
260     C Southern boundary
261     IF ( OBSptrFile(iTracer) .NE. ' ' ) THEN
262     CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
263     & 'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
264     & intime0, myThid )
265     CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
266     & 'RL', Nr, OBSptr1(1-Olx,1,1,1,iTracer),
267     & intime1, myThid )
268     ENDIF
269     # endif /* ALLOW_OBCS_SOUTH */
270     C end do iTracer
271     ENDDO
272     C end if (usePTRACERS)
273     ENDIF
274     #endif /* ALLOW_PTRACERS */
275 mlosch 1.1 _END_MASTER(myThid)
276     C
277     C At this point in external_fields_load the input fields are exchanged.
278     C However, we do not have exchange routines for vertical
279     C slices and they are not planned, either, so the approriate fields
280     C are exchanged after the open boundary conditions have been
281     C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
282     C
283 mlosch 1.5 C time to read new data?
284 mlosch 1.1 ENDIF
285    
286     C if not periodicForcing
287     ELSE
288 mlosch 1.5 aWght = 0. _d 0
289     bWght = 1. _d 0
290 mlosch 1.1 C read boundary values once and for all
291     IF ( myIter .EQ. nIter0 ) THEN
292     _BEGIN_MASTER(myThid)
293 mlosch 1.2 C Read constant boundary conditions only for myIter = nIter0
294 mlosch 1.5 WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
295     & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
296     & myIter, myTime
297     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
298     & SQUEEZE_RIGHT,myThid)
299     inTime0 = 1
300 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
301 mlosch 1.1 C Eastern boundary
302     IF ( OBEuFile .NE. ' ' ) THEN
303     CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
304 mlosch 1.2 & 'RL', Nr, OBEu0, inTime0, myThid )
305 mlosch 1.1 ENDIF
306     IF ( OBEvFile .NE. ' ' ) THEN
307     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
308 mlosch 1.2 & 'RL', Nr, OBEv0, inTime0, myThid )
309 mlosch 1.1 ENDIF
310 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
311 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
312 mlosch 1.2 & 'RL', Nr, OBEt0, inTime0, myThid )
313 mlosch 1.1 ENDIF
314 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
315 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
316 mlosch 1.2 & 'RL', Nr, OBEs0, inTime0, myThid )
317 mlosch 1.1 ENDIF
318     #endif /* ALLOW_OBCS_WEST */
319     #ifdef ALLOW_OBCS_WEST
320     C Western boundary
321     IF ( OBWuFile .NE. ' ' ) THEN
322     CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
323 mlosch 1.2 & 'RL', Nr, OBWu0, inTime0, myThid )
324 mlosch 1.1 ENDIF
325     IF ( OBWvFile .NE. ' ' ) THEN
326     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
327 mlosch 1.2 & 'RL', Nr, OBWv0, inTime0, myThid )
328 mlosch 1.1 ENDIF
329 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
330 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
331 mlosch 1.2 & 'RL', Nr, OBWt0, inTime0, myThid )
332 mlosch 1.1 ENDIF
333 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
334 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
335 mlosch 1.2 & 'RL', Nr, OBWs0, inTime0, myThid )
336 mlosch 1.1 ENDIF
337     #endif /* ALLOW_OBCS_WEST */
338     #ifdef ALLOW_OBCS_NORTH
339     C Northern boundary
340     IF ( OBNuFile .NE. ' ' ) THEN
341     CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
342 mlosch 1.2 & 'RL', Nr, OBNu0, inTime0, myThid )
343 mlosch 1.1 ENDIF
344     IF ( OBNvFile .NE. ' ' ) THEN
345     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
346 mlosch 1.2 & 'RL', Nr, OBNv0, inTime0, myThid )
347 mlosch 1.1 ENDIF
348 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
349 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
350 mlosch 1.2 & 'RL', Nr, OBNt0, inTime0, myThid )
351 mlosch 1.1 ENDIF
352 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
353 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
354 mlosch 1.2 & 'RL', Nr, OBNs0, inTime0, myThid )
355 mlosch 1.1 ENDIF
356     #endif /* ALLOW_OBCS_NORTH */
357     #ifdef ALLOW_OBCS_SOUTH
358     C Southern boundary
359     IF ( OBSuFile .NE. ' ' ) THEN
360     CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
361 mlosch 1.2 & 'RL', Nr, OBSu0, inTime0, myThid )
362 mlosch 1.1 ENDIF
363     IF ( OBSvFile .NE. ' ' ) THEN
364     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
365 mlosch 1.2 & 'RL', Nr, OBSv0, inTime0, myThid )
366 mlosch 1.1 ENDIF
367 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
368 mlosch 1.1 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
369 mlosch 1.2 & 'RL', Nr, OBSt0, inTime0, myThid )
370 mlosch 1.1 ENDIF
371 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
372 mlosch 1.1 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
373 mlosch 1.2 & 'RL', Nr, OBSs0, inTime0, myThid )
374 mlosch 1.1 ENDIF
375     #endif /* ALLOW_OBCS_SOUTH */
376 mlosch 1.5 #ifdef ALLOW_PTRACERS
377     IF (usePTRACERS) THEN
378     C read passive tracer boundary values
379     DO iTracer = 1, PTRACERS_numInUse
380     # ifdef ALLOW_OBCS_EAST
381     C Eastern boundary
382     IF ( OBEptrFile(iTracer) .NE. ' ' ) THEN
383     CALL MDSREADFIELDYZ ( OBEptrFile(iTracer), readBinaryPrec,
384     & 'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
385     & inTime0, myThid )
386     ENDIF
387     # endif /* ALLOW_OBCS_WEST */
388     # ifdef ALLOW_OBCS_WEST
389     C Western boundary
390     IF ( OBWptrFile(iTracer) .NE. ' ' ) THEN
391     CALL MDSREADFIELDYZ ( OBWptrFile(iTracer), readBinaryPrec,
392     & 'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
393     & inTime0, myThid )
394     ENDIF
395     # endif /* ALLOW_OBCS_WEST */
396     # ifdef ALLOW_OBCS_NORTH
397     C Northern boundary
398     IF ( OBNptrFile(iTracer) .NE. ' ' ) THEN
399     CALL MDSREADFIELDXZ ( OBNptrFile(iTracer), readBinaryPrec,
400     & 'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
401     & inTime0, myThid )
402     ENDIF
403     # endif /* ALLOW_OBCS_NORTH */
404     # ifdef ALLOW_OBCS_SOUTH
405     C Southern boundary
406     IF ( OBSptrFile(iTracer) .NE. ' ' ) THEN
407     CALL MDSREADFIELDXZ ( OBSptrFile(iTracer), readBinaryPrec,
408     & 'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
409     & inTime0, myThid )
410     ENDIF
411     # endif /* ALLOW_OBCS_SOUTH */
412     C end do iTracer
413     ENDDO
414     C end if (usePTRACERS)
415     ENDIF
416     #endif /* ALLOW_PTRACERS */
417 mlosch 1.1 _END_MASTER(myThid)
418     C endif myIter .EQ. nIter0
419     ENDIF
420 mlosch 1.5 C endif for periodicForcing
421     ENDIF
422    
423     C-- Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
424     C-- For periodicForcing, aWght = 0. and bWght = 1. so that the
425     C-- interpolation boilds down to copying the time-independent
426     C-- forcing field OBSu0 to OBSu
427 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
428 mlosch 1.5 IF ( OBEuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
429     & OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
430     IF ( OBEvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
431     & OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
432     IF ( OBEtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
433     & OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
434     IF ( OBEsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
435     & OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
436 mlosch 1.2 #endif /* ALLOW_OBCS_EAST */
437     #ifdef ALLOW_OBCS_WEST
438 mlosch 1.5 IF ( OBWuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
439     & OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
440     IF ( OBWvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
441     & OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
442     IF ( OBWtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
443     & OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
444     IF ( OBWsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
445     & OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
446 mlosch 1.2 #endif /* ALLOW_OBCS_WEST */
447     #ifdef ALLOW_OBCS_NORTH
448 mlosch 1.5 IF ( OBNuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
449     & OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
450     IF ( OBNvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
451     & OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
452     IF ( OBNtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
453     & OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
454     IF ( OBNsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
455     & OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
456 mlosch 1.2 #endif /* ALLOW_OBCS_NORTH */
457     #ifdef ALLOW_OBCS_SOUTH
458 mlosch 1.5 IF ( OBSuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
459     & OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
460     IF ( OBSvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
461     & OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
462     IF ( OBStFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
463     & OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
464     IF ( OBSsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
465     & OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
466 mlosch 1.2 #endif /* ALLOW_OBCS_SOUTH */
467 mlosch 1.5 #ifdef ALLOW_PTRACERS
468     IF (usePTRACERS) THEN
469     C "interpolate" passive tracer boundary values
470     DO iTracer = 1, PTRACERS_numInUse
471     # ifdef ALLOW_OBCS_EAST
472     IF ( OBEptrFile(iTracer) .NE. ' ' )
473     & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
474 mlosch 1.6 O OBEptr (1-Oly,1,1,1,iTracer),
475     I OBEptr0(1-Oly,1,1,1,iTracer),
476     I OBEptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
477 mlosch 1.5 # endif /* ALLOW_OBCS_EAST */
478     # ifdef ALLOW_OBCS_WEST
479     IF ( OBWptrFile(iTracer) .NE. ' ' )
480     & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
481     O OBWptr (1-Oly,1,1,1,iTracer),
482     I OBWptr0(1-Oly,1,1,1,iTracer),
483     I OBWptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
484     # endif /* ALLOW_OBCS_WEST */
485     # ifdef ALLOW_OBCS_NORTH
486     IF ( OBNptrFile(iTracer) .NE. ' ' )
487     & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
488     O OBNptr (1-Olx,1,1,1,iTracer),
489     I OBNptr0(1-Olx,1,1,1,iTracer),
490     I OBNptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
491     # endif /* ALLOW_OBCS_NORTH */
492     # ifdef ALLOW_OBCS_SOUTH
493     IF ( OBSptrFile(iTracer) .NE. ' ' )
494     & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
495     O OBSptr (1-Olx,1,1,1,iTracer),
496     I OBSptr0(1-Olx,1,1,1,iTracer),
497     I OBSptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
498     # endif /* ALLOW_OBCS_SOUTH */
499     C end do iTracer
500     ENDDO
501     C end if (usePTRACERS)
502     ENDIF
503     #endif /* ALLOW_PTRACERS */
504     CMLC endif for periodicForcing
505     CML ENDIF
506    
507     RETURN
508     END
509    
510     CBOP
511     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
512     C !INTERFACE:
513     SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
514     O fld,
515     I fld0, fld1, aWght, bWght, myThid )
516     C !DESCRIPTION: \bv
517     C *==========================================================*
518     C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
519     C | o Interpolate between to records
520     C *==========================================================*
521     C \ev
522    
523     C !USES:
524     IMPLICIT NONE
525     C === Global variables ===
526     #include "SIZE.h"
527     #include "EEPARAMS.h"
528     #include "PARAMS.h"
529    
530     C !INPUT/OUTPUT PARAMETERS:
531     C === Routine arguments ===
532     C myThid - Thread no. that called this routine.
533     C aWght, bWght :: Interpolation weights
534     INTEGER myThid
535     _RL aWght,bWght
536     _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
537     _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
538     _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
539    
540     C !LOCAL VARIABLES:
541     C === Local arrays ===
542     C bi,bj,i,j :: loop counters
543     INTEGER bi,bj,i,k
544     CEOP
545     DO bj = myByLo(myThid), myByHi(myThid)
546     DO bi = myBxLo(myThid), myBxHi(myThid)
547     DO K = 1, Nr
548     DO i=1-Olx,sNx+Olx
549     fld(i,k,bi,bj) = bWght*fld0(i,k,bi,bj)
550     & +aWght*fld1(i,k,bi,bj)
551 mlosch 1.2 ENDDO
552     ENDDO
553     ENDDO
554     ENDDO
555 mlosch 1.1
556     RETURN
557     END
558 mlosch 1.5 CBOP
559     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
560     C !INTERFACE:
561     SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
562     O fld,
563     I fld0, fld1, aWght, bWght, myThid )
564     C !DESCRIPTION: \bv
565     C *==========================================================*
566     C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
567     C | o Interpolate between to records
568     C *==========================================================*
569     C \ev
570    
571     C !USES:
572     IMPLICIT NONE
573     C === Global variables ===
574     #include "SIZE.h"
575     #include "EEPARAMS.h"
576     #include "PARAMS.h"
577    
578     C !INPUT/OUTPUT PARAMETERS:
579     C === Routine arguments ===
580     C myThid - Thread no. that called this routine.
581     C aWght, bWght :: Interpolation weights
582     INTEGER myThid
583     _RL aWght,bWght
584     _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
585     _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
586     _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
587    
588     C !LOCAL VARIABLES:
589     C === Local arrays ===
590     C bi,bj,i,j :: loop counters
591     INTEGER bi,bj,j,k
592     CEOP
593     DO bj = myByLo(myThid), myByHi(myThid)
594     DO bi = myBxLo(myThid), myBxHi(myThid)
595     DO K = 1, Nr
596     DO j=1-Oly,sNy+Oly
597     fld(j,k,bi,bj) = bWght*fld0(j,k,bi,bj)
598     & +aWght*fld1(j,k,bi,bj)
599     ENDDO
600     ENDDO
601     ENDDO
602     ENDDO
603    
604     #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE AND .NOT. ALLOW_EXF */
605 mlosch 1.1
606 mlosch 1.5 RETURN
607     END

  ViewVC Help
Powered by ViewVC 1.1.22