/[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.2 - (hide annotations) (download)
Wed Sep 29 12:27:09 2004 UTC (19 years, 8 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint55e_post, checkpoint57b_post, checkpoint57f_pre, checkpoint55d_pre, checkpoint57d_post, checkpoint57c_pre, checkpoint55j_post, checkpoint56b_post, checkpoint55h_post, checkpoint57e_post, checkpoint56c_post, checkpoint57a_post, checkpoint55g_post, checkpoint55f_post, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, eckpoint57e_pre, checkpoint57c_post, checkpoint56a_post, checkpoint55d_post
Changes since 1.1: +70 -37 lines
o fixed about 35 bugs

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

  ViewVC Help
Powered by ViewVC 1.1.22