/[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.2 - (hide 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 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     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 heimbach 1.2 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 heimbach 1.1
53     c == end of interface ==
54    
55     #ifndef ALLOW_AUTODIFF_TAMC
56     if ( first ) then
57     #endif
58 heimbach 1.2 call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr
59 heimbach 1.1 & , 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 heimbach 1.2 call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr
71 heimbach 1.1 & , 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 heimbach 1.2 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 heimbach 1.1
143     c == end of interface ==
144    
145     #ifndef ALLOW_AUTODIFF_TAMC
146     if ( first ) then
147     #endif
148 heimbach 1.2 call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
149 heimbach 1.1 & , 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 heimbach 1.2 call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
161 heimbach 1.1 & , 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 heimbach 1.2 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 heimbach 1.1
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 heimbach 1.2
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 heimbach 1.1
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