/[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.15 - (hide annotations) (download)
Tue Dec 8 00:21:34 2009 UTC (14 years, 6 months ago) by jmc
Branch: MAIN
Changes since 1.14: +62 -2 lines
add files & OB-variables for wVel (Non-Hydrostatic) with useOBCSprescribe

1 jmc 1.15 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.14 2009/10/04 21:52:25 jmc Exp $
2 mlosch 1.1 C $Name: $
3     #include "OBCS_OPTIONS.h"
4 jmc 1.8
5 mlosch 1.1 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 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD
12     C | o Control reading of fields from external source.
13 mlosch 1.1 C *==========================================================*
14 mlosch 1.5 C | External source field loading routine for open boundaries.
15 jmc 1.8 C | This routine is called every time we want to
16     C | load a a set of external open boundary fields.
17 mlosch 1.5 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 jmc 1.8 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 mlosch 1.1 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 jmc 1.8 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 jmc 1.14 #include "OBCS.h"
51     #ifdef ALLOW_PTRACERS
52     #include "PTRACERS_SIZE.h"
53     #include "OBCS_PTRACERS.h"
54     #include "PTRACERS_PARAMS.h"
55     c#include "PTRACERS_FIELDS.h"
56     #endif /* ALLOW_PTRACERS */
57 jmc 1.8
58 mlosch 1.1 C !INPUT/OUTPUT PARAMETERS:
59     C === Routine arguments ===
60 jmc 1.13 C myTime :: Simulation time
61     C myIter :: Simulation timestep number
62     C myThid :: Thread no. that called this routine.
63 mlosch 1.1 _RL myTime
64     INTEGER myIter
65 jmc 1.13 INTEGER myThid
66 jmc 1.8
67 jmc 1.14 C if external forcing (exf) package is enabled (useEXF=T), all loading of
68     C external fields is done by exf
69     #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE )
70 mlosch 1.1
71     C !LOCAL VARIABLES:
72     C === Local arrays ===
73     C aWght, bWght :: Interpolation weights
74 jmc 1.15 C msgBuf :: Informational/error message buffer
75 mlosch 1.12 #ifdef NONLIN_FRSURF
76     INTEGER i,j,bi,bj
77     #endif /* NONLIN_FRSURF */
78 jmc 1.13 INTEGER fp
79     INTEGER iRec0, iRec1, iTr
80 mlosch 1.1 _RL aWght,bWght,rdt
81     INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
82 mlosch 1.5 CHARACTER*(MAX_LEN_MBUF) msgBuf
83 mlosch 1.1 CEOP
84    
85 jmc 1.13 fp = readBinaryPrec
86    
87 mlosch 1.1 IF ( periodicExternalForcing ) THEN
88    
89     C Now calculate whether it is time to update the forcing arrays
90 jmc 1.10 rdt = 1. _d 0 / deltaTclock
91     nForcingPeriods = NINT(externForcingCycle/externForcingPeriod)
92     Imytm = NINT(myTime*rdt)
93     Ifprd = NINT(externForcingPeriod*rdt)
94     Ifcyc = NINT(externForcingCycle*rdt)
95     Iftm = MOD( Imytm+Ifcyc-Ifprd/2, Ifcyc)
96    
97 jmc 1.13 iRec0 = 1 + INT(Iftm/Ifprd)
98     iRec1 = 1 + MOD(iRec0,nForcingPeriods)
99     c aWght = DFLOAT( Iftm-Ifprd*(iRec0 - 1) ) / DFLOAT( Ifprd )
100     aWght = FLOAT( Iftm-Ifprd*(iRec0 - 1) )
101 jmc 1.10 bWght = FLOAT( Ifprd )
102     aWght = aWght / bWght
103     bWght = 1. _d 0 - aWght
104 mlosch 1.1
105     IF (
106 jmc 1.13 & Iftm-Ifprd*(iRec0-1) .EQ. 0
107 mlosch 1.1 & .OR. myIter .EQ. nIter0
108     & ) THEN
109    
110 jmc 1.13 #ifndef ALLOW_MDSIO
111     STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
112     #endif /* ALLOW_MDSIO */
113    
114 jmc 1.7 _BARRIER
115 mlosch 1.1
116     C If the above condition is met then we need to read in
117     C data for the period ahead and the period behind myTime.
118 mlosch 1.5 WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
119     & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
120 jmc 1.13 & iRec0, iRec1, myIter, myTime
121 mlosch 1.5 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
122     & SQUEEZE_RIGHT,myThid)
123 mlosch 1.1
124 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
125 mlosch 1.1 C Eastern boundary
126     IF ( OBEuFile .NE. ' ' ) THEN
127 jmc 1.13 CALL READ_REC_YZ_RL( OBEuFile, fp,Nr,OBEu0,iRec0,myIter,myThid )
128     CALL READ_REC_YZ_RL( OBEuFile, fp,Nr,OBEu1,iRec1,myIter,myThid )
129 mlosch 1.1 ENDIF
130     IF ( OBEvFile .NE. ' ' ) THEN
131 jmc 1.13 CALL READ_REC_YZ_RL( OBEvFile, fp,Nr,OBEv0,iRec0,myIter,myThid )
132     CALL READ_REC_YZ_RL( OBEvFile, fp,Nr,OBEv1,iRec1,myIter,myThid )
133 mlosch 1.1 ENDIF
134 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
135 jmc 1.13 CALL READ_REC_YZ_RL( OBEtFile, fp,Nr,OBEt0,iRec0,myIter,myThid )
136     CALL READ_REC_YZ_RL( OBEtFile, fp,Nr,OBEt1,iRec1,myIter,myThid )
137 mlosch 1.1 ENDIF
138 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
139 jmc 1.13 CALL READ_REC_YZ_RL( OBEsFile, fp,Nr,OBEs0,iRec0,myIter,myThid )
140     CALL READ_REC_YZ_RL( OBEsFile, fp,Nr,OBEs1,iRec1,myIter,myThid )
141 mlosch 1.1 ENDIF
142 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
143     IF ( OBEwFile .NE. ' ' ) THEN
144     CALL READ_REC_YZ_RL( OBEwFile, fp,Nr,OBEw0,iRec0,myIter,myThid )
145     CALL READ_REC_YZ_RL( OBEwFile, fp,Nr,OBEw1,iRec1,myIter,myThid )
146     ENDIF
147     # endif /* ALLOW_NONHYDROSTATIC */
148 mlosch 1.12 # ifdef NONLIN_FRSURF
149     IF ( OBEetaFile .NE. ' ' ) THEN
150 jmc 1.13 CALL READ_REC_YZ_RL(OBEetaFile,fp,1,OBEeta0,iRec0,myIter,myThid)
151     CALL READ_REC_YZ_RL(OBEetaFile,fp,1,OBEeta1,iRec1,myIter,myThid)
152 mlosch 1.12 ENDIF
153     # endif /* NONLIN_FRSURF */
154     #endif /* ALLOW_OBCS_EAST */
155 mlosch 1.1 #ifdef ALLOW_OBCS_WEST
156     C Western boundary
157     IF ( OBWuFile .NE. ' ' ) THEN
158 jmc 1.13 CALL READ_REC_YZ_RL( OBWuFile, fp,Nr,OBWu0,iRec0,myIter,myThid )
159     CALL READ_REC_YZ_RL( OBWuFile, fp,Nr,OBWu1,iRec1,myIter,myThid )
160 mlosch 1.1 ENDIF
161     IF ( OBWvFile .NE. ' ' ) THEN
162 jmc 1.13 CALL READ_REC_YZ_RL( OBWvFile, fp,Nr,OBWv0,iRec0,myIter,myThid )
163     CALL READ_REC_YZ_RL( OBWvFile, fp,Nr,OBWv1,iRec1,myIter,myThid )
164 mlosch 1.1 ENDIF
165 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
166 jmc 1.13 CALL READ_REC_YZ_RL( OBWtFile, fp,Nr,OBWt0,iRec0,myIter,myThid )
167     CALL READ_REC_YZ_RL( OBWtFile, fp,Nr,OBWt1,iRec1,myIter,myThid )
168 mlosch 1.1 ENDIF
169 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
170 jmc 1.13 CALL READ_REC_YZ_RL( OBWsFile, fp,Nr,OBWs0,iRec0,myIter,myThid )
171     CALL READ_REC_YZ_RL( OBWsFile, fp,Nr,OBWs1,iRec1,myIter,myThid )
172 mlosch 1.1 ENDIF
173 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
174     IF ( OBWwFile .NE. ' ' ) THEN
175     CALL READ_REC_YZ_RL( OBWwFile, fp,Nr,OBWw0,iRec0,myIter,myThid )
176     CALL READ_REC_YZ_RL( OBWwFile, fp,Nr,OBWw1,iRec1,myIter,myThid )
177     ENDIF
178     # endif /* ALLOW_NONHYDROSTATIC */
179 mlosch 1.12 # ifdef NONLIN_FRSURF
180     IF ( OBWetaFile .NE. ' ' ) THEN
181 jmc 1.13 CALL READ_REC_YZ_RL(OBWetaFile,fp,1,OBWeta0,iRec0,myIter,myThid)
182     CALL READ_REC_YZ_RL(OBWetaFile,fp,1,OBWeta1,iRec1,myIter,myThid)
183 mlosch 1.12 ENDIF
184     # endif /* NONLIN_FRSURF */
185 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
186     #ifdef ALLOW_OBCS_NORTH
187     C Northern boundary
188     IF ( OBNuFile .NE. ' ' ) THEN
189 jmc 1.13 CALL READ_REC_XZ_RL( OBNuFile, fp,Nr,OBNu0,iRec0,myIter,myThid )
190     CALL READ_REC_XZ_RL( OBNuFile, fp,Nr,OBNu1,iRec1,myIter,myThid )
191 mlosch 1.1 ENDIF
192     IF ( OBNvFile .NE. ' ' ) THEN
193 jmc 1.13 CALL READ_REC_XZ_RL( OBNvFile, fp,Nr,OBNv0,iRec0,myIter,myThid )
194     CALL READ_REC_XZ_RL( OBNvFile, fp,Nr,OBNv1,iRec1,myIter,myThid )
195 mlosch 1.1 ENDIF
196 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
197 jmc 1.13 CALL READ_REC_XZ_RL( OBNtFile, fp,Nr,OBNt0,iRec0,myIter,myThid )
198     CALL READ_REC_XZ_RL( OBNtFile, fp,Nr,OBNt1,iRec1,myIter,myThid )
199 mlosch 1.1 ENDIF
200 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
201 jmc 1.13 CALL READ_REC_XZ_RL( OBNsFile, fp,Nr,OBNs0,iRec0,myIter,myThid )
202     CALL READ_REC_XZ_RL( OBNsFile, fp,Nr,OBNs1,iRec1,myIter,myThid )
203 mlosch 1.1 ENDIF
204 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
205     IF ( OBNwFile .NE. ' ' ) THEN
206     CALL READ_REC_XZ_RL( OBNwFile, fp,Nr,OBNw0,iRec0,myIter,myThid )
207     CALL READ_REC_XZ_RL( OBNwFile, fp,Nr,OBNw1,iRec1,myIter,myThid )
208     ENDIF
209     # endif /* ALLOW_NONHYDROSTATIC */
210 mlosch 1.12 # ifdef NONLIN_FRSURF
211     IF ( OBNetaFile .NE. ' ' ) THEN
212 jmc 1.13 CALL READ_REC_XZ_RL(OBNetaFile,fp,1,OBNeta0,iRec0,myIter,myThid)
213     CALL READ_REC_XZ_RL(OBNetaFile,fp,1,OBNeta1,iRec1,myIter,myThid)
214 mlosch 1.12 ENDIF
215     # endif /* NONLIN_FRSURF */
216 mlosch 1.1 #endif /* ALLOW_OBCS_NORTH */
217     #ifdef ALLOW_OBCS_SOUTH
218     C Southern boundary
219     IF ( OBSuFile .NE. ' ' ) THEN
220 jmc 1.13 CALL READ_REC_XZ_RL( OBSuFile, fp,Nr,OBSu0,iRec0,myIter,myThid )
221     CALL READ_REC_XZ_RL( OBSuFile, fp,Nr,OBSu1,iRec1,myIter,myThid )
222 mlosch 1.1 ENDIF
223     IF ( OBSvFile .NE. ' ' ) THEN
224 jmc 1.13 CALL READ_REC_XZ_RL( OBSvFile, fp,Nr,OBSv0,iRec0,myIter,myThid )
225     CALL READ_REC_XZ_RL( OBSvFile, fp,Nr,OBSv1,iRec1,myIter,myThid )
226 mlosch 1.1 ENDIF
227 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
228 jmc 1.13 CALL READ_REC_XZ_RL( OBStFile, fp,Nr,OBSt0,iRec0,myIter,myThid )
229     CALL READ_REC_XZ_RL( OBStFile, fp,Nr,OBSt1,iRec1,myIter,myThid )
230 mlosch 1.1 ENDIF
231 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
232 jmc 1.13 CALL READ_REC_XZ_RL( OBSsFile, fp,Nr,OBSs0,iRec0,myIter,myThid )
233     CALL READ_REC_XZ_RL( OBSsFile, fp,Nr,OBSs1,iRec1,myIter,myThid )
234 mlosch 1.1 ENDIF
235 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
236     IF ( OBSwFile .NE. ' ' ) THEN
237     CALL READ_REC_XZ_RL( OBSwFile, fp,Nr,OBSw0,iRec0,myIter,myThid )
238     CALL READ_REC_XZ_RL( OBSwFile, fp,Nr,OBSw1,iRec1,myIter,myThid )
239     ENDIF
240     # endif /* ALLOW_NONHYDROSTATIC */
241 mlosch 1.12 # ifdef NONLIN_FRSURF
242     IF ( OBSetaFile .NE. ' ' ) THEN
243 jmc 1.13 CALL READ_REC_XZ_RL(OBSetaFile,fp,1,OBSeta0,iRec0,myIter,myThid)
244     CALL READ_REC_XZ_RL(OBSetaFile,fp,1,OBSeta1,iRec1,myIter,myThid)
245 mlosch 1.12 ENDIF
246     # endif /* NONLIN_FRSURF */
247 mlosch 1.1 #endif /* ALLOW_OBCS_SOUTH */
248 mlosch 1.5 #ifdef ALLOW_PTRACERS
249     IF (usePTRACERS) THEN
250     C read boundary values for passive tracers
251 jmc 1.13 DO iTr = 1, PTRACERS_numInUse
252 mlosch 1.5 # ifdef ALLOW_OBCS_EAST
253     C Eastern boundary
254 jmc 1.13 IF ( OBEptrFile(iTr) .NE. ' ' ) THEN
255     CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
256     & OBEptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
257     CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
258     & OBEptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
259 mlosch 1.5 ENDIF
260     # endif /* ALLOW_OBCS_WEST */
261     # ifdef ALLOW_OBCS_WEST
262     C Western boundary
263 jmc 1.13 IF ( OBWptrFile(iTr) .NE. ' ' ) THEN
264     CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
265     & OBWptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
266     CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
267     & OBWptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
268 mlosch 1.5 ENDIF
269     # endif /* ALLOW_OBCS_WEST */
270     # ifdef ALLOW_OBCS_NORTH
271     C Northern boundary
272 jmc 1.13 IF ( OBNptrFile(iTr) .NE. ' ' ) THEN
273     CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
274     & OBNptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
275     CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
276     & OBNptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
277 mlosch 1.5 ENDIF
278     # endif /* ALLOW_OBCS_NORTH */
279     # ifdef ALLOW_OBCS_SOUTH
280     C Southern boundary
281 jmc 1.13 IF ( OBSptrFile(iTr) .NE. ' ' ) THEN
282     CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
283     & OBSptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
284     CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
285     & OBSptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
286 mlosch 1.5 ENDIF
287     # endif /* ALLOW_OBCS_SOUTH */
288 jmc 1.13 C end do iTr
289 mlosch 1.5 ENDDO
290     C end if (usePTRACERS)
291     ENDIF
292     #endif /* ALLOW_PTRACERS */
293 jmc 1.8
294 mlosch 1.1 C
295     C At this point in external_fields_load the input fields are exchanged.
296 jmc 1.8 C However, we do not have exchange routines for vertical
297 mlosch 1.1 C slices and they are not planned, either, so the approriate fields
298 jmc 1.8 C are exchanged after the open boundary conditions have been
299 mlosch 1.1 C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
300 jmc 1.7 _BARRIER
301    
302     C end if time to read new data
303 mlosch 1.1 ENDIF
304    
305     C if not periodicForcing
306     ELSE
307 mlosch 1.5 aWght = 0. _d 0
308     bWght = 1. _d 0
309 mlosch 1.1 C read boundary values once and for all
310     IF ( myIter .EQ. nIter0 ) THEN
311 jmc 1.13 #ifndef ALLOW_MDSIO
312     STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
313     #endif /* ALLOW_MDSIO */
314 jmc 1.7 _BARRIER
315 mlosch 1.2 C Read constant boundary conditions only for myIter = nIter0
316 mlosch 1.5 WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
317 jmc 1.7 & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading initial data:',
318 mlosch 1.5 & myIter, myTime
319     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
320     & SQUEEZE_RIGHT,myThid)
321 jmc 1.13 iRec0 = 1
322    
323 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
324 mlosch 1.1 C Eastern boundary
325     IF ( OBEuFile .NE. ' ' ) THEN
326 jmc 1.13 CALL READ_REC_YZ_RL( OBEuFile,fp,Nr,OBEu0,iRec0,myIter,myThid )
327 mlosch 1.1 ENDIF
328     IF ( OBEvFile .NE. ' ' ) THEN
329 jmc 1.13 CALL READ_REC_YZ_RL( OBEvFile,fp,Nr,OBEv0,iRec0,myIter,myThid )
330 mlosch 1.1 ENDIF
331 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
332 jmc 1.13 CALL READ_REC_YZ_RL( OBEtFile,fp,Nr,OBEt0,iRec0,myIter,myThid )
333 mlosch 1.1 ENDIF
334 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
335 jmc 1.13 CALL READ_REC_YZ_RL( OBEsFile,fp,Nr,OBEs0,iRec0,myIter,myThid )
336 mlosch 1.1 ENDIF
337 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
338     IF ( OBEwFile .NE. ' ' ) THEN
339     CALL READ_REC_YZ_RL( OBEwFile,fp,Nr,OBEw0,iRec0,myIter,myThid )
340     ENDIF
341     # endif /* ALLOW_NONHYDROSTATIC */
342 mlosch 1.12 # ifdef NONLIN_FRSURF
343     IF ( OBEetaFile .NE. ' ' ) THEN
344 jmc 1.13 CALL READ_REC_YZ_RL( OBEetaFile, fp, 1, OBEeta0, iRec0,
345     & myIter, myThid )
346 mlosch 1.12 ENDIF
347     # endif /* NONLIN_FRSURF */
348 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
349     #ifdef ALLOW_OBCS_WEST
350     C Western boundary
351     IF ( OBWuFile .NE. ' ' ) THEN
352 jmc 1.13 CALL READ_REC_YZ_RL( OBWuFile,fp,Nr,OBWu0,iRec0,myIter,myThid )
353 mlosch 1.1 ENDIF
354     IF ( OBWvFile .NE. ' ' ) THEN
355 jmc 1.13 CALL READ_REC_YZ_RL( OBWvFile,fp,Nr,OBWv0,iRec0,myIter,myThid )
356 mlosch 1.1 ENDIF
357 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
358 jmc 1.13 CALL READ_REC_YZ_RL( OBWtFile,fp,Nr,OBWt0,iRec0,myIter,myThid )
359 mlosch 1.1 ENDIF
360 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
361 jmc 1.13 CALL READ_REC_YZ_RL( OBWsFile,fp,Nr,OBWs0,iRec0,myIter,myThid )
362 mlosch 1.1 ENDIF
363 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
364     IF ( OBWwFile .NE. ' ' ) THEN
365     CALL READ_REC_YZ_RL( OBWwFile,fp,Nr,OBWw0,iRec0,myIter,myThid )
366     ENDIF
367     # endif /* ALLOW_NONHYDROSTATIC */
368 mlosch 1.12 # ifdef NONLIN_FRSURF
369     IF ( OBWetaFile .NE. ' ' ) THEN
370 jmc 1.13 CALL READ_REC_YZ_RL( OBWetaFile, fp, 1, OBWeta0, iRec0,
371     & myIter, myThid )
372 mlosch 1.12 ENDIF
373     # endif /* NONLIN_FRSURF */
374 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
375     #ifdef ALLOW_OBCS_NORTH
376     C Northern boundary
377     IF ( OBNuFile .NE. ' ' ) THEN
378 jmc 1.13 CALL READ_REC_XZ_RL( OBNuFile,fp,Nr,OBNu0,iRec0,myIter,myThid )
379 mlosch 1.1 ENDIF
380     IF ( OBNvFile .NE. ' ' ) THEN
381 jmc 1.13 CALL READ_REC_XZ_RL( OBNvFile,fp,Nr,OBNv0,iRec0,myIter,myThid )
382 mlosch 1.1 ENDIF
383 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
384 jmc 1.13 CALL READ_REC_XZ_RL( OBNtFile,fp,Nr,OBNt0,iRec0,myIter,myThid )
385 mlosch 1.1 ENDIF
386 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
387 jmc 1.13 CALL READ_REC_XZ_RL( OBNsFile,fp,Nr,OBNs0,iRec0,myIter,myThid )
388 mlosch 1.1 ENDIF
389 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
390     IF ( OBNwFile .NE. ' ' ) THEN
391     CALL READ_REC_YZ_RL( OBNwFile,fp,Nr,OBNw0,iRec0,myIter,myThid )
392     ENDIF
393     # endif /* ALLOW_NONHYDROSTATIC */
394 mlosch 1.12 # ifdef NONLIN_FRSURF
395     IF ( OBNetaFile .NE. ' ' ) THEN
396 jmc 1.13 CALL READ_REC_XZ_RL( OBNetaFile, fp, 1, OBNeta0, iRec0,
397     & myIter, myThid )
398 mlosch 1.12 ENDIF
399     # endif /* NONLIN_FRSURF */
400 mlosch 1.1 #endif /* ALLOW_OBCS_NORTH */
401     #ifdef ALLOW_OBCS_SOUTH
402     C Southern boundary
403     IF ( OBSuFile .NE. ' ' ) THEN
404 jmc 1.13 CALL READ_REC_XZ_RL( OBSuFile,fp,Nr,OBSu0,iRec0,myIter,myThid )
405 mlosch 1.1 ENDIF
406     IF ( OBSvFile .NE. ' ' ) THEN
407 jmc 1.13 CALL READ_REC_XZ_RL( OBSvFile,fp,Nr,OBSv0,iRec0,myIter,myThid )
408 mlosch 1.1 ENDIF
409 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
410 jmc 1.13 CALL READ_REC_XZ_RL( OBStFile,fp,Nr,OBSt0,iRec0,myIter,myThid )
411 mlosch 1.1 ENDIF
412 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
413 jmc 1.13 CALL READ_REC_XZ_RL( OBSsFile,fp,Nr,OBSs0,iRec0,myIter,myThid )
414 mlosch 1.1 ENDIF
415 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
416     IF ( OBSwFile .NE. ' ' ) THEN
417     CALL READ_REC_YZ_RL( OBSwFile,fp,Nr,OBSw0,iRec0,myIter,myThid )
418     ENDIF
419     # endif /* ALLOW_NONHYDROSTATIC */
420 mlosch 1.12 # ifdef NONLIN_FRSURF
421     IF ( OBSetaFile .NE. ' ' ) THEN
422 jmc 1.13 CALL READ_REC_XZ_RL( OBSetaFile, fp, 1, OBSeta0, iRec0,
423     & myIter, myThid )
424 mlosch 1.12 ENDIF
425     # endif /* NONLIN_FRSURF */
426 mlosch 1.1 #endif /* ALLOW_OBCS_SOUTH */
427 mlosch 1.5 #ifdef ALLOW_PTRACERS
428     IF (usePTRACERS) THEN
429     C read passive tracer boundary values
430 jmc 1.13 DO iTr = 1, PTRACERS_numInUse
431 mlosch 1.5 # ifdef ALLOW_OBCS_EAST
432     C Eastern boundary
433 jmc 1.13 IF ( OBEptrFile(iTr) .NE. ' ' ) THEN
434     CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
435     & OBEptr0(1-Oly,1,1,1,iTr), iRec0,myIter, myThid )
436 mlosch 1.5 ENDIF
437     # endif /* ALLOW_OBCS_WEST */
438     # ifdef ALLOW_OBCS_WEST
439     C Western boundary
440 jmc 1.13 IF ( OBWptrFile(iTr) .NE. ' ' ) THEN
441     CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
442     & OBWptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
443 mlosch 1.5 ENDIF
444     # endif /* ALLOW_OBCS_WEST */
445     # ifdef ALLOW_OBCS_NORTH
446     C Northern boundary
447 jmc 1.13 IF ( OBNptrFile(iTr) .NE. ' ' ) THEN
448     CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
449     & OBNptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
450 mlosch 1.5 ENDIF
451     # endif /* ALLOW_OBCS_NORTH */
452     # ifdef ALLOW_OBCS_SOUTH
453     C Southern boundary
454 jmc 1.13 IF ( OBSptrFile(iTr) .NE. ' ' ) THEN
455     CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
456     & OBSptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
457 mlosch 1.5 ENDIF
458     # endif /* ALLOW_OBCS_SOUTH */
459 jmc 1.13 C end do iTr
460 mlosch 1.5 ENDDO
461     C end if (usePTRACERS)
462     ENDIF
463     #endif /* ALLOW_PTRACERS */
464 jmc 1.7 _BARRIER
465 mlosch 1.1 C endif myIter .EQ. nIter0
466     ENDIF
467 mlosch 1.5 C endif for periodicForcing
468     ENDIF
469    
470     C-- Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
471 jmc 1.8 C-- For periodicForcing, aWght = 0. and bWght = 1. so that the
472     C-- interpolation boilds down to copying the time-independent
473 mlosch 1.5 C-- forcing field OBSu0 to OBSu
474 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
475 jmc 1.8 IF ( OBEuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
476 mlosch 1.5 & OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
477 jmc 1.8 IF ( OBEvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
478 mlosch 1.5 & OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
479     IF ( OBEtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
480     & OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
481 jmc 1.8 IF ( OBEsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
482 mlosch 1.5 & OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
483 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
484     IF ( OBEwFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
485     & OBEw, OBEw0, OBEw1, aWght, bWght, myThid )
486     # endif /* ALLOW_NONHYDROSTATIC */
487 mlosch 1.12 # ifdef NONLIN_FRSURF
488     IF ( OBEetaFile .NE. ' ' ) THEN
489     DO bj = myByLo(myThid), myByHi(myThid)
490     DO bi = myBxLo(myThid), myBxHi(myThid)
491     DO j=1-Oly,sNy+Oly
492     OBEeta(j,bi,bj) = bWght*OBEeta0(j,bi,bj)
493     & +aWght*OBEeta1(j,bi,bj)
494     ENDDO
495     ENDDO
496 jmc 1.13 ENDDO
497 mlosch 1.12 ENDIF
498     # endif /* NONLIN_FRSURF */
499 mlosch 1.2 #endif /* ALLOW_OBCS_EAST */
500     #ifdef ALLOW_OBCS_WEST
501 jmc 1.8 IF ( OBWuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
502 mlosch 1.5 & OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
503 jmc 1.8 IF ( OBWvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
504 mlosch 1.5 & OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
505     IF ( OBWtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
506     & OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
507 jmc 1.8 IF ( OBWsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
508 mlosch 1.5 & OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
509 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
510     IF ( OBWwFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
511     & OBWw, OBWw0, OBWw1, aWght, bWght, myThid )
512     # endif /* ALLOW_NONHYDROSTATIC */
513 mlosch 1.12 # ifdef NONLIN_FRSURF
514     IF ( OBWetaFile .NE. ' ' ) THEN
515     DO bj = myByLo(myThid), myByHi(myThid)
516     DO bi = myBxLo(myThid), myBxHi(myThid)
517     DO j=1-Oly,sNy+Oly
518     OBWeta(j,bi,bj) = bWght*OBWeta0(j,bi,bj)
519     & +aWght*OBWeta1(j,bi,bj)
520     ENDDO
521     ENDDO
522 jmc 1.13 ENDDO
523 mlosch 1.12 ENDIF
524     # endif /* NONLIN_FRSURF */
525 mlosch 1.2 #endif /* ALLOW_OBCS_WEST */
526     #ifdef ALLOW_OBCS_NORTH
527 jmc 1.8 IF ( OBNuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
528 mlosch 1.5 & OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
529 jmc 1.8 IF ( OBNvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
530 mlosch 1.5 & OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
531     IF ( OBNtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
532     & OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
533 jmc 1.8 IF ( OBNsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
534 mlosch 1.5 & OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
535 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
536     IF ( OBNwFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
537     & OBNw, OBNw0, OBNw1, aWght, bWght, myThid )
538     # endif /* ALLOW_NONHYDROSTATIC */
539 mlosch 1.12 # ifdef NONLIN_FRSURF
540     IF ( OBNetaFile .NE. ' ' ) THEN
541     DO bj = myByLo(myThid), myByHi(myThid)
542     DO bi = myBxLo(myThid), myBxHi(myThid)
543     DO i=1-Olx,sNx+Olx
544     OBNeta(i,bi,bj) = bWght*OBNeta0(i,bi,bj)
545     & +aWght*OBNeta1(i,bi,bj)
546     ENDDO
547     ENDDO
548 jmc 1.13 ENDDO
549 mlosch 1.12 ENDIF
550     # endif /* NONLIN_FRSURF */
551 mlosch 1.2 #endif /* ALLOW_OBCS_NORTH */
552     #ifdef ALLOW_OBCS_SOUTH
553 jmc 1.8 IF ( OBSuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
554 mlosch 1.5 & OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
555 jmc 1.8 IF ( OBSvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
556 mlosch 1.5 & OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
557     IF ( OBStFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
558     & OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
559 jmc 1.8 IF ( OBSsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
560 mlosch 1.5 & OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
561 jmc 1.15 # ifdef ALLOW_NONHYDROSTATIC
562     IF ( OBSwFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
563     & OBSw, OBSw0, OBSw1, aWght, bWght, myThid )
564     # endif /* ALLOW_NONHYDROSTATIC */
565 mlosch 1.12 # ifdef NONLIN_FRSURF
566     IF ( OBSetaFile .NE. ' ' ) THEN
567     DO bj = myByLo(myThid), myByHi(myThid)
568     DO bi = myBxLo(myThid), myBxHi(myThid)
569     DO i=1-Olx,sNx+Olx
570     OBSeta(i,bi,bj) = bWght*OBSeta0(i,bi,bj)
571     & +aWght*OBSeta1(i,bi,bj)
572     ENDDO
573     ENDDO
574 jmc 1.13 ENDDO
575 mlosch 1.12 ENDIF
576     # endif /* NONLIN_FRSURF */
577 mlosch 1.2 #endif /* ALLOW_OBCS_SOUTH */
578 mlosch 1.5 #ifdef ALLOW_PTRACERS
579     IF (usePTRACERS) THEN
580     C "interpolate" passive tracer boundary values
581 jmc 1.13 DO iTr = 1, PTRACERS_numInUse
582 mlosch 1.5 # ifdef ALLOW_OBCS_EAST
583 jmc 1.13 IF ( OBEptrFile(iTr) .NE. ' ' )
584 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
585 jmc 1.13 O OBEptr (1-Oly,1,1,1,iTr),
586     I OBEptr0(1-Oly,1,1,1,iTr),
587     I OBEptr1(1-Oly,1,1,1,iTr), aWght, bWght, myThid )
588 mlosch 1.5 # endif /* ALLOW_OBCS_EAST */
589     # ifdef ALLOW_OBCS_WEST
590 jmc 1.13 IF ( OBWptrFile(iTr) .NE. ' ' )
591 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
592 jmc 1.13 O OBWptr (1-Oly,1,1,1,iTr),
593     I OBWptr0(1-Oly,1,1,1,iTr),
594     I OBWptr1(1-Oly,1,1,1,iTr), aWght, bWght, myThid )
595 mlosch 1.5 # endif /* ALLOW_OBCS_WEST */
596     # ifdef ALLOW_OBCS_NORTH
597 jmc 1.13 IF ( OBNptrFile(iTr) .NE. ' ' )
598 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
599 jmc 1.13 O OBNptr (1-Olx,1,1,1,iTr),
600     I OBNptr0(1-Olx,1,1,1,iTr),
601     I OBNptr1(1-Olx,1,1,1,iTr), aWght, bWght, myThid )
602 mlosch 1.5 # endif /* ALLOW_OBCS_NORTH */
603     # ifdef ALLOW_OBCS_SOUTH
604 jmc 1.13 IF ( OBSptrFile(iTr) .NE. ' ' )
605 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
606 jmc 1.13 O OBSptr (1-Olx,1,1,1,iTr),
607     I OBSptr0(1-Olx,1,1,1,iTr),
608     I OBSptr1(1-Olx,1,1,1,iTr), aWght, bWght, myThid )
609 mlosch 1.5 # endif /* ALLOW_OBCS_SOUTH */
610 jmc 1.13 C end do iTr
611 mlosch 1.5 ENDDO
612     C end if (usePTRACERS)
613     ENDIF
614     #endif /* ALLOW_PTRACERS */
615    
616     RETURN
617     END
618    
619     CBOP
620     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
621     C !INTERFACE:
622 jmc 1.8 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
623     O fld,
624 mlosch 1.5 I fld0, fld1, aWght, bWght, myThid )
625     C !DESCRIPTION: \bv
626     C *==========================================================*
627 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
628 mlosch 1.5 C | o Interpolate between to records
629     C *==========================================================*
630     C \ev
631    
632     C !USES:
633     IMPLICIT NONE
634     C === Global variables ===
635     #include "SIZE.h"
636     #include "EEPARAMS.h"
637     #include "PARAMS.h"
638 jmc 1.8
639 mlosch 1.5 C !INPUT/OUTPUT PARAMETERS:
640     C === Routine arguments ===
641     C myThid - Thread no. that called this routine.
642     C aWght, bWght :: Interpolation weights
643     INTEGER myThid
644     _RL aWght,bWght
645     _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
646     _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
647     _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
648    
649     C !LOCAL VARIABLES:
650     C === Local arrays ===
651     C bi,bj,i,j :: loop counters
652     INTEGER bi,bj,i,k
653     CEOP
654     DO bj = myByLo(myThid), myByHi(myThid)
655     DO bi = myBxLo(myThid), myBxHi(myThid)
656     DO K = 1, Nr
657     DO i=1-Olx,sNx+Olx
658 jmc 1.8 fld(i,k,bi,bj) = bWght*fld0(i,k,bi,bj)
659 mlosch 1.5 & +aWght*fld1(i,k,bi,bj)
660 mlosch 1.2 ENDDO
661     ENDDO
662     ENDDO
663 jmc 1.7 ENDDO
664 mlosch 1.1
665     RETURN
666     END
667 mlosch 1.5 CBOP
668     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
669     C !INTERFACE:
670 jmc 1.8 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
671     O fld,
672 mlosch 1.5 I fld0, fld1, aWght, bWght, myThid )
673     C !DESCRIPTION: \bv
674     C *==========================================================*
675 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
676 mlosch 1.5 C | o Interpolate between to records
677     C *==========================================================*
678     C \ev
679    
680     C !USES:
681     IMPLICIT NONE
682     C === Global variables ===
683     #include "SIZE.h"
684     #include "EEPARAMS.h"
685     #include "PARAMS.h"
686 jmc 1.8
687 mlosch 1.5 C !INPUT/OUTPUT PARAMETERS:
688     C === Routine arguments ===
689     C myThid - Thread no. that called this routine.
690     C aWght, bWght :: Interpolation weights
691     INTEGER myThid
692     _RL aWght,bWght
693     _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
694     _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
695     _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
696    
697     C !LOCAL VARIABLES:
698     C === Local arrays ===
699     C bi,bj,i,j :: loop counters
700     INTEGER bi,bj,j,k
701     CEOP
702     DO bj = myByLo(myThid), myByHi(myThid)
703     DO bi = myBxLo(myThid), myBxHi(myThid)
704     DO K = 1, Nr
705     DO j=1-Oly,sNy+Oly
706 jmc 1.8 fld(j,k,bi,bj) = bWght*fld0(j,k,bi,bj)
707 mlosch 1.5 & +aWght*fld1(j,k,bi,bj)
708     ENDDO
709     ENDDO
710     ENDDO
711 jmc 1.13 ENDDO
712 mlosch 1.5
713 jmc 1.14 #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE */
714 mlosch 1.1
715 mlosch 1.5 RETURN
716     END

  ViewVC Help
Powered by ViewVC 1.1.22