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

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

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

revision 1.7 by jmc, Mon Apr 16 23:27:21 2007 UTC revision 1.8 by dimitri, Thu Oct 11 01:29:16 2007 UTC
# Line 87  c     == end of interface == Line 87  c     == end of interface ==
87    
88        endif        endif
89    
90  #endif  #endif /* ALLOW_OBCS */
91    
92        end        end
93    
# Line 173  c     == end of interface == Line 173  c     == end of interface ==
173    
174        endif        endif
175    
176  #endif  #endif /* ALLOW_OBCS */
177    
178          end
179    
180          subroutine exf_set_obcs_x (
181         &       obcs_fld_x, obcs_x_0, obcs_x_1
182         I     , obcs_file, obcsmask
183         I     , fac, first, changed, count0, count1
184         I     , mycurrenttime, mycurrentiter, mythid
185         &                           )
186    
187    c     ==================================================================
188    c     SUBROUTINE exf_set_obcs_x
189    c     ==================================================================
190    c
191    c     o set open boundary conditions
192    c       same as exf_set_obcs_xz but for NR=1
193    c
194    c     ==================================================================
195    c     SUBROUTINE exf_set_obcs_x
196    c     ==================================================================
197    
198          implicit none
199    
200    c     == global variables ==
201    
202    #include "EEPARAMS.h"
203    #include "SIZE.h"
204    #include "GRID.h"
205    #include "EXF_PARAM.h"
206    #include "EXF_CONSTANTS.h"
207    
208    c     == routine arguments ==
209    
210          _RL obcs_fld_x(1-olx:snx+olx,nsx,nsy)
211          _RL obcs_x_0(1-olx:snx+olx,nsx,nsy)
212          _RL obcs_x_1(1-olx:snx+olx,nsx,nsy)
213    
214          character*(128) obcs_file
215          character*1 obcsmask
216          logical first, changed
217          integer count0, count1
218          _RL     fac
219          _RL     mycurrenttime
220          integer mycurrentiter
221          integer mythid
222    
223    #ifdef ALLOW_OBCS
224    
225    c     == local variables ==
226    
227          integer bi, bj, i
228    
229    c     == end of interface ==
230    
231          if ( obcs_file .NE. ' ' ) then
232    
233             if ( first ) then
234                call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, 1
235         &           , obcs_x_1, count0, mythid
236         &           )
237             endif
238    
239             if (( first ) .or. ( changed )) then
240                call exf_swapffields_x( obcs_x_0, obcs_x_1, mythid )
241    
242                call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, 1
243         &           , obcs_x_1, count1, mythid
244         &           )
245             endif
246    
247             do bj = mybylo(mythid),mybyhi(mythid)
248                do bi = mybxlo(mythid),mybxhi(mythid)
249                   do i = 1,snx
250                      obcs_fld_x(i,bi,bj) =
251         &                 fac * obcs_x_0(i,bi,bj) +
252         &                 (exf_one - fac) * obcs_x_1(i,bi,bj)
253                   enddo
254                enddo
255             enddo
256    
257          endif
258    
259    #endif /* ALLOW_OBCS */
260    
261          end
262    
263          subroutine exf_set_obcs_y (
264         &       obcs_fld_y, obcs_y_0, obcs_y_1
265         I     , obcs_file, obcsmask
266         I     , fac, first, changed, count0, count1
267         I     , mycurrenttime, mycurrentiter, mythid
268         &                           )
269    
270    c     ==================================================================
271    c     SUBROUTINE exf_set_obcs_y
272    c     ==================================================================
273    c
274    c     o set open boundary conditions
275    c       same as exf_set_obcs_yz but for NR=1
276    c
277    c     ==================================================================
278    c     SUBROUTINE exf_set_obcs_y
279    c     ==================================================================
280    
281          implicit none
282    
283    c     == global variables ==
284    
285    #include "EEPARAMS.h"
286    #include "SIZE.h"
287    #include "GRID.h"
288    #include "EXF_PARAM.h"
289    #include "EXF_CONSTANTS.h"
290    
291    c     == routine arguments ==
292    
293          _RL obcs_fld_y(1-oly:sny+oly,Nr,nsx,nsy)
294          _RL obcs_y_0(1-oly:sny+oly,Nr,nsx,nsy)
295          _RL obcs_y_1(1-oly:sny+oly,Nr,nsx,nsy)
296          character*(MAX_LEN_FNAM) obcs_file
297          character*1 obcsmask
298          logical first, changed
299          integer count0, count1
300          _RL     fac
301          _RL     mycurrenttime
302          integer mycurrentiter
303          integer mythid
304    
305    #ifdef ALLOW_OBCS
306    
307    c     == local variables ==
308    
309          integer bi, bj, j
310    
311    c     == end of interface ==
312    
313          if ( obcs_file .NE. ' ' ) then
314    
315             if ( first ) then
316                call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, 1
317         &           , obcs_y_1, count0, mythid
318         &           )
319             endif
320    
321             if (( first ) .or. ( changed )) then
322                call exf_swapffields_y( obcs_y_0, obcs_y_1, mythid )
323    
324                call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, 1
325         &           , obcs_y_1, count1, mythid
326         &           )
327             endif
328    
329             do bj = mybylo(mythid),mybyhi(mythid)
330                do bi = mybxlo(mythid),mybxhi(mythid)
331                   do j = 1,sny
332                      obcs_fld_y(j,bi,bj) =
333         &                 fac             *obcs_y_0(j,bi,bj) +
334         &                 (exf_one - fac) *obcs_y_1(j,bi,bj)
335                   enddo
336                enddo
337             enddo
338    
339          endif
340    
341    #endif /* ALLOW_OBCS */
342    
343        end        end
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22