/[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.15 - (hide annotations) (download)
Mon Nov 5 19:19:05 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59m, checkpoint59l, checkpoint59k, checkpoint59j
Changes since 1.14: +11 -12 lines
split PTRACERS.h in 2 header files: PTRACERS_FIELDS.h & PTRACERS_PARAMS.h

1 jmc 1.15 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_prescribe_read.F,v 1.14 2007/10/26 02:00:47 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 "GRID.h"
27     #include "OBCS.h"
28     #ifdef ALLOW_EXF
29 jmc 1.10 # include "EXF_PARAM.h"
30 heimbach 1.1 #endif
31 dimitri 1.12 #ifdef ALLOW_PTRACERS
32 mlosch 1.7 # include "PTRACERS_SIZE.h"
33 jmc 1.15 # include "PTRACERS_PARAMS.h"
34     # include "PTRACERS_FIELDS.h"
35 mlosch 1.7 # include "OBCS_PTRACERS.h"
36     #endif /* ALLOW_PTRACERS */
37 heimbach 1.1
38     c == routine arguments ==
39    
40     _RL mycurrenttime
41     integer mycurrentiter
42     integer mythid
43    
44     #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_PRESCRIBE))
45    
46     c == local variables ==
47    
48 jmc 1.8 #ifdef ALLOW_EXF
49 heimbach 1.1 logical first, changed
50     integer count0, count1
51 heimbach 1.5 integer year0, year1
52 heimbach 1.1 _RL fac
53 mlosch 1.7 #ifdef ALLOW_PTRACERS
54     integer iTracer, i,j,k
55     #endif /* ALLOW_PTRACERS */
56 jmc 1.8 #endif /* ALLOW_EXF */
57 heimbach 1.1
58     c == end of interface ==
59    
60 mlosch 1.2 #ifdef ALLOW_EXF
61 heimbach 1.1 #ifdef ALLOW_OBCS_NORTH
62     call exf_getffieldrec(
63     I obcsNstartdate, obcsNperiod
64 heimbach 1.3 I , obcsNstartdate1, obcsNstartdate2
65 heimbach 1.4 I , .false.
66 adcroft 1.6 O , fac, first, changed
67 heimbach 1.3 O , count0, count1, year0, year1
68 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid
69     & )
70    
71     call exf_set_obcs_xz( OBNu, OBNu0, OBNu1, OBNufile, 'u'
72     I , fac, first, changed, count0, count1
73     I , mycurrenttime, mycurrentiter, mythid )
74     call exf_set_obcs_xz( OBNv, OBNv0, OBNv1, OBNvfile, 'v'
75     I , fac, first, changed, count0, count1
76     I , mycurrenttime, mycurrentiter, mythid )
77     call exf_set_obcs_xz( OBNt, OBNt0, OBNt1, OBNtfile, 's'
78     I , fac, first, changed, count0, count1
79     I , mycurrenttime, mycurrentiter, mythid )
80     call exf_set_obcs_xz( OBNs, OBNs0, OBNs1, OBNsfile, 's'
81     I , fac, first, changed, count0, count1
82     I , mycurrenttime, mycurrentiter, mythid )
83 dimitri 1.11 #ifdef ALLOW_SEAICE
84 dimitri 1.12 IF (useSEAICE) THEN
85     call exf_set_obcs_x ( OBNa, OBNa0, OBNa1, OBNafile, 's'
86 dimitri 1.11 I , fac, first, changed, count0, count1
87     I , mycurrenttime, mycurrentiter, mythid )
88 dimitri 1.12 call exf_set_obcs_x ( OBNh, OBNh0, OBNh1, OBNhfile, 's'
89 dimitri 1.11 I , fac, first, changed, count0, count1
90     I , mycurrenttime, mycurrentiter, mythid )
91 dimitri 1.13 call exf_set_obcs_x ( OBNsl, OBNsl0, OBNsl1, OBNslfile, 's'
92     I , fac, first, changed, count0, count1
93     I , mycurrenttime, mycurrentiter, mythid )
94     call exf_set_obcs_x ( OBNsn, OBNsn0, OBNsn1, OBNsnfile, 's'
95     I , fac, first, changed, count0, count1
96     I , mycurrenttime, mycurrentiter, mythid )
97 dimitri 1.14 call exf_set_obcs_x ( OBNuice,OBNuice0,OBNuice1,OBNuicefile,'s'
98     I , fac, first, changed, count0, count1
99     I , mycurrenttime, mycurrentiter, mythid )
100     call exf_set_obcs_x ( OBNvice,OBNvice0,OBNvice1,OBNvicefile,'s'
101     I , fac, first, changed, count0, count1
102     I , mycurrenttime, mycurrentiter, mythid )
103 dimitri 1.12 ENDIF
104 dimitri 1.11 #endif /* ALLOW_SEAICE */
105 mlosch 1.7 #ifdef ALLOW_PTRACERS
106     if ( usePTRACERS ) then
107     do itracer = 1, PTRACERS_numInUse
108     call exf_set_obcs_xz( OBNptr (1-Olx,1,1,1,iTracer)
109     I , OBNptr0(1-Olx,1,1,1,iTracer)
110 jmc 1.15 I , OBNptr1(1-Olx,1,1,1,iTracer)
111 mlosch 1.7 I , OBNptrFile(iTracer), 's'
112     I , fac, first, changed, count0, count1
113     I , mycurrenttime, mycurrentiter, mythid )
114     enddo
115     endif
116     #endif /* ALLOW_PTRACERS */
117 dimitri 1.11 #endif /* ALLOW_OBCS_NORTH */
118 heimbach 1.1
119     #ifdef ALLOW_OBCS_SOUTH
120     call exf_getffieldrec(
121     I obcsSstartdate, obcsSperiod
122 heimbach 1.3 I , obcsSstartdate1, obcsSstartdate2
123 heimbach 1.4 I , .false.
124     O , fac, first, changed
125     O , count0, count1, year0, year1
126 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid
127     & )
128    
129     call exf_set_obcs_xz( OBSu, OBSu0, OBSu1, OBSufile, 'u'
130     I , fac, first, changed, count0, count1
131     I , mycurrenttime, mycurrentiter, mythid )
132     call exf_set_obcs_xz( OBSv, OBSv0, OBSv1, OBSvfile, 'v'
133     I , fac, first, changed, count0, count1
134     I , mycurrenttime, mycurrentiter, mythid )
135     call exf_set_obcs_xz( OBSt, OBSt0, OBSt1, OBStfile, 's'
136     I , fac, first, changed, count0, count1
137     I , mycurrenttime, mycurrentiter, mythid )
138     call exf_set_obcs_xz( OBSs, OBSs0, OBSs1, OBSsfile, 's'
139     I , fac, first, changed, count0, count1
140     I , mycurrenttime, mycurrentiter, mythid )
141 dimitri 1.11 #ifdef ALLOW_SEAICE
142 dimitri 1.12 IF (useSEAICE) THEN
143     call exf_set_obcs_x ( OBSa, OBSa0, OBSa1, OBSafile, 's'
144 dimitri 1.11 I , fac, first, changed, count0, count1
145     I , mycurrenttime, mycurrentiter, mythid )
146 dimitri 1.12 call exf_set_obcs_x ( OBSh, OBSh0, OBSh1, OBShfile, 's'
147 dimitri 1.11 I , fac, first, changed, count0, count1
148     I , mycurrenttime, mycurrentiter, mythid )
149 dimitri 1.13 call exf_set_obcs_x ( OBSsl, OBSsl0, OBSsl1, OBSslfile, 's'
150     I , fac, first, changed, count0, count1
151     I , mycurrenttime, mycurrentiter, mythid )
152     call exf_set_obcs_x ( OBSsn, OBSsn0, OBSsn1, OBSsnfile, 's'
153     I , fac, first, changed, count0, count1
154     I , mycurrenttime, mycurrentiter, mythid )
155 dimitri 1.14 call exf_set_obcs_x ( OBSuice,OBSuice0,OBSuice1,OBSuicefile,'s'
156     I , fac, first, changed, count0, count1
157     I , mycurrenttime, mycurrentiter, mythid )
158     call exf_set_obcs_x ( OBSvice,OBSvice0,OBSvice1,OBSvicefile,'s'
159     I , fac, first, changed, count0, count1
160     I , mycurrenttime, mycurrentiter, mythid )
161 dimitri 1.12 ENDIF
162 dimitri 1.11 #endif /* ALLOW_SEAICE */
163 mlosch 1.7 #ifdef ALLOW_PTRACERS
164     if ( usePTRACERS ) then
165     do itracer = 1, PTRACERS_numInUse
166     call exf_set_obcs_xz( OBSptr (1-Olx,1,1,1,iTracer)
167     I , OBSptr0(1-Olx,1,1,1,iTracer)
168 jmc 1.15 I , OBSptr1(1-Olx,1,1,1,iTracer)
169 mlosch 1.7 I , OBSptrFile(iTracer), 's'
170     I , fac, first, changed, count0, count1
171     I , mycurrenttime, mycurrentiter, mythid )
172     enddo
173     endif
174     #endif /* ALLOW_PTRACERS */
175 dimitri 1.11 #endif /* ALLOW_OBCS_SOUTH */
176 heimbach 1.1
177     #ifdef ALLOW_OBCS_EAST
178     call exf_getffieldrec(
179     I obcsEstartdate, obcsEperiod
180 heimbach 1.3 I , obcsEstartdate1, obcsEstartdate2
181 heimbach 1.4 I , .false.
182     O , fac, first, changed
183     O , count0, count1, year0, year1
184 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid
185     & )
186    
187     call exf_set_obcs_yz( OBEu, OBEu0, OBEu1, OBEufile, 'u'
188     I , fac, first, changed, count0, count1
189     I , mycurrenttime, mycurrentiter, mythid )
190     call exf_set_obcs_yz( OBEv, OBEv0, OBEv1, OBEvfile, 'v'
191     I , fac, first, changed, count0, count1
192     I , mycurrenttime, mycurrentiter, mythid )
193     call exf_set_obcs_yz( OBEt, OBEt0, OBEt1, OBEtfile, 's'
194     I , fac, first, changed, count0, count1
195     I , mycurrenttime, mycurrentiter, mythid )
196     call exf_set_obcs_yz( OBEs, OBEs0, OBEs1, OBEsfile, 's'
197     I , fac, first, changed, count0, count1
198     I , mycurrenttime, mycurrentiter, mythid )
199 dimitri 1.11 #ifdef ALLOW_SEAICE
200 dimitri 1.12 IF (useSEAICE) THEN
201     call exf_set_obcs_y ( OBEa, OBEa0, OBEa1, OBEafile, 's'
202 dimitri 1.11 I , fac, first, changed, count0, count1
203     I , mycurrenttime, mycurrentiter, mythid )
204 dimitri 1.12 call exf_set_obcs_y ( OBEh, OBEh0, OBEh1, OBEhfile, 's'
205 dimitri 1.11 I , fac, first, changed, count0, count1
206     I , mycurrenttime, mycurrentiter, mythid )
207 dimitri 1.13 call exf_set_obcs_y ( OBEsl, OBEsl0, OBEsl1, OBEslfile, 's'
208     I , fac, first, changed, count0, count1
209     I , mycurrenttime, mycurrentiter, mythid )
210     call exf_set_obcs_y ( OBEsn, OBEsn0, OBEsn1, OBEsnfile, 's'
211     I , fac, first, changed, count0, count1
212     I , mycurrenttime, mycurrentiter, mythid )
213 dimitri 1.14 call exf_set_obcs_y ( OBEuice,OBEuice0,OBEuice1,OBEuicefile,'s'
214     I , fac, first, changed, count0, count1
215     I , mycurrenttime, mycurrentiter, mythid )
216     call exf_set_obcs_y ( OBEvice,OBEvice0,OBEvice1,OBEvicefile,'s'
217     I , fac, first, changed, count0, count1
218     I , mycurrenttime, mycurrentiter, mythid )
219 dimitri 1.12 ENDIF
220 dimitri 1.11 #endif /* ALLOW_SEAICE */
221 mlosch 1.7 #ifdef ALLOW_PTRACERS
222     if ( usePTRACERS ) then
223     do itracer = 1, PTRACERS_numInUse
224     call exf_set_obcs_yz( OBEptr (1-Oly,1,1,1,iTracer)
225     I , OBEptr0(1-Oly,1,1,1,iTracer)
226 jmc 1.15 I , OBEptr1(1-Oly,1,1,1,iTracer)
227 mlosch 1.7 I , OBEptrFile(iTracer), 's'
228     I , fac, first, changed, count0, count1
229     I , mycurrenttime, mycurrentiter, mythid )
230     enddo
231     endif
232     #endif /* ALLOW_PTRACERS */
233 dimitri 1.11 #endif /* ALLOW_OBCS_EAST */
234 heimbach 1.1
235     #ifdef ALLOW_OBCS_WEST
236     call exf_getffieldrec(
237     I obcsWstartdate, obcsWperiod
238 heimbach 1.3 I , obcsWstartdate1, obcsWstartdate2
239 heimbach 1.4 I , .false.
240     O , fac, first, changed
241     O , count0, count1, year0, year1
242 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid
243     & )
244    
245     call exf_set_obcs_yz( OBWu, OBWu0, OBWu1, OBWufile, 'u'
246     I , fac, first, changed, count0, count1
247     I , mycurrenttime, mycurrentiter, mythid )
248     call exf_set_obcs_yz( OBWv, OBWv0, OBWv1, OBWvfile, 'v'
249     I , fac, first, changed, count0, count1
250     I , mycurrenttime, mycurrentiter, mythid )
251     call exf_set_obcs_yz( OBWt, OBWt0, OBWt1, OBWtfile, 's'
252     I , fac, first, changed, count0, count1
253     I , mycurrenttime, mycurrentiter, mythid )
254     call exf_set_obcs_yz( OBWs, OBWs0, OBWs1, OBWsfile, 's'
255     I , fac, first, changed, count0, count1
256     I , mycurrenttime, mycurrentiter, mythid )
257 dimitri 1.11 #ifdef ALLOW_SEAICE
258 dimitri 1.12 IF (useSEAICE) THEN
259     call exf_set_obcs_y ( OBWa, OBWa0, OBWa1, OBWafile, 's'
260 dimitri 1.11 I , fac, first, changed, count0, count1
261     I , mycurrenttime, mycurrentiter, mythid )
262 dimitri 1.12 call exf_set_obcs_y ( OBWh, OBWh0, OBWh1, OBWhfile, 's'
263 dimitri 1.11 I , fac, first, changed, count0, count1
264     I , mycurrenttime, mycurrentiter, mythid )
265 dimitri 1.13 call exf_set_obcs_y ( OBWsl, OBWsl0, OBWsl1, OBWslfile, 's'
266     I , fac, first, changed, count0, count1
267     I , mycurrenttime, mycurrentiter, mythid )
268     call exf_set_obcs_y ( OBWsn, OBWsn0, OBWsn1, OBWsnfile, 's'
269     I , fac, first, changed, count0, count1
270     I , mycurrenttime, mycurrentiter, mythid )
271 dimitri 1.14 call exf_set_obcs_y ( OBWuice,OBWuice0,OBWuice1,OBWuicefile,'s'
272     I , fac, first, changed, count0, count1
273     I , mycurrenttime, mycurrentiter, mythid )
274     call exf_set_obcs_y ( OBWvice,OBWvice0,OBWvice1,OBWvicefile,'s'
275     I , fac, first, changed, count0, count1
276     I , mycurrenttime, mycurrentiter, mythid )
277 dimitri 1.12 ENDIF
278 dimitri 1.11 #endif /* ALLOW_SEAICE */
279 mlosch 1.7 #ifdef ALLOW_PTRACERS
280     if ( usePTRACERS ) then
281     do itracer = 1, PTRACERS_numInUse
282     call exf_set_obcs_yz( OBWptr (1-Oly,1,1,1,iTracer)
283     I , OBWptr0(1-Oly,1,1,1,iTracer)
284 jmc 1.15 I , OBWptr1(1-Oly,1,1,1,iTracer)
285 mlosch 1.7 I , OBWptrFile(iTracer), 's'
286     I , fac, first, changed, count0, count1
287     I , mycurrenttime, mycurrentiter, mythid )
288     enddo
289     endif
290     #endif /* ALLOW_PTRACERS */
291 dimitri 1.11 #endif /* ALLOW_OBCS_WEST */
292 heimbach 1.1
293     #ifdef ALLOW_OBCS_CONTROL
294     cgg WARNING: Assuming North Open Boundary exists and has same
295     cgg calendar information as other boundaries.
296     call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )
297     #endif
298    
299     #ifdef ALLOW_OBCSN_CONTROL
300     call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )
301     #endif
302    
303     #ifdef ALLOW_OBCSS_CONTROL
304     call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )
305     #endif
306    
307     #ifdef ALLOW_OBCSW_CONTROL
308     call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )
309     #endif
310    
311     #ifdef ALLOW_OBCSE_CONTROL
312     call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )
313     #endif
314    
315 mlosch 1.2 #else /* not ALLOW_EXF */
316 jmc 1.15 CALL OBCS_EXTERNAL_FIELDS_LOAD(
317 mlosch 1.2 & myCurrentTime, myCurrentIter, myThid )
318     #endif /* ALLOw_EXF */
319 heimbach 1.1
320     #endif /* ALLOW_OBCS */
321    
322 adcroft 1.6 RETURN
323     END

  ViewVC Help
Powered by ViewVC 1.1.22