/[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.3 - (hide annotations) (download)
Wed Apr 6 18:43:35 2005 UTC (19 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57f_post, checkpoint57j_post, checkpoint57k_post, checkpoint57g_post, checkpoint57i_post, checkpoint57g_pre, checkpoint57h_post, checkpoint57h_done, checkpoint57h_pre
Changes since 1.2: +1 -3 lines
use baseTime as time origin ; DIFF_BASE_MULTIPLE replaces DIFFERENT_MULTIPLE

1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.2 2004/09/29 12:27:09 mlosch Exp $
2 mlosch 1.1 C $Name: $
3    
4     #include "OBCS_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: OBCS_EXTERNAL_FIELDS_LOAD
8     C !INTERFACE:
9     SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
10     C !DESCRIPTION: \bv
11     C *==========================================================*
12     C | SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD
13     C | o Control reading of fields from external source.
14     C *==========================================================*
15     C | External source field loading routine.
16     C | This routine is called every time we want to
17     C | load a a set of external fields. The routine decides
18     C | which fields to load and then reads them in.
19     C | This routine needs to be customised for particular
20     C | experiments.
21     C | Notes
22     C | =====
23     C | Two-dimensional and three-dimensional I/O are handled in
24     C | the following way under MITgcmUV. A master thread
25     C | performs I/O using system calls. This threads reads data
26     C | into a temporary buffer. At present the buffer is loaded
27     C | with the entire model domain. This is probably OK for now
28     C | Each thread then copies data from the buffer to the
29     C | region of the proper array it is responsible for.
30     C | =====
31     C | This routine is the complete analogue to external_fields_load,
32     C | except for exchanges of forcing fields. These are done in
33     C | obcs_precribe_exchanges, which is called from dynamics.
34     C | - Forcing period and cycle are the same as for other fields
35     C | in external forcing.
36     C | - constant boundary values are also read here and not
37     C | directly in obcs_init_variables (which calls obcs_calc
38     C | which in turn call this routine)
39     C *==========================================================*
40     C \ev
41    
42     C !USES:
43     IMPLICIT NONE
44     C === Global variables ===
45     #include "SIZE.h"
46     #include "EEPARAMS.h"
47     #include "PARAMS.h"
48     #include "GRID.h"
49    
50     C !INPUT/OUTPUT PARAMETERS:
51     C === Routine arguments ===
52     C myThid - Thread no. that called this routine.
53     C myTime - Simulation time
54     C myIter - Simulation timestep number
55     INTEGER myThid
56     _RL myTime
57     INTEGER myIter
58    
59     #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE)
60     C if external forcing (exf) package is enabled, all loading of external
61     C fields is done by exf
62     #ifndef ALLOW_EXF
63     #include "OBCS.h"
64    
65     C !LOCAL VARIABLES:
66     C === Local arrays ===
67     C aWght, bWght :: Interpolation weights
68     INTEGER bi,bj,i,j,k,intime0,intime1
69     _RL aWght,bWght,rdt
70     INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
71     CEOP
72    
73     IF ( periodicExternalForcing ) THEN
74    
75     C Now calculate whether it is time to update the forcing arrays
76     rdt=1. _d 0 / deltaTclock
77     nForcingPeriods=int(externForcingCycle/externForcingPeriod+0.5)
78     Imytm=int(myTime*rdt+0.5)
79     Ifprd=int(externForcingPeriod*rdt+0.5)
80     Ifcyc=int(externForcingCycle*rdt+0.5)
81     Iftm=mod( Imytm+Ifcyc-Ifprd/2 ,Ifcyc)
82    
83     intime0=int(Iftm/Ifprd)
84     intime1=mod(intime0+1,nForcingPeriods)
85     aWght=float( Iftm-Ifprd*intime0 )/float( Ifprd )
86     bWght=1.-aWght
87    
88     intime0=intime0+1
89     intime1=intime1+1
90    
91     IF (
92     & Iftm-Ifprd*(intime0-1) .EQ. 0
93     & .OR. myIter .EQ. nIter0
94     & ) THEN
95    
96     _BEGIN_MASTER(myThid)
97    
98     C If the above condition is met then we need to read in
99     C data for the period ahead and the period behind myTime.
100     WRITE(*,*)
101     & 'S/R OBCS_EXTERNAL_FIELDS_LOAD: Reading new data',myTime,myIter
102    
103 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
104 mlosch 1.1 C Eastern boundary
105     IF ( OBEuFile .NE. ' ' ) THEN
106     CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
107     & 'RL', Nr, OBEu0, intime0, myThid )
108     CALL MDSREADFIELDXz ( OBEuFile, readBinaryPrec,
109     & 'RL', Nr, OBEu1, intime0, myThid )
110     ENDIF
111     IF ( OBEvFile .NE. ' ' ) THEN
112     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
113     & 'RL', Nr, OBEv0, intime0, myThid )
114     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
115     & 'RL', Nr, OBEv1, intime0, myThid )
116     ENDIF
117 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
118 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
119     & 'RL', Nr, OBEt0, intime0, myThid )
120     CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
121     & 'RL', Nr, OBEt1, intime0, myThid )
122     ENDIF
123 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
124 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
125     & 'RL', Nr, OBEs0, intime0, myThid )
126     CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
127     & 'RL', Nr, OBEs1, intime0, myThid )
128     ENDIF
129     #endif /* ALLOW_OBCS_WEST */
130     #ifdef ALLOW_OBCS_WEST
131     C Western boundary
132     IF ( OBWuFile .NE. ' ' ) THEN
133     CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
134     & 'RL', Nr, OBWu0, intime0, myThid )
135     CALL MDSREADFIELDXz ( OBWuFile, readBinaryPrec,
136     & 'RL', Nr, OBWu1, intime0, myThid )
137     ENDIF
138     IF ( OBWvFile .NE. ' ' ) THEN
139     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
140     & 'RL', Nr, OBWv0, intime0, myThid )
141     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
142     & 'RL', Nr, OBWv1, intime0, myThid )
143     ENDIF
144 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
145 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
146     & 'RL', Nr, OBWt0, intime0, myThid )
147     CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
148     & 'RL', Nr, OBWt1, intime0, myThid )
149     ENDIF
150 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
151 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
152     & 'RL', Nr, OBWs0, intime0, myThid )
153     CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
154     & 'RL', Nr, OBWs1, intime0, myThid )
155     ENDIF
156     #endif /* ALLOW_OBCS_WEST */
157     #ifdef ALLOW_OBCS_NORTH
158     C Northern boundary
159     IF ( OBNuFile .NE. ' ' ) THEN
160     CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
161     & 'RL', Nr, OBNu0, intime0, myThid )
162     CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
163     & 'RL', Nr, OBNu1, intime0, myThid )
164     ENDIF
165     IF ( OBNvFile .NE. ' ' ) THEN
166     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
167     & 'RL', Nr, OBNv0, intime0, myThid )
168     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
169     & 'RL', Nr, OBNv1, intime0, myThid )
170     ENDIF
171 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
172 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
173     & 'RL', Nr, OBNt0, intime0, myThid )
174     CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
175     & 'RL', Nr, OBNt1, intime0, myThid )
176     ENDIF
177 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
178 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
179     & 'RL', Nr, OBNs0, intime0, myThid )
180     CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
181     & 'RL', Nr, OBNs1, intime0, myThid )
182     ENDIF
183     #endif /* ALLOW_OBCS_NORTH */
184     #ifdef ALLOW_OBCS_SOUTH
185     C Southern boundary
186     IF ( OBSuFile .NE. ' ' ) THEN
187     CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
188     & 'RL', Nr, OBSu0, intime0, myThid )
189     CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
190     & 'RL', Nr, OBSu1, intime0, myThid )
191     ENDIF
192     IF ( OBSvFile .NE. ' ' ) THEN
193     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
194     & 'RL', Nr, OBSv0, intime0, myThid )
195     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
196     & 'RL', Nr, OBSv1, intime0, myThid )
197     ENDIF
198 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
199 mlosch 1.1 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
200     & 'RL', Nr, OBSt0, intime0, myThid )
201     CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
202     & 'RL', Nr, OBSt1, intime0, myThid )
203     ENDIF
204 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
205 mlosch 1.1 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
206     & 'RL', Nr, OBSs0, intime0, myThid )
207     CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
208     & 'RL', Nr, OBSs1, intime0, myThid )
209     ENDIF
210     #endif /* ALLOW_OBCS_SOUTH */
211     _END_MASTER(myThid)
212     C
213     C At this point in external_fields_load the input fields are exchanged.
214     C However, we do not have exchange routines for vertical
215     C slices and they are not planned, either, so the approriate fields
216     C are exchanged after the open boundary conditions have been
217     C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
218     C
219     ENDIF
220    
221     C-- Interpolate OBSu, OBSv, OBSt, OBSs
222     DO bj = myByLo(myThid), myByHi(myThid)
223     DO bi = myBxLo(myThid), myBxHi(myThid)
224     DO K = 1, Nr
225     DO j=1-Oly,sNy+Oly
226     #ifdef ALLOW_OBCS_EAST
227     OBEu(j,k,bi,bj) = bWght*OBEu0(j,k,bi,bj)
228     & +aWght*OBEu1(j,k,bi,bj)
229     OBEv(j,k,bi,bj) = bWght*OBEv0(j,k,bi,bj)
230     & +aWght*OBEv1(j,k,bi,bj)
231     OBEt(j,k,bi,bj) = bWght*OBEt0(j,k,bi,bj)
232     & +aWght*OBEt1(j,k,bi,bj)
233     OBEs(j,k,bi,bj) = bWght*OBEs0(j,k,bi,bj)
234     & +aWght*OBEs1(j,k,bi,bj)
235     #endif /* ALLOW_OBCS_EAST */
236     #ifdef ALLOW_OBCS_WEST
237     OBWu(j,k,bi,bj) = bWght*OBWu0(j,k,bi,bj)
238     & +aWght*OBWu1(j,k,bi,bj)
239     OBWv(j,k,bi,bj) = bWght*OBWv0(j,k,bi,bj)
240     & +aWght*OBWv1(j,k,bi,bj)
241     OBWt(j,k,bi,bj) = bWght*OBWt0(j,k,bi,bj)
242     & +aWght*OBWt1(j,k,bi,bj)
243     OBWs(j,k,bi,bj) = bWght*OBWs0(j,k,bi,bj)
244     & +aWght*OBWs1(j,k,bi,bj)
245     #endif /* ALLOW_OBCS_WEST */
246     ENDDO
247     DO i=1-Olx,sNx+Olx
248     #ifdef ALLOW_OBCS_NORTH
249     OBNu(i,k,bi,bj) = bWght*OBNu0(i,k,bi,bj)
250     & +aWght*OBNu1(i,k,bi,bj)
251     OBNv(i,k,bi,bj) = bWght*OBNv0(i,k,bi,bj)
252     & +aWght*OBNv1(i,k,bi,bj)
253     OBNt(i,k,bi,bj) = bWght*OBNt0(i,k,bi,bj)
254     & +aWght*OBNt1(i,k,bi,bj)
255     OBNs(i,k,bi,bj) = bWght*OBNs0(i,k,bi,bj)
256     & +aWght*OBNs1(i,k,bi,bj)
257     #endif /* ALLOW_OBCS_NORTH */
258     #ifdef ALLOW_OBCS_SOUTH
259     OBSu(i,k,bi,bj) = bWght*OBSu0(i,k,bi,bj)
260     & +aWght*OBSu1(i,k,bi,bj)
261     OBSv(i,k,bi,bj) = bWght*OBSv0(i,k,bi,bj)
262     & +aWght*OBSv1(i,k,bi,bj)
263     OBSt(i,k,bi,bj) = bWght*OBSt0(i,k,bi,bj)
264     & +aWght*OBSt1(i,k,bi,bj)
265     OBSs(i,k,bi,bj) = bWght*OBSs0(i,k,bi,bj)
266     & +aWght*OBSs1(i,k,bi,bj)
267     #endif /* ALLOW_OBCS_SOUTH */
268     ENDDO
269     ENDDO
270     ENDDO
271     ENDDO
272     C if not periodicForcing
273     ELSE
274     C read boundary values once and for all
275     IF ( myIter .EQ. nIter0 ) THEN
276     _BEGIN_MASTER(myThid)
277 mlosch 1.2 C Read constant boundary conditions only for myIter = nIter0
278 mlosch 1.1 WRITE(*,*)
279     & 'S/R OBCS_EXTERNAl_FIELDS_LOAD: Reading new data',myTime,myIter
280     inTime0 = 1
281 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
282 mlosch 1.1 C Eastern boundary
283     IF ( OBEuFile .NE. ' ' ) THEN
284     CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
285 mlosch 1.2 & 'RL', Nr, OBEu0, inTime0, myThid )
286 mlosch 1.1 ENDIF
287     IF ( OBEvFile .NE. ' ' ) THEN
288     CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
289 mlosch 1.2 & 'RL', Nr, OBEv0, inTime0, myThid )
290 mlosch 1.1 ENDIF
291 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
292 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
293 mlosch 1.2 & 'RL', Nr, OBEt0, inTime0, myThid )
294 mlosch 1.1 ENDIF
295 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
296 mlosch 1.1 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
297 mlosch 1.2 & 'RL', Nr, OBEs0, inTime0, myThid )
298 mlosch 1.1 ENDIF
299     #endif /* ALLOW_OBCS_WEST */
300     #ifdef ALLOW_OBCS_WEST
301     C Western boundary
302     IF ( OBWuFile .NE. ' ' ) THEN
303     CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
304 mlosch 1.2 & 'RL', Nr, OBWu0, inTime0, myThid )
305 mlosch 1.1 ENDIF
306     IF ( OBWvFile .NE. ' ' ) THEN
307     CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
308 mlosch 1.2 & 'RL', Nr, OBWv0, inTime0, myThid )
309 mlosch 1.1 ENDIF
310 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
311 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
312 mlosch 1.2 & 'RL', Nr, OBWt0, inTime0, myThid )
313 mlosch 1.1 ENDIF
314 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
315 mlosch 1.1 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
316 mlosch 1.2 & 'RL', Nr, OBWs0, inTime0, myThid )
317 mlosch 1.1 ENDIF
318     #endif /* ALLOW_OBCS_WEST */
319     #ifdef ALLOW_OBCS_NORTH
320     C Northern boundary
321     IF ( OBNuFile .NE. ' ' ) THEN
322     CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
323 mlosch 1.2 & 'RL', Nr, OBNu0, inTime0, myThid )
324 mlosch 1.1 ENDIF
325     IF ( OBNvFile .NE. ' ' ) THEN
326     CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
327 mlosch 1.2 & 'RL', Nr, OBNv0, inTime0, myThid )
328 mlosch 1.1 ENDIF
329 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
330 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
331 mlosch 1.2 & 'RL', Nr, OBNt0, inTime0, myThid )
332 mlosch 1.1 ENDIF
333 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
334 mlosch 1.1 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
335 mlosch 1.2 & 'RL', Nr, OBNs0, inTime0, myThid )
336 mlosch 1.1 ENDIF
337     #endif /* ALLOW_OBCS_NORTH */
338     #ifdef ALLOW_OBCS_SOUTH
339     C Southern boundary
340     IF ( OBSuFile .NE. ' ' ) THEN
341     CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
342 mlosch 1.2 & 'RL', Nr, OBSu0, inTime0, myThid )
343 mlosch 1.1 ENDIF
344     IF ( OBSvFile .NE. ' ' ) THEN
345     CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
346 mlosch 1.2 & 'RL', Nr, OBSv0, inTime0, myThid )
347 mlosch 1.1 ENDIF
348 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
349 mlosch 1.1 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
350 mlosch 1.2 & 'RL', Nr, OBSt0, inTime0, myThid )
351 mlosch 1.1 ENDIF
352 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
353 mlosch 1.1 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
354 mlosch 1.2 & 'RL', Nr, OBSs0, inTime0, myThid )
355 mlosch 1.1 ENDIF
356     #endif /* ALLOW_OBCS_SOUTH */
357     _END_MASTER(myThid)
358     C endif myIter .EQ. nIter0
359     ENDIF
360 mlosch 1.2 DO bj = myByLo(myThid), myByHi(myThid)
361     DO bi = myBxLo(myThid), myBxHi(myThid)
362     DO K = 1, Nr
363     DO j=1-Oly,sNy+Oly
364     #ifdef ALLOW_OBCS_EAST
365     OBEu(j,k,bi,bj) = OBEu0(j,k,bi,bj)
366     OBEv(j,k,bi,bj) = OBEv0(j,k,bi,bj)
367     OBEt(j,k,bi,bj) = OBEt0(j,k,bi,bj)
368     OBEs(j,k,bi,bj) = OBEs0(j,k,bi,bj)
369     #endif /* ALLOW_OBCS_EAST */
370     #ifdef ALLOW_OBCS_WEST
371     OBWu(j,k,bi,bj) = OBWu0(j,k,bi,bj)
372     OBWv(j,k,bi,bj) = OBWv0(j,k,bi,bj)
373     OBWt(j,k,bi,bj) = OBWt0(j,k,bi,bj)
374     OBWs(j,k,bi,bj) = OBWs0(j,k,bi,bj)
375     #endif /* ALLOW_OBCS_WEST */
376     ENDDO
377     DO i=1-Olx,sNx+Olx
378     #ifdef ALLOW_OBCS_NORTH
379     OBNu(i,k,bi,bj) = OBNu0(i,k,bi,bj)
380     OBNv(i,k,bi,bj) = OBNv0(i,k,bi,bj)
381     OBNt(i,k,bi,bj) = OBNt0(i,k,bi,bj)
382     OBNs(i,k,bi,bj) = OBNs0(i,k,bi,bj)
383     #endif /* ALLOW_OBCS_NORTH */
384     #ifdef ALLOW_OBCS_SOUTH
385     OBSu(i,k,bi,bj) = OBSu0(i,k,bi,bj)
386     OBSv(i,k,bi,bj) = OBSv0(i,k,bi,bj)
387     OBSt(i,k,bi,bj) = OBSt0(i,k,bi,bj)
388     OBSs(i,k,bi,bj) = OBSs0(i,k,bi,bj)
389     #endif /* ALLOW_OBCS_SOUTH */
390     ENDDO
391     ENDDO
392     ENDDO
393     ENDDO
394 mlosch 1.1 C endif for periodicForcing
395     ENDIF
396    
397     #endif /* ALLOW_EXF */
398     #endif /* ALLOw_OBCS AND ALLOW_OBCS_PRESCRIBE */
399    
400     RETURN
401     END
402    

  ViewVC Help
Powered by ViewVC 1.1.22