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

Annotation of /MITgcm/pkg/obcs/obcs_prescribe_read.F

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


Revision 1.27 - (hide annotations) (download)
Wed Jan 12 09:05:37 2011 UTC (13 years, 5 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint62s, checkpoint62r, checkpoint62t
Changes since 1.26: +10 -10 lines
move 'CALL OBCS_EXTERNAL_FIELDS_LOAD' up, so that the calls of the
  ctrl_* subroutines are really at the end of the routines.

1 mlosch 1.27 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_prescribe_read.F,v 1.26 2010/12/19 20:29:29 heimbach Exp $
2 heimbach 1.1 C $Name: $
3    
4     # include "OBCS_OPTIONS.h"
5    
6 jmc 1.15 subroutine obcs_prescribe_read (
7 heimbach 1.1 I mycurrenttime
8     I , mycurrentiter
9     I , mythid
10     & )
11     c |==================================================================|
12     c | SUBROUTINE obcs_prescribe_read |
13     c |==================================================================|
14     c | read open boundary conditions from file |
15     c | N.B.: * uses exf and cal routines for file/record handling |
16     c | * uses ctrl routines for control variable handling |
17     c |==================================================================|
18    
19     implicit none
20    
21     c == global variables ==
22    
23 jmc 1.15 #include "SIZE.h"
24 heimbach 1.1 #include "EEPARAMS.h"
25 jmc 1.15 #include "PARAMS.h"
26 heimbach 1.1 #include "OBCS.h"
27     #ifdef ALLOW_EXF
28 jmc 1.10 # include "EXF_PARAM.h"
29 heimbach 1.1 #endif
30 dimitri 1.12 #ifdef ALLOW_PTRACERS
31 mlosch 1.7 # include "PTRACERS_SIZE.h"
32     # include "OBCS_PTRACERS.h"
33     #endif /* ALLOW_PTRACERS */
34 heimbach 1.1
35     c == routine arguments ==
36    
37     _RL mycurrenttime
38     integer mycurrentiter
39     integer mythid
40    
41     #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_PRESCRIBE))
42    
43     c == local variables ==
44    
45 mlosch 1.16 c == end of interface ==
46    
47 dimitri 1.19 # ifdef ALLOW_EXF
48 mlosch 1.16 IF ( useEXF ) THEN
49 dimitri 1.19 # ifdef ALLOW_OBCS_NORTH
50 mlosch 1.16 call obcs_prescribe_exf_xz (
51     I obcsNstartdate, obcsNperiod,
52     I useOBCSYearlyFields,
53     U OBNu, OBNu0, OBNu1, OBNufile,
54     U OBNv, OBNv0, OBNv1, OBNvfile,
55     U OBNt, OBNt0, OBNt1, OBNtfile,
56     U OBNs, OBNs0, OBNs1, OBNsfile,
57 mlosch 1.25 # ifdef NONLIN_FRSURF
58     U OBNeta, OBNeta0, OBNeta1, OBNetafile,
59     # endif
60 dimitri 1.19 # ifdef ALLOW_SEAICE
61     I siobNstartdate, siobNperiod,
62 mlosch 1.16 U OBNa, OBNa0, OBNa1, OBNafile,
63     U OBNh, OBNh0, OBNh1, OBNhfile,
64     U OBNsl, OBNsl0, OBNsl1, OBNslfile,
65     U OBNsn, OBNsn0, OBNsn1, OBNsnfile,
66     U OBNuice,OBNuice0,OBNuice1,OBNuicefile,
67     U OBNvice,OBNvice0,OBNvice1,OBNvicefile,
68 dimitri 1.19 # endif
69     # ifdef ALLOW_PTRACERS
70 mlosch 1.16 U OBNptr ,OBNptr0, OBNptr1, OBNptrFile,
71 dimitri 1.19 # endif
72 mlosch 1.16 I mycurrenttime, mycurrentiter, mythid
73     & )
74 dimitri 1.19 # endif /* ALLOW_OBCS_NORTH */
75 mlosch 1.16
76 dimitri 1.19 # ifdef ALLOW_OBCS_SOUTH
77 mlosch 1.16 call obcs_prescribe_exf_xz (
78     I obcsSstartdate, obcsSperiod,
79     I useOBCSYearlyFields,
80     U OBSu, OBSu0, OBSu1, OBSufile,
81     U OBSv, OBSv0, OBSv1, OBSvfile,
82     U OBSt, OBSt0, OBSt1, OBStfile,
83     U OBSs, OBSs0, OBSs1, OBSsfile,
84 mlosch 1.25 # ifdef NONLIN_FRSURF
85     U OBSeta, OBSeta0, OBSeta1, OBSetafile,
86     # endif
87 dimitri 1.19 # ifdef ALLOW_SEAICE
88     I siobSstartdate, siobSperiod,
89 mlosch 1.16 U OBSa, OBSa0, OBSa1, OBSafile,
90     U OBSh, OBSh0, OBSh1, OBShfile,
91     U OBSsl, OBSsl0, OBSsl1, OBSslfile,
92     U OBSsn, OBSsn0, OBSsn1, OBSsnfile,
93     U OBSuice,OBSuice0,OBSuice1,OBSuicefile,
94     U OBSvice,OBSvice0,OBSvice1,OBSvicefile,
95 dimitri 1.19 # endif
96     # ifdef ALLOW_PTRACERS
97 mlosch 1.16 U OBSptr ,OBSptr0, OBSptr1, OBSptrFile,
98 dimitri 1.19 # endif
99 mlosch 1.16 I mycurrenttime, mycurrentiter, mythid
100     & )
101 dimitri 1.19 # endif /* ALLOW_OBCS_SOUTH */
102 mlosch 1.16
103 dimitri 1.19 # ifdef ALLOW_OBCS_EAST
104 mlosch 1.16 call obcs_prescribe_exf_yz (
105     I obcsEstartdate, obcsEperiod,
106     I useOBCSYearlyFields,
107     U OBEu, OBEu0, OBEu1, OBEufile,
108     U OBEv, OBEv0, OBEv1, OBEvfile,
109     U OBEt, OBEt0, OBEt1, OBEtfile,
110     U OBEs, OBEs0, OBEs1, OBEsfile,
111 mlosch 1.25 # ifdef NONLIN_FRSURF
112     U OBEeta, OBEeta0, OBEeta1, OBEetafile,
113     # endif
114 dimitri 1.19 # ifdef ALLOW_SEAICE
115     I siobEstartdate, siobEperiod,
116 mlosch 1.16 U OBEa, OBEa0, OBEa1, OBEafile,
117     U OBEh, OBEh0, OBEh1, OBEhfile,
118     U OBEsl, OBEsl0, OBEsl1, OBEslfile,
119     U OBEsn, OBEsn0, OBEsn1, OBEsnfile,
120     U OBEuice,OBEuice0,OBEuice1,OBEuicefile,
121     U OBEvice,OBEvice0,OBEvice1,OBEvicefile,
122 dimitri 1.19 # endif
123     # ifdef ALLOW_PTRACERS
124 mlosch 1.16 U OBEptr ,OBEptr0, OBEptr1, OBEptrFile,
125 dimitri 1.19 # endif
126 mlosch 1.16 I mycurrenttime, mycurrentiter, mythid
127     & )
128 dimitri 1.19 # endif /* ALLOW_OBCS_EAST */
129 mlosch 1.16
130 dimitri 1.19 # ifdef ALLOW_OBCS_WEST
131 mlosch 1.16 call obcs_prescribe_exf_yz (
132     I obcsWstartdate, obcsWperiod,
133     I useOBCSYearlyFields,
134     U OBWu, OBWu0, OBWu1, OBWufile,
135     U OBWv, OBWv0, OBWv1, OBWvfile,
136     U OBWt, OBWt0, OBWt1, OBWtfile,
137     U OBWs, OBWs0, OBWs1, OBWsfile,
138 mlosch 1.25 # ifdef NONLIN_FRSURF
139     U OBWeta, OBWeta0, OBWeta1, OBWetafile,
140     # endif
141 dimitri 1.19 # ifdef ALLOW_SEAICE
142 dimitri 1.23 I siobWstartdate, siobWperiod,
143 mlosch 1.16 U OBWa, OBWa0, OBWa1, OBWafile,
144     U OBWh, OBWh0, OBWh1, OBWhfile,
145     U OBWsl, OBWsl0, OBWsl1, OBWslfile,
146     U OBWsn, OBWsn0, OBWsn1, OBWsnfile,
147     U OBWuice,OBWuice0,OBWuice1,OBWuicefile,
148     U OBWvice,OBWvice0,OBWvice1,OBWvicefile,
149 dimitri 1.19 # endif
150     # ifdef ALLOW_PTRACERS
151 mlosch 1.16 U OBWptr ,OBWptr0, OBWptr1, OBWptrFile,
152 dimitri 1.19 # endif
153 mlosch 1.16 I mycurrenttime, mycurrentiter, mythid
154     & )
155 dimitri 1.19 # endif /* ALLOW_OBCS_WEST */
156 mlosch 1.16 C ENDIF useEXF
157     ENDIF
158 dimitri 1.19 # endif /* ALLOW_EXF */
159 mlosch 1.16
160 mlosch 1.27 IF ( .NOT. useEXF ) THEN
161     cph#ifndef ALLOW_AUTODIFF_TAMC
162     CALL OBCS_EXTERNAL_FIELDS_LOAD(
163     & myCurrentTime, myCurrentIter, myThid )
164     cph#else
165     cph STOP 'PH HAS DISABLED THIS RUNTIME OPTION FOR ALLOW_EXF'
166     cph#endif
167     ENDIF
168    
169 dimitri 1.19 # ifdef ALLOW_OBCS_CONTROL
170 mlosch 1.16 cgg WARNING: Assuming North Open Boundary exists and has same
171     cgg calendar information as other boundaries.
172     call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )
173 dimitri 1.19 # endif
174 mlosch 1.16
175 dimitri 1.19 # ifdef ALLOW_OBCSN_CONTROL
176 mlosch 1.16 call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )
177 dimitri 1.19 # endif
178 mlosch 1.16
179 dimitri 1.19 # ifdef ALLOW_OBCSS_CONTROL
180 mlosch 1.16 call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )
181 dimitri 1.19 # endif
182 mlosch 1.16
183 dimitri 1.19 # ifdef ALLOW_OBCSW_CONTROL
184 mlosch 1.16 call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )
185 dimitri 1.19 # endif
186 mlosch 1.16
187 dimitri 1.19 # ifdef ALLOW_OBCSE_CONTROL
188 mlosch 1.16 call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )
189 dimitri 1.19 # endif
190 mlosch 1.16
191 dimitri 1.19 #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE */
192 mlosch 1.16
193     RETURN
194     END
195    
196 dimitri 1.19
197 mlosch 1.16 C=========================================================================
198     C=========================================================================
199    
200     subroutine obcs_prescribe_exf_xz (
201     I obcsstartdate, obcsperiod,
202     I useYearlyFields,
203     U OBu, OBu0, OBu1, OBufile,
204     U OBv, OBv0, OBv1, OBvfile,
205     U OBt, OBt0, OBt1, OBtfile,
206     U OBs, OBs0, OBs1, OBsfile,
207 mlosch 1.25 #ifdef NONLIN_FRSURF
208     U OBeta, OBeta0, OBeta1, OBetafile,
209     #endif
210 dimitri 1.19 #ifdef ALLOW_SEAICE
211     I siobstartdate, siobperiod,
212 mlosch 1.16 U OBa, OBa0, OBa1, OBafile,
213     U OBh, OBh0, OBh1, OBhfile,
214     U OBsl, OBsl0, OBsl1, OBslfile,
215     U OBsn, OBsn0, OBsn1, OBsnfile,
216     U OBuice,OBuice0,OBuice1,OBuicefile,
217     U OBvice,OBvice0,OBvice1,OBvicefile,
218     #endif
219 dimitri 1.19 #ifdef ALLOW_PTRACERS
220 mlosch 1.16 U OBptr ,OBptr0, OBptr1, OBptrFile,
221     #endif
222     I mycurrenttime, mycurrentiter, mythid
223     & )
224     c |==================================================================|
225     c | SUBROUTINE obcs_prescribe_exf_xz |
226     c |==================================================================|
227     c | read open boundary conditions from file |
228     c | N.B.: * uses exf and cal routines for file/record handling |
229     c | * uses ctrl routines for control variable handling |
230     c |==================================================================|
231    
232     implicit none
233    
234     c == global variables ==
235    
236     #include "SIZE.h"
237     #include "EEPARAMS.h"
238     #include "PARAMS.h"
239 jmc 1.8 #ifdef ALLOW_EXF
240 mlosch 1.16 # include "EXF_PARAM.h"
241     #endif
242     #ifdef ALLOW_PTRACERS
243     # include "PTRACERS_SIZE.h"
244     # include "PTRACERS_PARAMS.h"
245     #endif /* ALLOW_PTRACERS */
246    
247     c == routine arguments ==
248    
249     _RL obcsstartdate
250     _RL obcsperiod
251     LOGICAL useYearlyFields
252     _RL OBu (1-Olx:sNx+Olx,Nr,nSx,nSy)
253     _RL OBv (1-Olx:sNx+Olx,Nr,nSx,nSy)
254     _RL OBt (1-Olx:sNx+Olx,Nr,nSx,nSy)
255     _RL OBs (1-Olx:sNx+Olx,Nr,nSx,nSy)
256     _RL OBu0 (1-Olx:sNx+Olx,Nr,nSx,nSy)
257     _RL OBv0 (1-Olx:sNx+Olx,Nr,nSx,nSy)
258     _RL OBt0 (1-Olx:sNx+Olx,Nr,nSx,nSy)
259     _RL OBs0 (1-Olx:sNx+Olx,Nr,nSx,nSy)
260     _RL OBu1 (1-Olx:sNx+Olx,Nr,nSx,nSy)
261     _RL OBv1 (1-Olx:sNx+Olx,Nr,nSx,nSy)
262     _RL OBt1 (1-Olx:sNx+Olx,Nr,nSx,nSy)
263     _RL OBs1 (1-Olx:sNx+Olx,Nr,nSx,nSy)
264     CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
265 mlosch 1.25 #ifdef NONLIN_FRSURF
266     _RL OBeta (1-Olx:sNx+Olx,nSx,nSy)
267     _RL OBeta0 (1-Olx:sNx+Olx,nSx,nSy)
268     _RL OBeta1 (1-Olx:sNx+Olx,nSx,nSy)
269     CHARACTER*(MAX_LEN_FNAM) OBetaFile
270     #endif
271 dimitri 1.19 #ifdef ALLOW_SEAICE
272     _RL siobstartdate
273     _RL siobperiod
274 mlosch 1.16 _RL OBa (1-Olx:sNx+Olx,nSx,nSy)
275     _RL OBh (1-Olx:sNx+Olx,nSx,nSy)
276     _RL OBa0 (1-Olx:sNx+Olx,nSx,nSy)
277     _RL OBh0 (1-Olx:sNx+Olx,nSx,nSy)
278     _RL OBa1 (1-Olx:sNx+Olx,nSx,nSy)
279     _RL OBh1 (1-Olx:sNx+Olx,nSx,nSy)
280     _RL OBsl (1-Olx:sNx+Olx,nSx,nSy)
281     _RL OBsn (1-Olx:sNx+Olx,nSx,nSy)
282     _RL OBsl0 (1-Olx:sNx+Olx,nSx,nSy)
283     _RL OBsn0 (1-Olx:sNx+Olx,nSx,nSy)
284     _RL OBsl1 (1-Olx:sNx+Olx,nSx,nSy)
285     _RL OBsn1 (1-Olx:sNx+Olx,nSx,nSy)
286     _RL OBuice (1-Olx:sNx+Olx,nSx,nSy)
287     _RL OBvice (1-Olx:sNx+Olx,nSx,nSy)
288     _RL OBuice0 (1-Olx:sNx+Olx,nSx,nSy)
289     _RL OBvice0 (1-Olx:sNx+Olx,nSx,nSy)
290     _RL OBuice1 (1-Olx:sNx+Olx,nSx,nSy)
291     _RL OBvice1 (1-Olx:sNx+Olx,nSx,nSy)
292     CHARACTER*(MAX_LEN_FNAM)
293     & OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
294     #endif /* ALLOW_SEAICE */
295 dimitri 1.19 #ifdef ALLOW_PTRACERS
296 mlosch 1.16 _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
297     _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
298     _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
299     CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
300     #endif /* ALLOW_PTRACERS */
301     _RL mycurrenttime
302     integer mycurrentiter
303     integer mythid
304    
305     #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
306     && defined ALLOW_EXF
307    
308     c == local variables ==
309 heimbach 1.1 logical first, changed
310     integer count0, count1
311 heimbach 1.5 integer year0, year1
312 heimbach 1.1 _RL fac
313 dimitri 1.19 # ifdef ALLOW_PTRACERS
314 mlosch 1.17 integer iTracer
315 dimitri 1.19 # endif /* ALLOW_PTRACERS */
316 dimitri 1.23 c == end of interface ==
317 heimbach 1.1
318 mlosch 1.24 if ( obcsperiod .eq. -12. _d 0 ) then
319 mlosch 1.16 c obcsperiod=-12 means input file contains 12 monthly means
320     c record numbers are assumed 1 to 12 corresponding to
321     c Jan. through Dec.
322     call cal_GetMonthsRec(
323     O fac, first, changed,
324     O count0, count1,
325     I mycurrenttime, mycurrentiter, mythid
326     & )
327    
328 mlosch 1.24 elseif ( obcsperiod .lt. 0. _d 0 ) then
329 mlosch 1.16 print *, 'obcsperiod is out of range'
330     STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
331     else
332     c get record numbers and interpolation factor
333     call exf_GetFFieldRec(
334     I obcsstartdate, obcsperiod,
335     I useYearlyFields,
336     O fac, first, changed,
337     O count0, count1, year0, year1,
338     I mycurrenttime, mycurrentiter, mythid
339     & )
340     endif
341     call exf_set_obcs_xz( OBu, OBu0, OBu1, OBufile, 'u'
342     I , fac, first, changed, useYearlyFields
343     I , obcsperiod, count0, count1, year0, year1
344     I , mycurrenttime, mycurrentiter, mythid )
345     call exf_set_obcs_xz( OBv, OBv0, OBv1, OBvfile, 'v'
346     I , fac, first, changed, useYearlyFields
347     I , obcsperiod, count0, count1, year0, year1
348     I , mycurrenttime, mycurrentiter, mythid )
349     call exf_set_obcs_xz( OBt, OBt0, OBt1, OBtfile, 's'
350     I , fac, first, changed, useYearlyFields
351     I , obcsperiod, count0, count1, year0, year1
352     I , mycurrenttime, mycurrentiter, mythid )
353     call exf_set_obcs_xz( OBs, OBs0, OBs1, OBsfile, 's'
354     I , fac, first, changed, useYearlyFields
355     I , obcsperiod, count0, count1, year0, year1
356 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid )
357 mlosch 1.25 # ifdef NONLIN_FRSURF
358     call exf_set_obcs_x ( OBeta, OBeta0, OBeta1, OBetaFile, 's'
359     I , fac, first, changed, useYearlyFields
360     I , obcsperiod, count0, count1, year0, year1
361     I , mycurrenttime, mycurrentiter, mythid )
362     # endif /* NONLIN_FRSURF */
363 dimitri 1.23 # ifdef ALLOW_PTRACERS
364     if ( usePTRACERS ) then
365     do iTracer = 1, PTRACERS_numInUse
366     call exf_set_obcs_xz( OBptr (1-Olx,1,1,1,iTracer)
367     I , OBptr0(1-Olx,1,1,1,iTracer)
368     I , OBptr1(1-Olx,1,1,1,iTracer)
369     I , OBptrFile(iTracer), 's'
370     I , fac, first, changed, useYearlyFields
371     I , obcsperiod, count0, count1, year0, year1
372     I , mycurrenttime, mycurrentiter, mythid )
373     enddo
374     endif
375     # endif /* ALLOW_PTRACERS */
376 dimitri 1.19 # ifdef ALLOW_SEAICE
377 dimitri 1.12 IF (useSEAICE) THEN
378 mlosch 1.24 if ( siobperiod .eq. -12. _d 0 ) then
379 dimitri 1.23 c siobperiod=-12 means input file contains 12 monthly means
380     c record numbers are assumed 1 to 12 corresponding to
381     c Jan. through Dec.
382     call cal_GetMonthsRec(
383     O fac, first, changed,
384     O count0, count1,
385     I mycurrenttime, mycurrentiter, mythid
386     & )
387    
388 mlosch 1.24 elseif ( siobperiod .lt. 0. _d 0 ) then
389 dimitri 1.23 print *, 'siobperiod is out of range'
390     STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
391     else
392     c get record numbers and interpolation factor
393     call exf_GetFFieldRec(
394     I siobstartdate, siobperiod,
395     I useYearlyFields,
396     O fac, first, changed,
397     O count0, count1, year0, year1,
398     I mycurrenttime, mycurrentiter, mythid
399     & )
400     endif
401 mlosch 1.16 call exf_set_obcs_x ( OBa, OBa0, OBa1, OBafile, 's'
402     I , fac, first, changed, useYearlyFields
403 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
404 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
405     call exf_set_obcs_x ( OBh, OBh0, OBh1, OBhfile, 's'
406     I , fac, first, changed, useYearlyFields
407 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
408 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
409     call exf_set_obcs_x ( OBsl, OBsl0, OBsl1, OBslfile, 's'
410     I , fac, first, changed, useYearlyFields
411 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
412 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
413     call exf_set_obcs_x ( OBsn, OBsn0, OBsn1, OBsnfile, 's'
414     I , fac, first, changed, useYearlyFields
415 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
416 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
417 dimitri 1.22 call exf_set_obcs_x ( OBuice,OBuice0,OBuice1,OBuicefile,'u'
418 mlosch 1.16 I , fac, first, changed, useYearlyFields
419 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
420 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
421 dimitri 1.22 call exf_set_obcs_x ( OBvice,OBvice0,OBvice1,OBvicefile,'v'
422 mlosch 1.16 I , fac, first, changed, useYearlyFields
423 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
424 dimitri 1.14 I , mycurrenttime, mycurrentiter, mythid )
425 dimitri 1.12 ENDIF
426 dimitri 1.19 # endif /* ALLOW_SEAICE */
427 heimbach 1.1
428 mlosch 1.16 #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
429     RETURN
430     END
431     C=========================================================================
432     C=========================================================================
433    
434     subroutine obcs_prescribe_exf_yz (
435     I obcsstartdate, obcsperiod,
436     I useYearlyFields,
437     U OBu, OBu0, OBu1, OBufile,
438     U OBv, OBv0, OBv1, OBvfile,
439     U OBt, OBt0, OBt1, OBtfile,
440     U OBs, OBs0, OBs1, OBsfile,
441 mlosch 1.25 #ifdef NONLIN_FRSURF
442     U OBeta, OBeta0, OBeta1, OBetafile,
443     #endif
444 dimitri 1.19 #ifdef ALLOW_SEAICE
445     I siobstartdate, siobperiod,
446 mlosch 1.16 U OBa, OBa0, OBa1, OBafile,
447     U OBh, OBh0, OBh1, OBhfile,
448     U OBsl, OBsl0, OBsl1, OBslfile,
449     U OBsn, OBsn0, OBsn1, OBsnfile,
450     U OBuice,OBuice0,OBuice1,OBuicefile,
451     U OBvice,OBvice0,OBvice1,OBvicefile,
452     #endif
453 dimitri 1.19 #ifdef ALLOW_PTRACERS
454 mlosch 1.16 U OBptr ,OBptr0, OBptr1, OBptrFile,
455     #endif
456     I mycurrenttime, mycurrentiter, mythid
457     & )
458     c |==================================================================|
459     c | SUBROUTINE obcs_prescribe_exf_yz |
460     c |==================================================================|
461     c | read open boundary conditions from file |
462     c | N.B.: * uses exf and cal routines for file/record handling |
463     c | * uses ctrl routines for control variable handling |
464     c |==================================================================|
465    
466     implicit none
467    
468     c == global variables ==
469 heimbach 1.1
470 mlosch 1.16 #include "SIZE.h"
471     #include "EEPARAMS.h"
472     #include "PARAMS.h"
473     #ifdef ALLOW_EXF
474     # include "EXF_PARAM.h"
475     #endif
476 mlosch 1.7 #ifdef ALLOW_PTRACERS
477 mlosch 1.16 # include "PTRACERS_SIZE.h"
478     # include "PTRACERS_PARAMS.h"
479 mlosch 1.7 #endif /* ALLOW_PTRACERS */
480 heimbach 1.1
481 mlosch 1.16 c == routine arguments ==
482 heimbach 1.1
483 mlosch 1.16 _RL obcsstartdate
484     _RL obcsperiod
485     LOGICAL useYearlyFields
486     _RL OBu (1-Oly:sNy+Oly,Nr,nSx,nSy)
487     _RL OBv (1-Oly:sNy+Oly,Nr,nSx,nSy)
488     _RL OBt (1-Oly:sNy+Oly,Nr,nSx,nSy)
489     _RL OBs (1-Oly:sNy+Oly,Nr,nSx,nSy)
490     _RL OBu0 (1-Oly:sNy+Oly,Nr,nSx,nSy)
491     _RL OBv0 (1-Oly:sNy+Oly,Nr,nSx,nSy)
492     _RL OBt0 (1-Oly:sNy+Oly,Nr,nSx,nSy)
493     _RL OBs0 (1-Oly:sNy+Oly,Nr,nSx,nSy)
494     _RL OBu1 (1-Oly:sNy+Oly,Nr,nSx,nSy)
495     _RL OBv1 (1-Oly:sNy+Oly,Nr,nSx,nSy)
496     _RL OBt1 (1-Oly:sNy+Oly,Nr,nSx,nSy)
497     _RL OBs1 (1-Oly:sNy+Oly,Nr,nSx,nSy)
498     CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
499 mlosch 1.25 #ifdef NONLIN_FRSURF
500     _RL OBeta (1-Olx:sNx+Olx,nSx,nSy)
501     _RL OBeta0 (1-Olx:sNx+Olx,nSx,nSy)
502     _RL OBeta1 (1-Olx:sNx+Olx,nSx,nSy)
503     CHARACTER*(MAX_LEN_FNAM) OBetaFile
504     #endif
505 dimitri 1.19 #ifdef ALLOW_SEAICE
506     _RL siobstartdate
507     _RL siobperiod
508 mlosch 1.16 _RL OBa (1-Oly:sNy+Oly,nSx,nSy)
509     _RL OBh (1-Oly:sNy+Oly,nSx,nSy)
510     _RL OBa0 (1-Oly:sNy+Oly,nSx,nSy)
511     _RL OBh0 (1-Oly:sNy+Oly,nSx,nSy)
512     _RL OBa1 (1-Oly:sNy+Oly,nSx,nSy)
513     _RL OBh1 (1-Oly:sNy+Oly,nSx,nSy)
514     _RL OBsl (1-Oly:sNy+Oly,nSx,nSy)
515     _RL OBsn (1-Oly:sNy+Oly,nSx,nSy)
516     _RL OBsl0 (1-Oly:sNy+Oly,nSx,nSy)
517     _RL OBsn0 (1-Oly:sNy+Oly,nSx,nSy)
518     _RL OBsl1 (1-Oly:sNy+Oly,nSx,nSy)
519     _RL OBsn1 (1-Oly:sNy+Oly,nSx,nSy)
520     _RL OBuice (1-Oly:sNy+Oly,nSx,nSy)
521     _RL OBvice (1-Oly:sNy+Oly,nSx,nSy)
522     _RL OBuice0 (1-Oly:sNy+Oly,nSx,nSy)
523     _RL OBvice0 (1-Oly:sNy+Oly,nSx,nSy)
524     _RL OBuice1 (1-Oly:sNy+Oly,nSx,nSy)
525     _RL OBvice1 (1-Oly:sNy+Oly,nSx,nSy)
526     CHARACTER*(MAX_LEN_FNAM)
527     & OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
528 dimitri 1.11 #endif /* ALLOW_SEAICE */
529 dimitri 1.19 #ifdef ALLOW_PTRACERS
530 mlosch 1.16 _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
531     _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
532     _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
533     CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
534     #endif /* ALLOW_PTRACERS */
535     _RL mycurrenttime
536     integer mycurrentiter
537     integer mythid
538    
539     #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
540     && defined ALLOW_EXF
541    
542     c == local variables ==
543     logical first, changed
544     integer count0, count1
545     integer year0, year1
546     _RL fac
547 dimitri 1.19 # ifdef ALLOW_PTRACERS
548 mlosch 1.17 integer iTracer
549 dimitri 1.19 # endif /* ALLOW_PTRACERS */
550 heimbach 1.1
551 mlosch 1.16 c == end of interface ==
552 mlosch 1.24 if ( obcsperiod .eq. -12. _d 0 ) then
553 mlosch 1.16 c obcsperiod=-12 means input file contains 12 monthly means
554     c record numbers are assumed 1 to 12 corresponding to
555     c Jan. through Dec.
556     call cal_GetMonthsRec(
557     O fac, first, changed,
558     O count0, count1,
559     I mycurrenttime, mycurrentiter, mythid
560     & )
561    
562 mlosch 1.24 elseif ( obcsperiod .lt. 0. _d 0 ) then
563 mlosch 1.16 print *, 'obcsperiod is out of range'
564     STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'
565     else
566     c get record numbers and interpolation factor
567     call exf_GetFFieldRec(
568     I obcsstartdate, obcsperiod,
569     I useYearlyFields,
570     O fac, first, changed,
571     O count0, count1, year0, year1,
572     I mycurrenttime, mycurrentiter, mythid
573     & )
574     endif
575     call exf_set_obcs_yz( OBu, OBu0, OBu1, OBufile, 'u'
576     I , fac, first, changed, useYearlyFields
577     I , obcsperiod, count0, count1, year0, year1
578     I , mycurrenttime, mycurrentiter, mythid )
579     call exf_set_obcs_yz( OBv, OBv0, OBv1, OBvfile, 'v'
580     I , fac, first, changed, useYearlyFields
581     I , obcsperiod, count0, count1, year0, year1
582     I , mycurrenttime, mycurrentiter, mythid )
583     call exf_set_obcs_yz( OBt, OBt0, OBt1, OBtfile, 's'
584     I , fac, first, changed, useYearlyFields
585     I , obcsperiod, count0, count1, year0, year1
586     I , mycurrenttime, mycurrentiter, mythid )
587     call exf_set_obcs_yz( OBs, OBs0, OBs1, OBsfile, 's'
588     I , fac, first, changed, useYearlyFields
589     I , obcsperiod, count0, count1, year0, year1
590 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid )
591 mlosch 1.25 # ifdef NONLIN_FRSURF
592     call exf_set_obcs_y ( OBeta, OBeta0, OBeta1, OBetaFile, 's'
593     I , fac, first, changed, useYearlyFields
594     I , obcsperiod, count0, count1, year0, year1
595     I , mycurrenttime, mycurrentiter, mythid )
596     # endif /* NONLIN_FRSURF */
597 dimitri 1.23 # ifdef ALLOW_PTRACERS
598     if ( usePTRACERS ) then
599     do iTracer = 1, PTRACERS_numInUse
600     call exf_set_obcs_yz( OBptr (1-Olx,1,1,1,iTracer)
601     I , OBptr0(1-Olx,1,1,1,iTracer)
602     I , OBptr1(1-Olx,1,1,1,iTracer)
603     I , OBptrFile(iTracer), 's'
604     I , fac, first, changed, useYearlyFields
605     I , obcsperiod, count0, count1, year0, year1
606     I , mycurrenttime, mycurrentiter, mythid )
607     enddo
608     endif
609     # endif /* ALLOW_PTRACERS */
610 dimitri 1.19 # ifdef ALLOW_SEAICE
611 dimitri 1.12 IF (useSEAICE) THEN
612 mlosch 1.24 if ( siobperiod .eq. -12. _d 0 ) then
613 dimitri 1.23 c siobperiod=-12 means input file contains 12 monthly means
614     c record numbers are assumed 1 to 12 corresponding to
615     c Jan. through Dec.
616     call cal_GetMonthsRec(
617     O fac, first, changed,
618     O count0, count1,
619     I mycurrenttime, mycurrentiter, mythid
620     & )
621    
622 mlosch 1.24 elseif ( siobperiod .lt. 0. _d 0 ) then
623 dimitri 1.23 print *, 'siobperiod is out of range'
624     STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
625     else
626     c get record numbers and interpolation factor
627     call exf_GetFFieldRec(
628     I siobstartdate, siobperiod,
629     I useYearlyFields,
630     O fac, first, changed,
631     O count0, count1, year0, year1,
632     I mycurrenttime, mycurrentiter, mythid
633     & )
634     endif
635 mlosch 1.16 call exf_set_obcs_y ( OBa, OBa0, OBa1, OBafile, 's'
636     I , fac, first, changed, useYearlyFields
637 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
638 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
639     call exf_set_obcs_y ( OBh, OBh0, OBh1, OBhfile, 's'
640     I , fac, first, changed, useYearlyFields
641 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
642 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
643     call exf_set_obcs_y ( OBsl, OBsl0, OBsl1, OBslfile, 's'
644     I , fac, first, changed, useYearlyFields
645 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
646 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
647     call exf_set_obcs_y ( OBsn, OBsn0, OBsn1, OBsnfile, 's'
648     I , fac, first, changed, useYearlyFields
649 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
650 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
651 dimitri 1.22 call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'u'
652 mlosch 1.16 I , fac, first, changed, useYearlyFields
653 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
654 mlosch 1.16 I , mycurrenttime, mycurrentiter, mythid )
655 dimitri 1.22 call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'v'
656 mlosch 1.16 I , fac, first, changed, useYearlyFields
657 dimitri 1.19 I , siobperiod, count0, count1, year0, year1
658 dimitri 1.14 I , mycurrenttime, mycurrentiter, mythid )
659 dimitri 1.12 ENDIF
660 dimitri 1.19 # endif /* ALLOW_SEAICE */
661 heimbach 1.1
662 mlosch 1.16 #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
663 adcroft 1.6 RETURN
664     END

  ViewVC Help
Powered by ViewVC 1.1.22