/[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.14 - (hide annotations) (download)
Sun Oct 4 21:52:25 2009 UTC (14 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61w, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.13: +12 -13 lines
compile this S/R even if ALLOW_EXF is defined

1 jmc 1.14 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_external_fields_load.F,v 1.13 2009/09/01 19:40:45 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 mlosch 1.5 C msgBuf :: Informational/error meesage 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 mlosch 1.12 # ifdef NONLIN_FRSURF
143     IF ( OBEetaFile .NE. ' ' ) THEN
144 jmc 1.13 CALL READ_REC_YZ_RL(OBEetaFile,fp,1,OBEeta0,iRec0,myIter,myThid)
145     CALL READ_REC_YZ_RL(OBEetaFile,fp,1,OBEeta1,iRec1,myIter,myThid)
146 mlosch 1.12 ENDIF
147     # endif /* NONLIN_FRSURF */
148     #endif /* ALLOW_OBCS_EAST */
149 mlosch 1.1 #ifdef ALLOW_OBCS_WEST
150     C Western boundary
151     IF ( OBWuFile .NE. ' ' ) THEN
152 jmc 1.13 CALL READ_REC_YZ_RL( OBWuFile, fp,Nr,OBWu0,iRec0,myIter,myThid )
153     CALL READ_REC_YZ_RL( OBWuFile, fp,Nr,OBWu1,iRec1,myIter,myThid )
154 mlosch 1.1 ENDIF
155     IF ( OBWvFile .NE. ' ' ) THEN
156 jmc 1.13 CALL READ_REC_YZ_RL( OBWvFile, fp,Nr,OBWv0,iRec0,myIter,myThid )
157     CALL READ_REC_YZ_RL( OBWvFile, fp,Nr,OBWv1,iRec1,myIter,myThid )
158 mlosch 1.1 ENDIF
159 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
160 jmc 1.13 CALL READ_REC_YZ_RL( OBWtFile, fp,Nr,OBWt0,iRec0,myIter,myThid )
161     CALL READ_REC_YZ_RL( OBWtFile, fp,Nr,OBWt1,iRec1,myIter,myThid )
162 mlosch 1.1 ENDIF
163 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
164 jmc 1.13 CALL READ_REC_YZ_RL( OBWsFile, fp,Nr,OBWs0,iRec0,myIter,myThid )
165     CALL READ_REC_YZ_RL( OBWsFile, fp,Nr,OBWs1,iRec1,myIter,myThid )
166 mlosch 1.1 ENDIF
167 mlosch 1.12 # ifdef NONLIN_FRSURF
168     IF ( OBWetaFile .NE. ' ' ) THEN
169 jmc 1.13 CALL READ_REC_YZ_RL(OBWetaFile,fp,1,OBWeta0,iRec0,myIter,myThid)
170     CALL READ_REC_YZ_RL(OBWetaFile,fp,1,OBWeta1,iRec1,myIter,myThid)
171 mlosch 1.12 ENDIF
172     # endif /* NONLIN_FRSURF */
173 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
174     #ifdef ALLOW_OBCS_NORTH
175     C Northern boundary
176     IF ( OBNuFile .NE. ' ' ) THEN
177 jmc 1.13 CALL READ_REC_XZ_RL( OBNuFile, fp,Nr,OBNu0,iRec0,myIter,myThid )
178     CALL READ_REC_XZ_RL( OBNuFile, fp,Nr,OBNu1,iRec1,myIter,myThid )
179 mlosch 1.1 ENDIF
180     IF ( OBNvFile .NE. ' ' ) THEN
181 jmc 1.13 CALL READ_REC_XZ_RL( OBNvFile, fp,Nr,OBNv0,iRec0,myIter,myThid )
182     CALL READ_REC_XZ_RL( OBNvFile, fp,Nr,OBNv1,iRec1,myIter,myThid )
183 mlosch 1.1 ENDIF
184 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
185 jmc 1.13 CALL READ_REC_XZ_RL( OBNtFile, fp,Nr,OBNt0,iRec0,myIter,myThid )
186     CALL READ_REC_XZ_RL( OBNtFile, fp,Nr,OBNt1,iRec1,myIter,myThid )
187 mlosch 1.1 ENDIF
188 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
189 jmc 1.13 CALL READ_REC_XZ_RL( OBNsFile, fp,Nr,OBNs0,iRec0,myIter,myThid )
190     CALL READ_REC_XZ_RL( OBNsFile, fp,Nr,OBNs1,iRec1,myIter,myThid )
191 mlosch 1.1 ENDIF
192 mlosch 1.12 # ifdef NONLIN_FRSURF
193     IF ( OBNetaFile .NE. ' ' ) THEN
194 jmc 1.13 CALL READ_REC_XZ_RL(OBNetaFile,fp,1,OBNeta0,iRec0,myIter,myThid)
195     CALL READ_REC_XZ_RL(OBNetaFile,fp,1,OBNeta1,iRec1,myIter,myThid)
196 mlosch 1.12 ENDIF
197     # endif /* NONLIN_FRSURF */
198 mlosch 1.1 #endif /* ALLOW_OBCS_NORTH */
199     #ifdef ALLOW_OBCS_SOUTH
200     C Southern boundary
201     IF ( OBSuFile .NE. ' ' ) THEN
202 jmc 1.13 CALL READ_REC_XZ_RL( OBSuFile, fp,Nr,OBSu0,iRec0,myIter,myThid )
203     CALL READ_REC_XZ_RL( OBSuFile, fp,Nr,OBSu1,iRec1,myIter,myThid )
204 mlosch 1.1 ENDIF
205     IF ( OBSvFile .NE. ' ' ) THEN
206 jmc 1.13 CALL READ_REC_XZ_RL( OBSvFile, fp,Nr,OBSv0,iRec0,myIter,myThid )
207     CALL READ_REC_XZ_RL( OBSvFile, fp,Nr,OBSv1,iRec1,myIter,myThid )
208 mlosch 1.1 ENDIF
209 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
210 jmc 1.13 CALL READ_REC_XZ_RL( OBStFile, fp,Nr,OBSt0,iRec0,myIter,myThid )
211     CALL READ_REC_XZ_RL( OBStFile, fp,Nr,OBSt1,iRec1,myIter,myThid )
212 mlosch 1.1 ENDIF
213 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
214 jmc 1.13 CALL READ_REC_XZ_RL( OBSsFile, fp,Nr,OBSs0,iRec0,myIter,myThid )
215     CALL READ_REC_XZ_RL( OBSsFile, fp,Nr,OBSs1,iRec1,myIter,myThid )
216 mlosch 1.1 ENDIF
217 mlosch 1.12 # ifdef NONLIN_FRSURF
218     IF ( OBSetaFile .NE. ' ' ) THEN
219 jmc 1.13 CALL READ_REC_XZ_RL(OBSetaFile,fp,1,OBSeta0,iRec0,myIter,myThid)
220     CALL READ_REC_XZ_RL(OBSetaFile,fp,1,OBSeta1,iRec1,myIter,myThid)
221 mlosch 1.12 ENDIF
222     # endif /* NONLIN_FRSURF */
223 mlosch 1.1 #endif /* ALLOW_OBCS_SOUTH */
224 mlosch 1.5 #ifdef ALLOW_PTRACERS
225     IF (usePTRACERS) THEN
226     C read boundary values for passive tracers
227 jmc 1.13 DO iTr = 1, PTRACERS_numInUse
228 mlosch 1.5 # ifdef ALLOW_OBCS_EAST
229     C Eastern boundary
230 jmc 1.13 IF ( OBEptrFile(iTr) .NE. ' ' ) THEN
231     CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
232     & OBEptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
233     CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
234     & OBEptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
235 mlosch 1.5 ENDIF
236     # endif /* ALLOW_OBCS_WEST */
237     # ifdef ALLOW_OBCS_WEST
238     C Western boundary
239 jmc 1.13 IF ( OBWptrFile(iTr) .NE. ' ' ) THEN
240     CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
241     & OBWptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
242     CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
243     & OBWptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
244 mlosch 1.5 ENDIF
245     # endif /* ALLOW_OBCS_WEST */
246     # ifdef ALLOW_OBCS_NORTH
247     C Northern boundary
248 jmc 1.13 IF ( OBNptrFile(iTr) .NE. ' ' ) THEN
249     CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
250     & OBNptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
251     CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
252     & OBNptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
253 mlosch 1.5 ENDIF
254     # endif /* ALLOW_OBCS_NORTH */
255     # ifdef ALLOW_OBCS_SOUTH
256     C Southern boundary
257 jmc 1.13 IF ( OBSptrFile(iTr) .NE. ' ' ) THEN
258     CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
259     & OBSptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
260     CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
261     & OBSptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
262 mlosch 1.5 ENDIF
263     # endif /* ALLOW_OBCS_SOUTH */
264 jmc 1.13 C end do iTr
265 mlosch 1.5 ENDDO
266     C end if (usePTRACERS)
267     ENDIF
268     #endif /* ALLOW_PTRACERS */
269 jmc 1.8
270 mlosch 1.1 C
271     C At this point in external_fields_load the input fields are exchanged.
272 jmc 1.8 C However, we do not have exchange routines for vertical
273 mlosch 1.1 C slices and they are not planned, either, so the approriate fields
274 jmc 1.8 C are exchanged after the open boundary conditions have been
275 mlosch 1.1 C applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
276 jmc 1.7 _BARRIER
277    
278     C end if time to read new data
279 mlosch 1.1 ENDIF
280    
281     C if not periodicForcing
282     ELSE
283 mlosch 1.5 aWght = 0. _d 0
284     bWght = 1. _d 0
285 mlosch 1.1 C read boundary values once and for all
286     IF ( myIter .EQ. nIter0 ) THEN
287 jmc 1.13 #ifndef ALLOW_MDSIO
288     STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
289     #endif /* ALLOW_MDSIO */
290 jmc 1.7 _BARRIER
291 mlosch 1.2 C Read constant boundary conditions only for myIter = nIter0
292 mlosch 1.5 WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
293 jmc 1.7 & 'OBCS_EXTERNAL_FIELDS_LOAD: Reading initial data:',
294 mlosch 1.5 & myIter, myTime
295     CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
296     & SQUEEZE_RIGHT,myThid)
297 jmc 1.13 iRec0 = 1
298    
299 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
300 mlosch 1.1 C Eastern boundary
301     IF ( OBEuFile .NE. ' ' ) THEN
302 jmc 1.13 CALL READ_REC_YZ_RL( OBEuFile,fp,Nr,OBEu0,iRec0,myIter,myThid )
303 mlosch 1.1 ENDIF
304     IF ( OBEvFile .NE. ' ' ) THEN
305 jmc 1.13 CALL READ_REC_YZ_RL( OBEvFile,fp,Nr,OBEv0,iRec0,myIter,myThid )
306 mlosch 1.1 ENDIF
307 mlosch 1.2 IF ( OBEtFile .NE. ' ' ) THEN
308 jmc 1.13 CALL READ_REC_YZ_RL( OBEtFile,fp,Nr,OBEt0,iRec0,myIter,myThid )
309 mlosch 1.1 ENDIF
310 mlosch 1.2 IF ( OBEsFile .NE. ' ' ) THEN
311 jmc 1.13 CALL READ_REC_YZ_RL( OBEsFile,fp,Nr,OBEs0,iRec0,myIter,myThid )
312 mlosch 1.1 ENDIF
313 mlosch 1.12 # ifdef NONLIN_FRSURF
314     IF ( OBEetaFile .NE. ' ' ) THEN
315 jmc 1.13 CALL READ_REC_YZ_RL( OBEetaFile, fp, 1, OBEeta0, iRec0,
316     & myIter, myThid )
317 mlosch 1.12 ENDIF
318     # endif /* NONLIN_FRSURF */
319 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
320     #ifdef ALLOW_OBCS_WEST
321     C Western boundary
322     IF ( OBWuFile .NE. ' ' ) THEN
323 jmc 1.13 CALL READ_REC_YZ_RL( OBWuFile,fp,Nr,OBWu0,iRec0,myIter,myThid )
324 mlosch 1.1 ENDIF
325     IF ( OBWvFile .NE. ' ' ) THEN
326 jmc 1.13 CALL READ_REC_YZ_RL( OBWvFile,fp,Nr,OBWv0,iRec0,myIter,myThid )
327 mlosch 1.1 ENDIF
328 mlosch 1.2 IF ( OBWtFile .NE. ' ' ) THEN
329 jmc 1.13 CALL READ_REC_YZ_RL( OBWtFile,fp,Nr,OBWt0,iRec0,myIter,myThid )
330 mlosch 1.1 ENDIF
331 mlosch 1.2 IF ( OBWsFile .NE. ' ' ) THEN
332 jmc 1.13 CALL READ_REC_YZ_RL( OBWsFile,fp,Nr,OBWs0,iRec0,myIter,myThid )
333 mlosch 1.1 ENDIF
334 mlosch 1.12 # ifdef NONLIN_FRSURF
335     IF ( OBWetaFile .NE. ' ' ) THEN
336 jmc 1.13 CALL READ_REC_YZ_RL( OBWetaFile, fp, 1, OBWeta0, iRec0,
337     & myIter, myThid )
338 mlosch 1.12 ENDIF
339     # endif /* NONLIN_FRSURF */
340 mlosch 1.1 #endif /* ALLOW_OBCS_WEST */
341     #ifdef ALLOW_OBCS_NORTH
342     C Northern boundary
343     IF ( OBNuFile .NE. ' ' ) THEN
344 jmc 1.13 CALL READ_REC_XZ_RL( OBNuFile,fp,Nr,OBNu0,iRec0,myIter,myThid )
345 mlosch 1.1 ENDIF
346     IF ( OBNvFile .NE. ' ' ) THEN
347 jmc 1.13 CALL READ_REC_XZ_RL( OBNvFile,fp,Nr,OBNv0,iRec0,myIter,myThid )
348 mlosch 1.1 ENDIF
349 mlosch 1.2 IF ( OBNtFile .NE. ' ' ) THEN
350 jmc 1.13 CALL READ_REC_XZ_RL( OBNtFile,fp,Nr,OBNt0,iRec0,myIter,myThid )
351 mlosch 1.1 ENDIF
352 mlosch 1.2 IF ( OBNsFile .NE. ' ' ) THEN
353 jmc 1.13 CALL READ_REC_XZ_RL( OBNsFile,fp,Nr,OBNs0,iRec0,myIter,myThid )
354 mlosch 1.1 ENDIF
355 mlosch 1.12 # ifdef NONLIN_FRSURF
356     IF ( OBNetaFile .NE. ' ' ) THEN
357 jmc 1.13 CALL READ_REC_XZ_RL( OBNetaFile, fp, 1, OBNeta0, iRec0,
358     & myIter, myThid )
359 mlosch 1.12 ENDIF
360     # endif /* NONLIN_FRSURF */
361 mlosch 1.1 #endif /* ALLOW_OBCS_NORTH */
362     #ifdef ALLOW_OBCS_SOUTH
363     C Southern boundary
364     IF ( OBSuFile .NE. ' ' ) THEN
365 jmc 1.13 CALL READ_REC_XZ_RL( OBSuFile,fp,Nr,OBSu0,iRec0,myIter,myThid )
366 mlosch 1.1 ENDIF
367     IF ( OBSvFile .NE. ' ' ) THEN
368 jmc 1.13 CALL READ_REC_XZ_RL( OBSvFile,fp,Nr,OBSv0,iRec0,myIter,myThid )
369 mlosch 1.1 ENDIF
370 mlosch 1.2 IF ( OBStFile .NE. ' ' ) THEN
371 jmc 1.13 CALL READ_REC_XZ_RL( OBStFile,fp,Nr,OBSt0,iRec0,myIter,myThid )
372 mlosch 1.1 ENDIF
373 mlosch 1.2 IF ( OBSsFile .NE. ' ' ) THEN
374 jmc 1.13 CALL READ_REC_XZ_RL( OBSsFile,fp,Nr,OBSs0,iRec0,myIter,myThid )
375 mlosch 1.1 ENDIF
376 mlosch 1.12 # ifdef NONLIN_FRSURF
377     IF ( OBSetaFile .NE. ' ' ) THEN
378 jmc 1.13 CALL READ_REC_XZ_RL( OBSetaFile, fp, 1, OBSeta0, iRec0,
379     & myIter, myThid )
380 mlosch 1.12 ENDIF
381     # endif /* NONLIN_FRSURF */
382 mlosch 1.1 #endif /* ALLOW_OBCS_SOUTH */
383 mlosch 1.5 #ifdef ALLOW_PTRACERS
384     IF (usePTRACERS) THEN
385     C read passive tracer boundary values
386 jmc 1.13 DO iTr = 1, PTRACERS_numInUse
387 mlosch 1.5 # ifdef ALLOW_OBCS_EAST
388     C Eastern boundary
389 jmc 1.13 IF ( OBEptrFile(iTr) .NE. ' ' ) THEN
390     CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
391     & OBEptr0(1-Oly,1,1,1,iTr), iRec0,myIter, myThid )
392 mlosch 1.5 ENDIF
393     # endif /* ALLOW_OBCS_WEST */
394     # ifdef ALLOW_OBCS_WEST
395     C Western boundary
396 jmc 1.13 IF ( OBWptrFile(iTr) .NE. ' ' ) THEN
397     CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
398     & OBWptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
399 mlosch 1.5 ENDIF
400     # endif /* ALLOW_OBCS_WEST */
401     # ifdef ALLOW_OBCS_NORTH
402     C Northern boundary
403 jmc 1.13 IF ( OBNptrFile(iTr) .NE. ' ' ) THEN
404     CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
405     & OBNptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
406 mlosch 1.5 ENDIF
407     # endif /* ALLOW_OBCS_NORTH */
408     # ifdef ALLOW_OBCS_SOUTH
409     C Southern boundary
410 jmc 1.13 IF ( OBSptrFile(iTr) .NE. ' ' ) THEN
411     CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
412     & OBSptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
413 mlosch 1.5 ENDIF
414     # endif /* ALLOW_OBCS_SOUTH */
415 jmc 1.13 C end do iTr
416 mlosch 1.5 ENDDO
417     C end if (usePTRACERS)
418     ENDIF
419     #endif /* ALLOW_PTRACERS */
420 jmc 1.7 _BARRIER
421 mlosch 1.1 C endif myIter .EQ. nIter0
422     ENDIF
423 mlosch 1.5 C endif for periodicForcing
424     ENDIF
425    
426     C-- Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
427 jmc 1.8 C-- For periodicForcing, aWght = 0. and bWght = 1. so that the
428     C-- interpolation boilds down to copying the time-independent
429 mlosch 1.5 C-- forcing field OBSu0 to OBSu
430 mlosch 1.2 #ifdef ALLOW_OBCS_EAST
431 jmc 1.8 IF ( OBEuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
432 mlosch 1.5 & OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
433 jmc 1.8 IF ( OBEvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
434 mlosch 1.5 & OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
435     IF ( OBEtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
436     & OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
437 jmc 1.8 IF ( OBEsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
438 mlosch 1.5 & OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
439 mlosch 1.12 # ifdef NONLIN_FRSURF
440     IF ( OBEetaFile .NE. ' ' ) THEN
441     DO bj = myByLo(myThid), myByHi(myThid)
442     DO bi = myBxLo(myThid), myBxHi(myThid)
443     DO j=1-Oly,sNy+Oly
444     OBEeta(j,bi,bj) = bWght*OBEeta0(j,bi,bj)
445     & +aWght*OBEeta1(j,bi,bj)
446     ENDDO
447     ENDDO
448 jmc 1.13 ENDDO
449 mlosch 1.12 ENDIF
450     # endif /* NONLIN_FRSURF */
451 mlosch 1.2 #endif /* ALLOW_OBCS_EAST */
452     #ifdef ALLOW_OBCS_WEST
453 jmc 1.8 IF ( OBWuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
454 mlosch 1.5 & OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
455 jmc 1.8 IF ( OBWvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
456 mlosch 1.5 & OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
457     IF ( OBWtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
458     & OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
459 jmc 1.8 IF ( OBWsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
460 mlosch 1.5 & OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
461 mlosch 1.12 # ifdef NONLIN_FRSURF
462     IF ( OBWetaFile .NE. ' ' ) THEN
463     DO bj = myByLo(myThid), myByHi(myThid)
464     DO bi = myBxLo(myThid), myBxHi(myThid)
465     DO j=1-Oly,sNy+Oly
466     OBWeta(j,bi,bj) = bWght*OBWeta0(j,bi,bj)
467     & +aWght*OBWeta1(j,bi,bj)
468     ENDDO
469     ENDDO
470 jmc 1.13 ENDDO
471 mlosch 1.12 ENDIF
472     # endif /* NONLIN_FRSURF */
473 mlosch 1.2 #endif /* ALLOW_OBCS_WEST */
474     #ifdef ALLOW_OBCS_NORTH
475 jmc 1.8 IF ( OBNuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
476 mlosch 1.5 & OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
477 jmc 1.8 IF ( OBNvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
478 mlosch 1.5 & OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
479     IF ( OBNtFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
480     & OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
481 jmc 1.8 IF ( OBNsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
482 mlosch 1.5 & OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
483 mlosch 1.12 # ifdef NONLIN_FRSURF
484     IF ( OBNetaFile .NE. ' ' ) THEN
485     DO bj = myByLo(myThid), myByHi(myThid)
486     DO bi = myBxLo(myThid), myBxHi(myThid)
487     DO i=1-Olx,sNx+Olx
488     OBNeta(i,bi,bj) = bWght*OBNeta0(i,bi,bj)
489     & +aWght*OBNeta1(i,bi,bj)
490     ENDDO
491     ENDDO
492 jmc 1.13 ENDDO
493 mlosch 1.12 ENDIF
494     # endif /* NONLIN_FRSURF */
495 mlosch 1.2 #endif /* ALLOW_OBCS_NORTH */
496     #ifdef ALLOW_OBCS_SOUTH
497 jmc 1.8 IF ( OBSuFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
498 mlosch 1.5 & OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
499 jmc 1.8 IF ( OBSvFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
500 mlosch 1.5 & OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
501     IF ( OBStFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
502     & OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
503 jmc 1.8 IF ( OBSsFile .NE. ' ' ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
504 mlosch 1.5 & OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
505 mlosch 1.12 # ifdef NONLIN_FRSURF
506     IF ( OBSetaFile .NE. ' ' ) THEN
507     DO bj = myByLo(myThid), myByHi(myThid)
508     DO bi = myBxLo(myThid), myBxHi(myThid)
509     DO i=1-Olx,sNx+Olx
510     OBSeta(i,bi,bj) = bWght*OBSeta0(i,bi,bj)
511     & +aWght*OBSeta1(i,bi,bj)
512     ENDDO
513     ENDDO
514 jmc 1.13 ENDDO
515 mlosch 1.12 ENDIF
516     # endif /* NONLIN_FRSURF */
517 mlosch 1.2 #endif /* ALLOW_OBCS_SOUTH */
518 mlosch 1.5 #ifdef ALLOW_PTRACERS
519     IF (usePTRACERS) THEN
520     C "interpolate" passive tracer boundary values
521 jmc 1.13 DO iTr = 1, PTRACERS_numInUse
522 mlosch 1.5 # ifdef ALLOW_OBCS_EAST
523 jmc 1.13 IF ( OBEptrFile(iTr) .NE. ' ' )
524 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
525 jmc 1.13 O OBEptr (1-Oly,1,1,1,iTr),
526     I OBEptr0(1-Oly,1,1,1,iTr),
527     I OBEptr1(1-Oly,1,1,1,iTr), aWght, bWght, myThid )
528 mlosch 1.5 # endif /* ALLOW_OBCS_EAST */
529     # ifdef ALLOW_OBCS_WEST
530 jmc 1.13 IF ( OBWptrFile(iTr) .NE. ' ' )
531 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
532 jmc 1.13 O OBWptr (1-Oly,1,1,1,iTr),
533     I OBWptr0(1-Oly,1,1,1,iTr),
534     I OBWptr1(1-Oly,1,1,1,iTr), aWght, bWght, myThid )
535 mlosch 1.5 # endif /* ALLOW_OBCS_WEST */
536     # ifdef ALLOW_OBCS_NORTH
537 jmc 1.13 IF ( OBNptrFile(iTr) .NE. ' ' )
538 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
539 jmc 1.13 O OBNptr (1-Olx,1,1,1,iTr),
540     I OBNptr0(1-Olx,1,1,1,iTr),
541     I OBNptr1(1-Olx,1,1,1,iTr), aWght, bWght, myThid )
542 mlosch 1.5 # endif /* ALLOW_OBCS_NORTH */
543     # ifdef ALLOW_OBCS_SOUTH
544 jmc 1.13 IF ( OBSptrFile(iTr) .NE. ' ' )
545 jmc 1.8 & CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
546 jmc 1.13 O OBSptr (1-Olx,1,1,1,iTr),
547     I OBSptr0(1-Olx,1,1,1,iTr),
548     I OBSptr1(1-Olx,1,1,1,iTr), aWght, bWght, myThid )
549 mlosch 1.5 # endif /* ALLOW_OBCS_SOUTH */
550 jmc 1.13 C end do iTr
551 mlosch 1.5 ENDDO
552     C end if (usePTRACERS)
553     ENDIF
554     #endif /* ALLOW_PTRACERS */
555    
556     RETURN
557     END
558    
559     CBOP
560     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
561     C !INTERFACE:
562 jmc 1.8 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
563     O fld,
564 mlosch 1.5 I fld0, fld1, aWght, bWght, myThid )
565     C !DESCRIPTION: \bv
566     C *==========================================================*
567 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
568 mlosch 1.5 C | o Interpolate between to records
569     C *==========================================================*
570     C \ev
571    
572     C !USES:
573     IMPLICIT NONE
574     C === Global variables ===
575     #include "SIZE.h"
576     #include "EEPARAMS.h"
577     #include "PARAMS.h"
578 jmc 1.8
579 mlosch 1.5 C !INPUT/OUTPUT PARAMETERS:
580     C === Routine arguments ===
581     C myThid - Thread no. that called this routine.
582     C aWght, bWght :: Interpolation weights
583     INTEGER myThid
584     _RL aWght,bWght
585     _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
586     _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
587     _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
588    
589     C !LOCAL VARIABLES:
590     C === Local arrays ===
591     C bi,bj,i,j :: loop counters
592     INTEGER bi,bj,i,k
593     CEOP
594     DO bj = myByLo(myThid), myByHi(myThid)
595     DO bi = myBxLo(myThid), myBxHi(myThid)
596     DO K = 1, Nr
597     DO i=1-Olx,sNx+Olx
598 jmc 1.8 fld(i,k,bi,bj) = bWght*fld0(i,k,bi,bj)
599 mlosch 1.5 & +aWght*fld1(i,k,bi,bj)
600 mlosch 1.2 ENDDO
601     ENDDO
602     ENDDO
603 jmc 1.7 ENDDO
604 mlosch 1.1
605     RETURN
606     END
607 mlosch 1.5 CBOP
608     C !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
609     C !INTERFACE:
610 jmc 1.8 SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
611     O fld,
612 mlosch 1.5 I fld0, fld1, aWght, bWght, myThid )
613     C !DESCRIPTION: \bv
614     C *==========================================================*
615 jmc 1.8 C | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
616 mlosch 1.5 C | o Interpolate between to records
617     C *==========================================================*
618     C \ev
619    
620     C !USES:
621     IMPLICIT NONE
622     C === Global variables ===
623     #include "SIZE.h"
624     #include "EEPARAMS.h"
625     #include "PARAMS.h"
626 jmc 1.8
627 mlosch 1.5 C !INPUT/OUTPUT PARAMETERS:
628     C === Routine arguments ===
629     C myThid - Thread no. that called this routine.
630     C aWght, bWght :: Interpolation weights
631     INTEGER myThid
632     _RL aWght,bWght
633     _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
634     _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
635     _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
636    
637     C !LOCAL VARIABLES:
638     C === Local arrays ===
639     C bi,bj,i,j :: loop counters
640     INTEGER bi,bj,j,k
641     CEOP
642     DO bj = myByLo(myThid), myByHi(myThid)
643     DO bi = myBxLo(myThid), myBxHi(myThid)
644     DO K = 1, Nr
645     DO j=1-Oly,sNy+Oly
646 jmc 1.8 fld(j,k,bi,bj) = bWght*fld0(j,k,bi,bj)
647 mlosch 1.5 & +aWght*fld1(j,k,bi,bj)
648     ENDDO
649     ENDDO
650     ENDDO
651 jmc 1.13 ENDDO
652 mlosch 1.5
653 jmc 1.14 #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE */
654 mlosch 1.1
655 mlosch 1.5 RETURN
656     END

  ViewVC Help
Powered by ViewVC 1.1.22