/[MITgcm]/MITgcm/pkg/exf/exf_set_obcs.F
ViewVC logotype

Annotation of /MITgcm/pkg/exf/exf_set_obcs.F

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


Revision 1.13 - (hide annotations) (download)
Fri May 9 10:00:40 2008 UTC (16 years, 1 month ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59r, checkpoint61f, checkpoint61n, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.12: +18 -14 lines
recovering earlier version; changes caused segmentation preblem.

1 dimitri 1.12 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_obcs.F,v 1.11 2008/01/25 16:02:56 mlosch Exp $
2 jmc 1.7 C $Name: $
3    
4 edhill 1.6 #include "EXF_OPTIONS.h"
5 heimbach 1.1
6     subroutine exf_set_obcs_xz (
7 heimbach 1.3 & obcs_fld_xz, obcs_xz_0, obcs_xz_1
8     I , obcs_file, obcsmask
9 mlosch 1.10 I , fac, first, changed, useYearlyFields, obcs_period
10     I , count0, count1, year0, year1
11 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid
12     & )
13    
14     c ==================================================================
15     c SUBROUTINE exf_set_obcs_xz
16     c ==================================================================
17     c
18     c o set open boundary conditions
19     c
20     c started: heimbach@mit.edu 01-May-2001
21 dimitri 1.4 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
22 heimbach 1.1
23     c ==================================================================
24     c SUBROUTINE exf_set_obcs_xz
25     c ==================================================================
26    
27     implicit none
28    
29     c == global variables ==
30    
31     #include "EEPARAMS.h"
32     #include "SIZE.h"
33     #include "GRID.h"
34 jmc 1.7 #include "EXF_PARAM.h"
35     #include "EXF_CONSTANTS.h"
36 heimbach 1.1
37     c == routine arguments ==
38    
39     _RL obcs_fld_xz(1-olx:snx+olx,Nr,nsx,nsy)
40 heimbach 1.3 _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
41     _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
42 dimitri 1.13
43     character*(128) obcs_file
44 heimbach 1.1 character*1 obcsmask
45     logical first, changed
46 mlosch 1.10 logical useYearlyFields
47     _RL obcs_period
48     integer count0, count1, year0, year1
49 heimbach 1.1 _RL fac
50     _RL mycurrenttime
51     integer mycurrentiter
52     integer mythid
53    
54     #ifdef ALLOW_OBCS
55    
56     c == local variables ==
57    
58     integer bi, bj
59 heimbach 1.2 integer i, k
60 dimitri 1.13
61 mlosch 1.10 integer il
62 dimitri 1.13 character*(128) obcs_file0, obcs_file1
63 mlosch 1.10
64     c == external ==
65    
66     integer ilnblnk
67     external ilnblnk
68    
69 heimbach 1.1 c == end of interface ==
70    
71 dimitri 1.4 if ( obcs_file .NE. ' ' ) then
72 heimbach 1.1
73 dimitri 1.4 if ( first ) then
74 mlosch 1.10
75 mlosch 1.11 call exf_GetYearlyFieldName(
76     I useYearlyFields, twoDigitYear, obcs_period, year0,
77     I obcs_file,
78     O obcs_file0,
79     I mycurrenttime, mycurrentiter, mythid )
80 mlosch 1.10
81     call mdsreadfieldxz( obcs_file0, exf_iprec, exf_yftype, Nr
82 dimitri 1.4 & , obcs_xz_1, count0, mythid
83     & )
84     endif
85    
86     if (( first ) .or. ( changed )) then
87     call exf_swapffields_xz( obcs_xz_0, obcs_xz_1, mythid )
88    
89 mlosch 1.11 call exf_GetYearlyFieldName(
90     I useYearlyFields, twoDigitYear, obcs_period, year1,
91     I obcs_file,
92     O obcs_file1,
93     I mycurrenttime, mycurrentiter, mythid )
94 mlosch 1.10
95     call mdsreadfieldxz( obcs_file1, exf_iprec, exf_yftype, Nr
96 dimitri 1.4 & , obcs_xz_1, count1, mythid
97     & )
98     endif
99    
100     do bj = mybylo(mythid),mybyhi(mythid)
101     do bi = mybxlo(mythid),mybxhi(mythid)
102     do k = 1,Nr
103     do i = 1,snx
104     obcs_fld_xz(i,k,bi,bj) =
105 dimitri 1.13 & fac * obcs_xz_0(i,k,bi,bj) +
106 dimitri 1.4 & (exf_one - fac) * obcs_xz_1(i,k,bi,bj)
107     enddo
108     enddo
109     enddo
110     enddo
111 heimbach 1.1
112     endif
113    
114 dimitri 1.8 #endif /* ALLOW_OBCS */
115 heimbach 1.1
116     end
117    
118     subroutine exf_set_obcs_yz (
119 heimbach 1.3 & obcs_fld_yz, obcs_yz_0, obcs_yz_1
120     I , obcs_file, obcsmask
121 mlosch 1.10 I , fac, first, changed, useYearlyFields, obcs_period
122     I , count0, count1, year0, year1
123 heimbach 1.1 I , mycurrenttime, mycurrentiter, mythid
124     & )
125    
126     c ==================================================================
127     c SUBROUTINE exf_set_obcs_yz
128     c ==================================================================
129     c
130     c o set open boundary conditions
131     c
132     c started: heimbach@mit.edu 01-May-2001
133    
134     c ==================================================================
135     c SUBROUTINE exf_set_obcs_yz
136     c ==================================================================
137    
138     implicit none
139    
140     c == global variables ==
141    
142     #include "EEPARAMS.h"
143     #include "SIZE.h"
144     #include "GRID.h"
145 jmc 1.7 #include "EXF_PARAM.h"
146     #include "EXF_CONSTANTS.h"
147 heimbach 1.1
148     c == routine arguments ==
149    
150     _RL obcs_fld_yz(1-oly:sny+oly,Nr,nsx,nsy)
151 heimbach 1.3 _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
152     _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
153 heimbach 1.1 character*(MAX_LEN_FNAM) obcs_file
154     character*1 obcsmask
155     logical first, changed
156 mlosch 1.10 logical useYearlyFields
157     _RL obcs_period
158     integer count0, count1, year0, year1
159 heimbach 1.1 _RL fac
160     _RL mycurrenttime
161     integer mycurrentiter
162     integer mythid
163    
164     #ifdef ALLOW_OBCS
165    
166     c == local variables ==
167    
168     integer bi, bj
169 heimbach 1.2 integer j, k
170 mlosch 1.10 integer il
171 dimitri 1.13 character*(128) obcs_file0, obcs_file1
172 mlosch 1.10
173     c == external ==
174    
175     integer ilnblnk
176     external ilnblnk
177 heimbach 1.2
178 heimbach 1.1 c == end of interface ==
179    
180 heimbach 1.5 if ( obcs_file .NE. ' ' ) then
181    
182     if ( first ) then
183 mlosch 1.10
184 mlosch 1.11 call exf_GetYearlyFieldName(
185 dimitri 1.13 I useYearlyFields, twoDigitYear, obcs_period, year0,
186 mlosch 1.11 I obcs_file,
187     O obcs_file0,
188     I mycurrenttime, mycurrentiter, mythid )
189 mlosch 1.10
190     call mdsreadfieldyz( obcs_file0, exf_iprec, exf_yftype, Nr
191 heimbach 1.5 & , obcs_yz_1, count0, mythid
192     & )
193     endif
194 heimbach 1.1
195 heimbach 1.5 if (( first ) .or. ( changed )) then
196     call exf_swapffields_yz( obcs_yz_0, obcs_yz_1, mythid )
197 heimbach 1.1
198 mlosch 1.11 call exf_GetYearlyFieldName(
199     I useYearlyFields, twoDigitYear, obcs_period, year1,
200     I obcs_file,
201     O obcs_file1,
202     I mycurrenttime, mycurrentiter, mythid )
203 mlosch 1.10
204     call mdsreadfieldyz( obcs_file1, exf_iprec, exf_yftype, Nr
205 heimbach 1.5 & , obcs_yz_1, count1, mythid
206     & )
207     endif
208 heimbach 1.1
209 heimbach 1.5 do bj = mybylo(mythid),mybyhi(mythid)
210     do bi = mybxlo(mythid),mybxhi(mythid)
211     do k = 1,Nr
212     do j = 1,sny
213     obcs_fld_yz(j,k,bi,bj) =
214 dimitri 1.13 & fac *obcs_yz_0(j,k,bi,bj) +
215     & (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
216 heimbach 1.5 enddo
217     enddo
218 heimbach 1.1 enddo
219 heimbach 1.5 enddo
220    
221     endif
222 heimbach 1.1
223 dimitri 1.8 #endif /* ALLOW_OBCS */
224    
225     end
226    
227     subroutine exf_set_obcs_x (
228     & obcs_fld_x, obcs_x_0, obcs_x_1
229     I , obcs_file, obcsmask
230 mlosch 1.10 I , fac, first, changed, useYearlyFields, obcs_period
231     I , count0, count1, year0, year1
232 dimitri 1.8 I , mycurrenttime, mycurrentiter, mythid
233     & )
234    
235     c ==================================================================
236     c SUBROUTINE exf_set_obcs_x
237     c ==================================================================
238     c
239     c o set open boundary conditions
240     c same as exf_set_obcs_xz but for NR=1
241     c
242     c ==================================================================
243     c SUBROUTINE exf_set_obcs_x
244     c ==================================================================
245    
246     implicit none
247    
248     c == global variables ==
249    
250     #include "EEPARAMS.h"
251     #include "SIZE.h"
252     #include "GRID.h"
253     #include "EXF_PARAM.h"
254     #include "EXF_CONSTANTS.h"
255    
256     c == routine arguments ==
257    
258     _RL obcs_fld_x(1-olx:snx+olx,nsx,nsy)
259     _RL obcs_x_0(1-olx:snx+olx,nsx,nsy)
260     _RL obcs_x_1(1-olx:snx+olx,nsx,nsy)
261 dimitri 1.13
262     character*(128) obcs_file
263 dimitri 1.8 character*1 obcsmask
264     logical first, changed
265 mlosch 1.10 logical useYearlyFields
266     _RL obcs_period
267     integer count0, count1, year0, year1
268 dimitri 1.8 _RL fac
269     _RL mycurrenttime
270     integer mycurrentiter
271     integer mythid
272    
273     #ifdef ALLOW_OBCS
274    
275     c == local variables ==
276    
277     integer bi, bj, i
278 dimitri 1.13
279 mlosch 1.10 integer il
280 dimitri 1.13 character*(128) obcs_file0, obcs_file1
281 mlosch 1.10
282     c == external ==
283    
284     integer ilnblnk
285     external ilnblnk
286    
287 dimitri 1.8 c == end of interface ==
288    
289     if ( obcs_file .NE. ' ' ) then
290    
291     if ( first ) then
292 mlosch 1.10
293 mlosch 1.11 call exf_GetYearlyFieldName(
294     I useYearlyFields, twoDigitYear, obcs_period, year0,
295     I obcs_file,
296     O obcs_file0,
297     I mycurrenttime, mycurrentiter, mythid )
298 mlosch 1.10
299     call mdsreadfieldxz( obcs_file0, exf_iprec, exf_yftype, 1
300 dimitri 1.8 & , obcs_x_1, count0, mythid
301     & )
302     endif
303    
304     if (( first ) .or. ( changed )) then
305     call exf_swapffields_x( obcs_x_0, obcs_x_1, mythid )
306    
307 mlosch 1.11 call exf_GetYearlyFieldName(
308     I useYearlyFields, twoDigitYear, obcs_period, year1,
309     I obcs_file,
310     O obcs_file1,
311     I mycurrenttime, mycurrentiter, mythid )
312 mlosch 1.10
313     call mdsreadfieldxz( obcs_file1, exf_iprec, exf_yftype, 1
314 dimitri 1.8 & , obcs_x_1, count1, mythid
315     & )
316     endif
317    
318     do bj = mybylo(mythid),mybyhi(mythid)
319     do bi = mybxlo(mythid),mybxhi(mythid)
320     do i = 1,snx
321     obcs_fld_x(i,bi,bj) =
322 dimitri 1.13 & fac * obcs_x_0(i,bi,bj) +
323 dimitri 1.8 & (exf_one - fac) * obcs_x_1(i,bi,bj)
324     enddo
325     enddo
326     enddo
327    
328     endif
329    
330     #endif /* ALLOW_OBCS */
331    
332     end
333    
334     subroutine exf_set_obcs_y (
335     & obcs_fld_y, obcs_y_0, obcs_y_1
336     I , obcs_file, obcsmask
337 mlosch 1.10 I , fac, first, changed, useYearlyFields, obcs_period
338     I , count0, count1, year0, year1
339 dimitri 1.8 I , mycurrenttime, mycurrentiter, mythid
340     & )
341    
342     c ==================================================================
343     c SUBROUTINE exf_set_obcs_y
344     c ==================================================================
345     c
346     c o set open boundary conditions
347     c same as exf_set_obcs_yz but for NR=1
348     c
349     c ==================================================================
350     c SUBROUTINE exf_set_obcs_y
351     c ==================================================================
352    
353     implicit none
354    
355     c == global variables ==
356    
357     #include "EEPARAMS.h"
358     #include "SIZE.h"
359     #include "GRID.h"
360     #include "EXF_PARAM.h"
361     #include "EXF_CONSTANTS.h"
362    
363     c == routine arguments ==
364    
365 dimitri 1.9 _RL obcs_fld_y(1-oly:sny+oly,nsx,nsy)
366     _RL obcs_y_0(1-oly:sny+oly,nsx,nsy)
367     _RL obcs_y_1(1-oly:sny+oly,nsx,nsy)
368 dimitri 1.8 character*(MAX_LEN_FNAM) obcs_file
369     character*1 obcsmask
370     logical first, changed
371 mlosch 1.10 logical useYearlyFields
372     _RL obcs_period
373     integer count0, count1, year0, year1
374 dimitri 1.8 _RL fac
375     _RL mycurrenttime
376     integer mycurrentiter
377     integer mythid
378    
379     #ifdef ALLOW_OBCS
380    
381     c == local variables ==
382    
383     integer bi, bj, j
384 dimitri 1.13
385 mlosch 1.10 integer il
386 dimitri 1.13 character*(128) obcs_file0, obcs_file1
387 mlosch 1.10
388     c == external ==
389    
390     integer ilnblnk
391     external ilnblnk
392    
393 dimitri 1.8 c == end of interface ==
394    
395     if ( obcs_file .NE. ' ' ) then
396    
397     if ( first ) then
398 mlosch 1.10
399 mlosch 1.11 call exf_GetYearlyFieldName(
400     I useYearlyFields, twoDigitYear, obcs_period, year0,
401     I obcs_file,
402     O obcs_file0,
403     I mycurrenttime, mycurrentiter, mythid )
404 mlosch 1.10
405     call mdsreadfieldyz( obcs_file0, exf_iprec, exf_yftype, 1
406 dimitri 1.8 & , obcs_y_1, count0, mythid
407     & )
408     endif
409    
410     if (( first ) .or. ( changed )) then
411     call exf_swapffields_y( obcs_y_0, obcs_y_1, mythid )
412    
413 mlosch 1.11 call exf_GetYearlyFieldName(
414     I useYearlyFields, twoDigitYear, obcs_period, year1,
415     I obcs_file,
416     O obcs_file1,
417     I mycurrenttime, mycurrentiter, mythid )
418 mlosch 1.10
419     call mdsreadfieldyz( obcs_file1, exf_iprec, exf_yftype, 1
420 dimitri 1.8 & , obcs_y_1, count1, mythid
421     & )
422     endif
423    
424     do bj = mybylo(mythid),mybyhi(mythid)
425     do bi = mybxlo(mythid),mybxhi(mythid)
426     do j = 1,sny
427     obcs_fld_y(j,bi,bj) =
428 dimitri 1.13 & fac *obcs_y_0(j,bi,bj) +
429     & (exf_one - fac) *obcs_y_1(j,bi,bj)
430 dimitri 1.8 enddo
431     enddo
432     enddo
433    
434     endif
435    
436     #endif /* ALLOW_OBCS */
437 heimbach 1.1
438     end

  ViewVC Help
Powered by ViewVC 1.1.22