/[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.2 - (show annotations) (download)
Wed Sep 29 12:27:09 2004 UTC (19 years, 9 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 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.1 2004/09/24 12:32:09 mlosch 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 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 #ifdef ALLOW_OBCS_EAST
106 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 IF ( OBEtFile .NE. ' ' ) THEN
120 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
121 & 'RL', Nr, OBEt0, intime0, myThid )
122 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
123 & 'RL', Nr, OBEt1, intime0, myThid )
124 ENDIF
125 IF ( OBEsFile .NE. ' ' ) THEN
126 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 IF ( OBWtFile .NE. ' ' ) THEN
147 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
148 & 'RL', Nr, OBWt0, intime0, myThid )
149 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
150 & 'RL', Nr, OBWt1, intime0, myThid )
151 ENDIF
152 IF ( OBWsFile .NE. ' ' ) THEN
153 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 IF ( OBNtFile .NE. ' ' ) THEN
174 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
175 & 'RL', Nr, OBNt0, intime0, myThid )
176 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
177 & 'RL', Nr, OBNt1, intime0, myThid )
178 ENDIF
179 IF ( OBNsFile .NE. ' ' ) THEN
180 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 IF ( OBStFile .NE. ' ' ) THEN
201 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
202 & 'RL', Nr, OBSt0, intime0, myThid )
203 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
204 & 'RL', Nr, OBSt1, intime0, myThid )
205 ENDIF
206 IF ( OBSsFile .NE. ' ' ) THEN
207 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 C Read constant boundary conditions only for myIter = nIter0
280 WRITE(*,*)
281 & 'S/R OBCS_EXTERNAl_FIELDS_LOAD: Reading new data',myTime,myIter
282 inTime0 = 1
283 #ifdef ALLOW_OBCS_EAST
284 C Eastern boundary
285 IF ( OBEuFile .NE. ' ' ) THEN
286 CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
287 & 'RL', Nr, OBEu0, inTime0, myThid )
288 ENDIF
289 IF ( OBEvFile .NE. ' ' ) THEN
290 CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
291 & 'RL', Nr, OBEv0, inTime0, myThid )
292 ENDIF
293 IF ( OBEtFile .NE. ' ' ) THEN
294 CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
295 & 'RL', Nr, OBEt0, inTime0, myThid )
296 ENDIF
297 IF ( OBEsFile .NE. ' ' ) THEN
298 CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
299 & 'RL', Nr, OBEs0, inTime0, myThid )
300 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 & 'RL', Nr, OBWu0, inTime0, myThid )
307 ENDIF
308 IF ( OBWvFile .NE. ' ' ) THEN
309 CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
310 & 'RL', Nr, OBWv0, inTime0, myThid )
311 ENDIF
312 IF ( OBWtFile .NE. ' ' ) THEN
313 CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
314 & 'RL', Nr, OBWt0, inTime0, myThid )
315 ENDIF
316 IF ( OBWsFile .NE. ' ' ) THEN
317 CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
318 & 'RL', Nr, OBWs0, inTime0, myThid )
319 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 & 'RL', Nr, OBNu0, inTime0, myThid )
326 ENDIF
327 IF ( OBNvFile .NE. ' ' ) THEN
328 CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
329 & 'RL', Nr, OBNv0, inTime0, myThid )
330 ENDIF
331 IF ( OBNtFile .NE. ' ' ) THEN
332 CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
333 & 'RL', Nr, OBNt0, inTime0, myThid )
334 ENDIF
335 IF ( OBNsFile .NE. ' ' ) THEN
336 CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
337 & 'RL', Nr, OBNs0, inTime0, myThid )
338 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 & 'RL', Nr, OBSu0, inTime0, myThid )
345 ENDIF
346 IF ( OBSvFile .NE. ' ' ) THEN
347 CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
348 & 'RL', Nr, OBSv0, inTime0, myThid )
349 ENDIF
350 IF ( OBStFile .NE. ' ' ) THEN
351 CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
352 & 'RL', Nr, OBSt0, inTime0, myThid )
353 ENDIF
354 IF ( OBSsFile .NE. ' ' ) THEN
355 CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
356 & 'RL', Nr, OBSs0, inTime0, myThid )
357 ENDIF
358 #endif /* ALLOW_OBCS_SOUTH */
359 _END_MASTER(myThid)
360 C endif myIter .EQ. nIter0
361 ENDIF
362 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 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