/[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.14 - (hide annotations) (download)
Fri Oct 26 02:00:47 2007 UTC (16 years, 8 months ago) by dimitri
Branch: MAIN
Changes since 1.13: +25 -1 lines
Added open boundary conditions capability for seaice UICE, and VICE
UICE and VICE are reset at the edges after calling the solver and
before advection/diffusion.  Needs testing.

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

  ViewVC Help
Powered by ViewVC 1.1.22