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

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

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


Revision 1.1 - (show annotations) (download)
Mon May 14 22:08:41 2001 UTC (23 years, 1 month 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 #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