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

Contents of /MITgcm/pkg/obcs/obcs_external_fields_load.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4 - (show annotations) (download)
Wed Jul 6 08:22:00 2005 UTC (18 years, 11 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint57o_post, checkpoint57m_post, checkpoint57s_post, checkpoint57r_post, checkpoint57n_post, checkpoint57p_post, checkpoint57q_post, checkpoint57l_post
Changes since 1.3: +20 -19 lines
o fixed another bug (16 times), intime0 -> intime1 where appropriate.

1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.3 2005/04/06 18:43:35 jmc Exp $
2 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(standardMessageUnit,'(A,2I5,I10,1P1E20.12)')
101 & 'S/R OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
102 & intime0, intime1, myIter, myTime
103
104 #ifdef ALLOW_OBCS_EAST
105 C Eastern boundary
106 IF ( OBEuFile .NE. ' ' ) THEN
107 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
108 & 'RL', Nr, OBEu0, intime0, myThid )
109 CALL MDSREADFIELDXz ( OBEuFile, readBinaryPrec,
110 & 'RL', Nr, OBEu1, intime1, myThid )
111 ENDIF
112 IF ( OBEvFile .NE. ' ' ) THEN
113 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
114 & 'RL', Nr, OBEv0, intime0, myThid )
115 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
116 & 'RL', Nr, OBEv1, intime1, myThid )
117 ENDIF
118 IF ( OBEtFile .NE. ' ' ) THEN
119 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
120 & 'RL', Nr, OBEt0, intime0, myThid )
121 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
122 & 'RL', Nr, OBEt1, intime1, myThid )
123 ENDIF
124 IF ( OBEsFile .NE. ' ' ) THEN
125 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
126 & 'RL', Nr, OBEs0, intime0, myThid )
127 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
128 & 'RL', Nr, OBEs1, intime1, myThid )
129 ENDIF
130 #endif /* ALLOW_OBCS_WEST */
131 #ifdef ALLOW_OBCS_WEST
132 C Western boundary
133 IF ( OBWuFile .NE. ' ' ) THEN
134 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
135 & 'RL', Nr, OBWu0, intime0, myThid )
136 CALL MDSREADFIELDXz ( OBWuFile, readBinaryPrec,
137 & 'RL', Nr, OBWu1, intime1, myThid )
138 ENDIF
139 IF ( OBWvFile .NE. ' ' ) THEN
140 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
141 & 'RL', Nr, OBWv0, intime0, myThid )
142 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
143 & 'RL', Nr, OBWv1, intime1, myThid )
144 ENDIF
145 IF ( OBWtFile .NE. ' ' ) THEN
146 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
147 & 'RL', Nr, OBWt0, intime0, myThid )
148 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
149 & 'RL', Nr, OBWt1, intime1, myThid )
150 ENDIF
151 IF ( OBWsFile .NE. ' ' ) THEN
152 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
153 & 'RL', Nr, OBWs0, intime0, myThid )
154 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
155 & 'RL', Nr, OBWs1, intime1, myThid )
156 ENDIF
157 #endif /* ALLOW_OBCS_WEST */
158 #ifdef ALLOW_OBCS_NORTH
159 C Northern boundary
160 IF ( OBNuFile .NE. ' ' ) THEN
161 CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
162 & 'RL', Nr, OBNu0, intime0, myThid )
163 CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
164 & 'RL', Nr, OBNu1, intime1, myThid )
165 ENDIF
166 IF ( OBNvFile .NE. ' ' ) THEN
167 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
168 & 'RL', Nr, OBNv0, intime0, myThid )
169 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
170 & 'RL', Nr, OBNv1, intime1, myThid )
171 ENDIF
172 IF ( OBNtFile .NE. ' ' ) THEN
173 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
174 & 'RL', Nr, OBNt0, intime0, myThid )
175 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
176 & 'RL', Nr, OBNt1, intime1, myThid )
177 ENDIF
178 IF ( OBNsFile .NE. ' ' ) THEN
179 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
180 & 'RL', Nr, OBNs0, intime0, myThid )
181 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
182 & 'RL', Nr, OBNs1, intime1, myThid )
183 ENDIF
184 #endif /* ALLOW_OBCS_NORTH */
185 #ifdef ALLOW_OBCS_SOUTH
186 C Southern boundary
187 IF ( OBSuFile .NE. ' ' ) THEN
188 CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
189 & 'RL', Nr, OBSu0, intime0, myThid )
190 CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
191 & 'RL', Nr, OBSu1, intime1, myThid )
192 ENDIF
193 IF ( OBSvFile .NE. ' ' ) THEN
194 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
195 & 'RL', Nr, OBSv0, intime0, myThid )
196 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
197 & 'RL', Nr, OBSv1, intime1, myThid )
198 ENDIF
199 IF ( OBStFile .NE. ' ' ) THEN
200 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
201 & 'RL', Nr, OBSt0, intime0, myThid )
202 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
203 & 'RL', Nr, OBSt1, intime1, myThid )
204 ENDIF
205 IF ( OBSsFile .NE. ' ' ) THEN
206 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
207 & 'RL', Nr, OBSs0, intime0, myThid )
208 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
209 & 'RL', Nr, OBSs1, intime1, myThid )
210 ENDIF
211 #endif /* ALLOW_OBCS_SOUTH */
212 _END_MASTER(myThid)
213 C
214 C At this point in external_fields_load the input fields are exchanged.
215 C However, we do not have exchange routines for vertical
216 C slices and they are not planned, either, so the approriate fields
217 C are exchanged after the open boundary conditions have been
218 C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
219 C
220 ENDIF
221
222 C-- Interpolate OBSu, OBSv, OBSt, OBSs
223 DO bj = myByLo(myThid), myByHi(myThid)
224 DO bi = myBxLo(myThid), myBxHi(myThid)
225 DO K = 1, Nr
226 DO j=1-Oly,sNy+Oly
227 #ifdef ALLOW_OBCS_EAST
228 OBEu(j,k,bi,bj) = bWght*OBEu0(j,k,bi,bj)
229 & +aWght*OBEu1(j,k,bi,bj)
230 OBEv(j,k,bi,bj) = bWght*OBEv0(j,k,bi,bj)
231 & +aWght*OBEv1(j,k,bi,bj)
232 OBEt(j,k,bi,bj) = bWght*OBEt0(j,k,bi,bj)
233 & +aWght*OBEt1(j,k,bi,bj)
234 OBEs(j,k,bi,bj) = bWght*OBEs0(j,k,bi,bj)
235 & +aWght*OBEs1(j,k,bi,bj)
236 #endif /* ALLOW_OBCS_EAST */
237 #ifdef ALLOW_OBCS_WEST
238 OBWu(j,k,bi,bj) = bWght*OBWu0(j,k,bi,bj)
239 & +aWght*OBWu1(j,k,bi,bj)
240 OBWv(j,k,bi,bj) = bWght*OBWv0(j,k,bi,bj)
241 & +aWght*OBWv1(j,k,bi,bj)
242 OBWt(j,k,bi,bj) = bWght*OBWt0(j,k,bi,bj)
243 & +aWght*OBWt1(j,k,bi,bj)
244 OBWs(j,k,bi,bj) = bWght*OBWs0(j,k,bi,bj)
245 & +aWght*OBWs1(j,k,bi,bj)
246 #endif /* ALLOW_OBCS_WEST */
247 ENDDO
248 DO i=1-Olx,sNx+Olx
249 #ifdef ALLOW_OBCS_NORTH
250 OBNu(i,k,bi,bj) = bWght*OBNu0(i,k,bi,bj)
251 & +aWght*OBNu1(i,k,bi,bj)
252 OBNv(i,k,bi,bj) = bWght*OBNv0(i,k,bi,bj)
253 & +aWght*OBNv1(i,k,bi,bj)
254 OBNt(i,k,bi,bj) = bWght*OBNt0(i,k,bi,bj)
255 & +aWght*OBNt1(i,k,bi,bj)
256 OBNs(i,k,bi,bj) = bWght*OBNs0(i,k,bi,bj)
257 & +aWght*OBNs1(i,k,bi,bj)
258 #endif /* ALLOW_OBCS_NORTH */
259 #ifdef ALLOW_OBCS_SOUTH
260 OBSu(i,k,bi,bj) = bWght*OBSu0(i,k,bi,bj)
261 & +aWght*OBSu1(i,k,bi,bj)
262 OBSv(i,k,bi,bj) = bWght*OBSv0(i,k,bi,bj)
263 & +aWght*OBSv1(i,k,bi,bj)
264 OBSt(i,k,bi,bj) = bWght*OBSt0(i,k,bi,bj)
265 & +aWght*OBSt1(i,k,bi,bj)
266 OBSs(i,k,bi,bj) = bWght*OBSs0(i,k,bi,bj)
267 & +aWght*OBSs1(i,k,bi,bj)
268 #endif /* ALLOW_OBCS_SOUTH */
269 ENDDO
270 ENDDO
271 ENDDO
272 ENDDO
273 C if not periodicForcing
274 ELSE
275 C read boundary values once and for all
276 IF ( myIter .EQ. nIter0 ) THEN
277 _BEGIN_MASTER(myThid)
278 C Read constant boundary conditions only for myIter = nIter0
279 WRITE(*,*)
280 & 'S/R OBCS_EXTERNAl_FIELDS_LOAD: Reading new data',myTime,myIter
281 inTime0 = 1
282 #ifdef ALLOW_OBCS_EAST
283 C Eastern boundary
284 IF ( OBEuFile .NE. ' ' ) THEN
285 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
286 & 'RL', Nr, OBEu0, inTime0, myThid )
287 ENDIF
288 IF ( OBEvFile .NE. ' ' ) THEN
289 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
290 & 'RL', Nr, OBEv0, inTime0, myThid )
291 ENDIF
292 IF ( OBEtFile .NE. ' ' ) THEN
293 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
294 & 'RL', Nr, OBEt0, inTime0, myThid )
295 ENDIF
296 IF ( OBEsFile .NE. ' ' ) THEN
297 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
298 & 'RL', Nr, OBEs0, inTime0, myThid )
299 ENDIF
300 #endif /* ALLOW_OBCS_WEST */
301 #ifdef ALLOW_OBCS_WEST
302 C Western boundary
303 IF ( OBWuFile .NE. ' ' ) THEN
304 CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
305 & 'RL', Nr, OBWu0, inTime0, myThid )
306 ENDIF
307 IF ( OBWvFile .NE. ' ' ) THEN
308 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
309 & 'RL', Nr, OBWv0, inTime0, myThid )
310 ENDIF
311 IF ( OBWtFile .NE. ' ' ) THEN
312 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
313 & 'RL', Nr, OBWt0, inTime0, myThid )
314 ENDIF
315 IF ( OBWsFile .NE. ' ' ) THEN
316 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
317 & 'RL', Nr, OBWs0, inTime0, myThid )
318 ENDIF
319 #endif /* ALLOW_OBCS_WEST */
320 #ifdef ALLOW_OBCS_NORTH
321 C Northern boundary
322 IF ( OBNuFile .NE. ' ' ) THEN
323 CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,
324 & 'RL', Nr, OBNu0, inTime0, myThid )
325 ENDIF
326 IF ( OBNvFile .NE. ' ' ) THEN
327 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
328 & 'RL', Nr, OBNv0, inTime0, myThid )
329 ENDIF
330 IF ( OBNtFile .NE. ' ' ) THEN
331 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
332 & 'RL', Nr, OBNt0, inTime0, myThid )
333 ENDIF
334 IF ( OBNsFile .NE. ' ' ) THEN
335 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
336 & 'RL', Nr, OBNs0, inTime0, myThid )
337 ENDIF
338 #endif /* ALLOW_OBCS_NORTH */
339 #ifdef ALLOW_OBCS_SOUTH
340 C Southern boundary
341 IF ( OBSuFile .NE. ' ' ) THEN
342 CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,
343 & 'RL', Nr, OBSu0, inTime0, myThid )
344 ENDIF
345 IF ( OBSvFile .NE. ' ' ) THEN
346 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
347 & 'RL', Nr, OBSv0, inTime0, myThid )
348 ENDIF
349 IF ( OBStFile .NE. ' ' ) THEN
350 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
351 & 'RL', Nr, OBSt0, inTime0, myThid )
352 ENDIF
353 IF ( OBSsFile .NE. ' ' ) THEN
354 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
355 & 'RL', Nr, OBSs0, inTime0, myThid )
356 ENDIF
357 #endif /* ALLOW_OBCS_SOUTH */
358 _END_MASTER(myThid)
359 C endif myIter .EQ. nIter0
360 ENDIF
361 DO bj = myByLo(myThid), myByHi(myThid)
362 DO bi = myBxLo(myThid), myBxHi(myThid)
363 DO K = 1, Nr
364 DO j=1-Oly,sNy+Oly
365 #ifdef ALLOW_OBCS_EAST
366 OBEu(j,k,bi,bj) = OBEu0(j,k,bi,bj)
367 OBEv(j,k,bi,bj) = OBEv0(j,k,bi,bj)
368 OBEt(j,k,bi,bj) = OBEt0(j,k,bi,bj)
369 OBEs(j,k,bi,bj) = OBEs0(j,k,bi,bj)
370 #endif /* ALLOW_OBCS_EAST */
371 #ifdef ALLOW_OBCS_WEST
372 OBWu(j,k,bi,bj) = OBWu0(j,k,bi,bj)
373 OBWv(j,k,bi,bj) = OBWv0(j,k,bi,bj)
374 OBWt(j,k,bi,bj) = OBWt0(j,k,bi,bj)
375 OBWs(j,k,bi,bj) = OBWs0(j,k,bi,bj)
376 #endif /* ALLOW_OBCS_WEST */
377 ENDDO
378 DO i=1-Olx,sNx+Olx
379 #ifdef ALLOW_OBCS_NORTH
380 OBNu(i,k,bi,bj) = OBNu0(i,k,bi,bj)
381 OBNv(i,k,bi,bj) = OBNv0(i,k,bi,bj)
382 OBNt(i,k,bi,bj) = OBNt0(i,k,bi,bj)
383 OBNs(i,k,bi,bj) = OBNs0(i,k,bi,bj)
384 #endif /* ALLOW_OBCS_NORTH */
385 #ifdef ALLOW_OBCS_SOUTH
386 OBSu(i,k,bi,bj) = OBSu0(i,k,bi,bj)
387 OBSv(i,k,bi,bj) = OBSv0(i,k,bi,bj)
388 OBSt(i,k,bi,bj) = OBSt0(i,k,bi,bj)
389 OBSs(i,k,bi,bj) = OBSs0(i,k,bi,bj)
390 #endif /* ALLOW_OBCS_SOUTH */
391 ENDDO
392 ENDDO
393 ENDDO
394 ENDDO
395 C endif for periodicForcing
396 ENDIF
397
398 #endif /* ALLOW_EXF */
399 #endif /* ALLOw_OBCS AND ALLOW_OBCS_PRESCRIBE */
400
401 RETURN
402 END
403

  ViewVC Help
Powered by ViewVC 1.1.22