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