/[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.23 - (hide annotations) (download)
Fri May 9 09:20:30 2008 UTC (16 years ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59r, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.22: +75 -53 lines
some bug fixes and clean-up for sea-ice open boundary conditions
for case where siobperiod is different from obcsperiod.

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

  ViewVC Help
Powered by ViewVC 1.1.22