/[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.2 - (show annotations) (download)
Thu Feb 7 20:00:09 2002 UTC (22 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint44e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint46f_post, checkpoint44f_post, checkpoint46b_post, checkpoint46l_pre, chkpt44d_post, checkpoint44e_pre, checkpoint46d_pre, checkpoint45d_post, checkpoint46j_pre, checkpoint44h_pre, checkpoint46a_post, checkpoint46j_post, checkpoint46k_post, chkpt44c_pre, checkpoint45a_post, checkpoint44g_post, checkpoint46e_pre, checkpoint45b_post, checkpoint46b_pre, release1_final_v1, checkpoint46c_pre, checkpoint46, checkpoint44b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint46a_pre, checkpoint45c_post, checkpoint44h_post, checkpoint46g_post, checkpoint46i_post, checkpoint46c_post, checkpoint46e_post, checkpoint45, checkpoint46h_post, chkpt44c_post, checkpoint44f_pre, checkpoint46d_post
Branch point for: release1_final
Changes since 1.1: +19 -39 lines 
o merge of relevant stuff from the ecco-branch:
  - genmake: removed $S64 overwrite for case SunOS
  - pkg/exf: update and corrections for field swapping and obcs
  - pkg/ecco: parameter lists for the_model_main, the_main_loop
              harmonized between ECCO and MITgcm
  - pkg/autodiff: added flow directives for obcs, mdsio_gl_slice
                  updated checkpointing_lev... lists for obcs
  - model/src: minor changes in forward_step, plot_field
               added directive for divided adjoint in the_main_loop
  - pkg/mdsio: added mdsio_gl_slice
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 c == routine arguments ==
32
33 _RL obcs_fld_xz(1-olx:snx+olx,Nr,nsx,nsy)
34 character*(128) obcs_file
35 character*1 obcsmask
36 logical first, changed
37 integer count0, count1
38 _RL fac
39 _RL mycurrenttime
40 integer mycurrentiter
41 integer mythid
42
43 #ifdef ALLOW_OBCS
44
45 c == local variables ==
46
47 integer bi, bj
48 integer i, k
49
50 _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
51 _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
52
53 c == end of interface ==
54
55 #ifndef ALLOW_AUTODIFF_TAMC
56 if ( first ) then
57 #endif
58 call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr
59 & , obcs_xz_1, count0, mythid
60 & )
61 #ifndef ALLOW_AUTODIFF_TAMC
62 endif
63 #endif
64
65 #ifndef ALLOW_AUTODIFF_TAMC
66 if (( first ) .or. ( changed )) then
67 #endif
68 call exf_swapffields_xz( obcs_xz_0, obcs_xz_1, mythid )
69
70 call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr
71 & , obcs_xz_1, count1, mythid
72 & )
73 #ifndef ALLOW_AUTODIFF_TAMC
74 endif
75 #endif
76
77 do bj = mybylo(mythid),mybyhi(mythid)
78 do bi = mybxlo(mythid),mybxhi(mythid)
79 do k = 1,Nr
80 do i = 1,snx
81 obcs_fld_xz(i,k,bi,bj) =
82 & fac *obcs_xz_0(i,k,bi,bj) +
83 & (exf_one - fac) *obcs_xz_1(i,k,bi,bj)
84 enddo
85 enddo
86 enddo
87 enddo
88
89 #endif
90
91 end
92
93 subroutine exf_set_obcs_yz (
94 & obcs_fld_yz, obcs_file, obcsmask
95 I , fac, first, changed, count0, count1
96 I , mycurrenttime, mycurrentiter, mythid
97 & )
98
99 c ==================================================================
100 c SUBROUTINE exf_set_obcs_yz
101 c ==================================================================
102 c
103 c o set open boundary conditions
104 c
105 c started: heimbach@mit.edu 01-May-2001
106
107 c ==================================================================
108 c SUBROUTINE exf_set_obcs_yz
109 c ==================================================================
110
111 implicit none
112
113 c == global variables ==
114
115 #include "EEPARAMS.h"
116 #include "SIZE.h"
117 #include "GRID.h"
118 #include "exf_param.h"
119 #include "exf_constants.h"
120
121 c == routine arguments ==
122
123 _RL obcs_fld_yz(1-oly:sny+oly,Nr,nsx,nsy)
124 character*(MAX_LEN_FNAM) obcs_file
125 character*1 obcsmask
126 logical first, changed
127 integer count0, count1
128 _RL fac
129 _RL mycurrenttime
130 integer mycurrentiter
131 integer mythid
132
133 #ifdef ALLOW_OBCS
134
135 c == local variables ==
136
137 integer bi, bj
138 integer j, k
139
140 _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
141 _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
142
143 c == end of interface ==
144
145 #ifndef ALLOW_AUTODIFF_TAMC
146 if ( first ) then
147 #endif
148 call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
149 & , obcs_yz_1, count0, mythid
150 & )
151 #ifndef ALLOW_AUTODIFF_TAMC
152 endif
153 #endif
154
155 #ifndef ALLOW_AUTODIFF_TAMC
156 if (( first ) .or. ( changed )) then
157 #endif
158 call exf_swapffields_yz( obcs_yz_0, obcs_yz_1, mythid )
159
160 call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
161 & , obcs_yz_1, count1, mythid
162 & )
163 #ifndef ALLOW_AUTODIFF_TAMC
164 endif
165 #endif
166
167 do bj = mybylo(mythid),mybyhi(mythid)
168 do bi = mybxlo(mythid),mybxhi(mythid)
169 do k = 1,Nr
170 do j = 1,sny
171 obcs_fld_yz(j,k,bi,bj) =
172 & fac *obcs_yz_0(j,k,bi,bj) +
173 & (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
174 enddo
175 enddo
176 enddo
177 enddo
178
179 #endif
180
181 end
182
183 subroutine exf_init_obcs_xz(
184 I mythid
185 & )
186
187 c ==================================================================
188 c SUBROUTINE exf_init_obcs_xz
189 c ==================================================================
190 c
191 c o
192 c
193 c started: heimbach@mit.edu 01-May-2001
194 c
195 c ==================================================================
196 c SUBROUTINE exf_init_obcs_xz
197 c ==================================================================
198
199 implicit none
200
201 c == global variables ==
202
203 #include "EEPARAMS.h"
204 #include "SIZE.h"
205
206 c == routine arguments ==
207
208 integer mythid
209
210 #ifdef ALLOW_OBCS
211
212 c == local variables ==
213
214 integer bi, bj
215 integer i, k
216
217 _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
218 _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
219
220 c == end of interface ==
221
222 do bj = mybylo(mythid), mybyhi(mythid)
223 do bi = mybxlo(mythid), mybxhi(mythid)
224 do k = 1, Nr
225 do i = 1, snx
226 obcs_xz_0(i,k,bi,bj) = 0. _d 0
227 obcs_xz_1(i,k,bi,bj) = 0. _d 0
228 enddo
229 enddo
230 enddo
231 enddo
232
233 #endif
234 end
235
236
237 subroutine exf_init_obcs_yz(
238 I mythid
239 & )
240
241 c ==================================================================
242 c SUBROUTINE exf_init_obcs_yz
243 c ==================================================================
244 c
245 c o
246 c
247 c started: heimbach@mit.edu 01-May-2001
248 c
249 c ==================================================================
250 c SUBROUTINE exf_init_obcs_yz
251 c ==================================================================
252
253 implicit none
254
255 c == global variables ==
256
257 #include "EEPARAMS.h"
258 #include "SIZE.h"
259
260 c == routine arguments ==
261
262 integer mythid
263
264 _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
265 _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
266
267 #ifdef ALLOW_OBCS
268
269 c == local variables ==
270
271 integer bi, bj
272 integer i, j, k
273
274 c == end of interface ==
275
276 do bj = mybylo(mythid), mybyhi(mythid)
277 do bi = mybxlo(mythid), mybxhi(mythid)
278 do k = 1, Nr
279 do j = 1, sny
280 obcs_yz_0(j,k,bi,bj) = 0. _d 0
281 obcs_yz_1(j,k,bi,bj) = 0. _d 0
282 enddo
283 enddo
284 enddo
285 enddo
286
287 #endif
288 end
  ViewVC Help
Powered by ViewVC 1.1.22