/[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.1 - (hide annotations) (download)
Mon May 14 22:08:41 2001 UTC (23 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint43a-release1mods, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, release1_b1, checkpoint43, checkpoint40pre2, release1-branch_tutorials, chkpt44a_post, checkpoint40pre4, release1-branch-end, checkpoint39, checkpoint40pre5, chkpt44a_pre, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint40, checkpoint41, checkpoint44, release1-branch_branchpoint
Branch point for: release1-branch, release1, ecco-branch, release1_coupled
Added external forcing package.
Not presently supported by mitgcm, i.e. disabled by default.

1 heimbach 1.1 #include "EXF_CPPOPTIONS.h"
2    
3     subroutine exf_set_obcs_xz (
4     & obcs_fld_xz, obcs_file, obcsmask
5     I , fac, first, changed, count0, count1
6     I , mycurrenttime, mycurrentiter, mythid
7     & )
8    
9     c ==================================================================
10     c SUBROUTINE exf_set_obcs_xz
11     c ==================================================================
12     c
13     c o set open boundary conditions
14     c
15     c started: heimbach@mit.edu 01-May-2001
16    
17     c ==================================================================
18     c SUBROUTINE exf_set_obcs_xz
19     c ==================================================================
20    
21     implicit none
22    
23     c == global variables ==
24    
25     #include "EEPARAMS.h"
26     #include "SIZE.h"
27     #include "GRID.h"
28     #include "exf_param.h"
29     #include "exf_constants.h"
30    
31     cph common /exfl_obcs_r/
32     cph & obcs_xz_0, obcs_xz_1,
33     cph & obcs_yz_0, obcs_yz_1
34     _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
35     _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
36     _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
37     _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
38    
39     c == routine arguments ==
40    
41     _RL obcs_fld_xz(1-olx:snx+olx,Nr,nsx,nsy)
42     character*(128) obcs_file
43     character*1 obcsmask
44     logical first, changed
45     integer count0, count1
46     _RL fac
47     _RL mycurrenttime
48     integer mycurrentiter
49     integer mythid
50    
51     #ifdef ALLOW_OBCS
52    
53     c == local variables ==
54    
55     integer bi, bj
56     integer i, j, k
57    
58     c == end of interface ==
59    
60     #ifndef ALLOW_AUTODIFF_TAMC
61     if ( first ) then
62     #endif
63     call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, 1
64     & , obcs_xz_1, count0, mythid
65     & )
66     #ifndef ALLOW_AUTODIFF_TAMC
67     endif
68     #endif
69    
70     #ifndef ALLOW_AUTODIFF_TAMC
71     if (( first ) .or. ( changed )) then
72     #endif
73     call exf_swapffields_xz( obcs_xz_0, obcs_xz_1, mythid )
74    
75     call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, 1
76     & , obcs_xz_1, count1, mythid
77     & )
78     #ifndef ALLOW_AUTODIFF_TAMC
79     endif
80     #endif
81    
82     do bj = mybylo(mythid),mybyhi(mythid)
83     do bi = mybxlo(mythid),mybxhi(mythid)
84     do k = 1,Nr
85     do i = 1,snx
86     obcs_fld_xz(i,k,bi,bj) =
87     & fac *obcs_xz_0(i,k,bi,bj) +
88     & (exf_one - fac) *obcs_xz_1(i,k,bi,bj)
89     enddo
90     enddo
91     enddo
92     enddo
93    
94     #endif
95    
96     end
97    
98     subroutine exf_set_obcs_yz (
99     & obcs_fld_yz, obcs_file, obcsmask
100     I , fac, first, changed, count0, count1
101     I , mycurrenttime, mycurrentiter, mythid
102     & )
103    
104     c ==================================================================
105     c SUBROUTINE exf_set_obcs_yz
106     c ==================================================================
107     c
108     c o set open boundary conditions
109     c
110     c started: heimbach@mit.edu 01-May-2001
111    
112     c ==================================================================
113     c SUBROUTINE exf_set_obcs_yz
114     c ==================================================================
115    
116     implicit none
117    
118     c == global variables ==
119    
120     #include "EEPARAMS.h"
121     #include "SIZE.h"
122     #include "GRID.h"
123     #include "exf_param.h"
124     #include "exf_constants.h"
125    
126     cph common /exfl_obcs_r/
127     cph & obcs_xz_0, obcs_xz_1,
128     cph & obcs_yz_0, obcs_yz_1
129     _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
130     _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
131     _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
132     _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
133    
134     c == routine arguments ==
135    
136     _RL obcs_fld_yz(1-oly:sny+oly,Nr,nsx,nsy)
137     character*(MAX_LEN_FNAM) obcs_file
138     character*1 obcsmask
139     logical first, changed
140     integer count0, count1
141     _RL fac
142     _RL mycurrenttime
143     integer mycurrentiter
144     integer mythid
145    
146     #ifdef ALLOW_OBCS
147    
148     c == local variables ==
149    
150     integer bi, bj
151     integer i, j, k
152    
153     c == end of interface ==
154    
155     #ifndef ALLOW_AUTODIFF_TAMC
156     if ( first ) then
157     #endif
158     call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, 1
159     & , obcs_yz_1, count0, mythid
160     & )
161     #ifndef ALLOW_AUTODIFF_TAMC
162     endif
163     #endif
164    
165     #ifndef ALLOW_AUTODIFF_TAMC
166     if (( first ) .or. ( changed )) then
167     #endif
168     call exf_swapffields_yz( obcs_yz_0, obcs_yz_1, mythid )
169    
170     call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, 1
171     & , obcs_yz_1, count1, mythid
172     & )
173     #ifndef ALLOW_AUTODIFF_TAMC
174     endif
175     #endif
176    
177     do bj = mybylo(mythid),mybyhi(mythid)
178     do bi = mybxlo(mythid),mybxhi(mythid)
179     do k = 1,Nr
180     do j = 1,sny
181     obcs_fld_yz(j,k,bi,bj) =
182     & fac *obcs_yz_0(j,k,bi,bj) +
183     & (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
184     enddo
185     enddo
186     enddo
187     enddo
188    
189     #endif
190    
191     end
192    
193     subroutine exf_init_obcs_xz(
194     I mythid
195     & )
196    
197     c ==================================================================
198     c SUBROUTINE exf_init_obcs_xz
199     c ==================================================================
200     c
201     c o
202     c
203     c started: heimbach@mit.edu 01-May-2001
204     c
205     c ==================================================================
206     c SUBROUTINE exf_init_obcs_xz
207     c ==================================================================
208    
209     implicit none
210    
211     c == global variables ==
212    
213     #include "EEPARAMS.h"
214     #include "SIZE.h"
215    
216     cph common /exfl_obcs_r/
217     cph & obcs_xz_0, obcs_xz_1,
218     cph & obcs_yz_0, obcs_yz_1
219     _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
220     _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
221     _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
222     _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
223    
224     c == routine arguments ==
225    
226     integer mythid
227    
228     #ifdef ALLOW_OBCS
229    
230     c == local variables ==
231    
232     integer bi, bj
233     integer i, j, k
234    
235     c == end of interface ==
236    
237     do bj = mybylo(mythid), mybyhi(mythid)
238     do bi = mybxlo(mythid), mybxhi(mythid)
239     do k = 1, Nr
240     do i = 1, snx
241     obcs_xz_0(i,k,bi,bj) = 0. _d 0
242     obcs_xz_1(i,k,bi,bj) = 0. _d 0
243     enddo
244     enddo
245     enddo
246     enddo
247    
248     #endif
249     end
250    
251    
252     subroutine exf_init_obcs_yz(
253     I mythid
254     & )
255    
256     c ==================================================================
257     c SUBROUTINE exf_init_obcs_yz
258     c ==================================================================
259     c
260     c o
261     c
262     c started: heimbach@mit.edu 01-May-2001
263     c
264     c ==================================================================
265     c SUBROUTINE exf_init_obcs_yz
266     c ==================================================================
267    
268     implicit none
269    
270     c == global variables ==
271    
272     #include "EEPARAMS.h"
273     #include "SIZE.h"
274    
275     cph common /exfl_obcs_r/
276     cph & obcs_xz_0, obcs_xz_1,
277     cph & obcs_yz_0, obcs_yz_1
278     _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
279     _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
280     _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
281     _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
282    
283     c == routine arguments ==
284    
285     integer mythid
286    
287     #ifdef ALLOW_OBCS
288    
289     c == local variables ==
290    
291     integer bi, bj
292     integer i, j, k
293    
294     c == end of interface ==
295    
296     do bj = mybylo(mythid), mybyhi(mythid)
297     do bi = mybxlo(mythid), mybxhi(mythid)
298     do k = 1, Nr
299     do j = 1, sny
300     obcs_yz_0(j,k,bi,bj) = 0. _d 0
301     obcs_yz_1(j,k,bi,bj) = 0. _d 0
302     enddo
303     enddo
304     enddo
305     enddo
306    
307     #endif
308     end

  ViewVC Help
Powered by ViewVC 1.1.22