/[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.4 by dimitri, Tue Feb 18 05:33:54 2003 UTC revision 1.14 by mlosch, Tue Jun 2 14:59:55 2009 UTC
# Line 1  Line 1 
1  #include "EXF_CPPOPTIONS.h"  C $Header$
2    C $Name$
3    
4    #include "EXF_OPTIONS.h"
5    
6        subroutine exf_set_obcs_xz (        subroutine exf_set_obcs_xz (
7       &       obcs_fld_xz, obcs_xz_0, obcs_xz_1       &       obcs_fld_xz, obcs_xz_0, obcs_xz_1
8       I     , obcs_file, obcsmask       I     , obcs_file, obcsmask
9       I     , fac, first, changed, count0, count1       I     , fac, first, changed, useYearlyFields, obcs_period
10         I     , count0, count1, year0, year1
11       I     , mycurrenttime, mycurrentiter, mythid       I     , mycurrenttime, mycurrentiter, mythid
12       &                           )       &                           )
13    
# Line 27  c     == global variables == Line 31  c     == global variables ==
31  #include "EEPARAMS.h"  #include "EEPARAMS.h"
32  #include "SIZE.h"  #include "SIZE.h"
33  #include "GRID.h"  #include "GRID.h"
34  #include "exf_param.h"  #include "EXF_PARAM.h"
35  #include "exf_constants.h"  #include "EXF_CONSTANTS.h"
36    
37  c     == routine arguments ==  c     == routine arguments ==
38    
# Line 39  c     == routine arguments == Line 43  c     == routine arguments ==
43        character*(128) obcs_file        character*(128) obcs_file
44        character*1 obcsmask        character*1 obcsmask
45        logical first, changed        logical first, changed
46        integer count0, count1        logical useYearlyFields
47          _RL     obcs_period
48          integer count0, count1, year0, year1
49        _RL     fac        _RL     fac
50        _RL     mycurrenttime        _RL     mycurrenttime
51        integer mycurrentiter        integer mycurrentiter
# Line 52  c     == local variables == Line 58  c     == local variables ==
58        integer bi, bj        integer bi, bj
59        integer i, k        integer i, k
60    
61          integer il
62          character*(128) obcs_file0, obcs_file1
63    
64    c     == external ==
65    
66          integer  ilnblnk
67          external ilnblnk
68    
69  c     == end of interface ==  c     == end of interface ==
70    
71        if ( obcs_file .NE. ' ' ) then        if ( obcs_file .NE. ' ' ) then
72    
73           if ( first ) then           if ( first ) then
74              call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr  
75       &           , obcs_xz_1, count0, mythid              call exf_GetYearlyFieldName(
76         I         useYearlyFields, twoDigitYear, obcs_period, year0,
77         I         obcs_file,
78         O         obcs_file0,
79         I         mycurrenttime, mycurrentiter, mythid )
80    
81                call mdsreadfieldxz( obcs_file0, exf_iprec_obsc, exf_yftype
82         &           , Nr, obcs_xz_1, count0, mythid
83       &           )       &           )
84           endif           endif
85    
86           if (( first ) .or. ( changed )) then           if (( first ) .or. ( changed )) then
87              call exf_swapffields_xz( obcs_xz_0, obcs_xz_1, mythid )              call exf_swapffields_xz( obcs_xz_0, obcs_xz_1, mythid )
88    
89              call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr              call exf_GetYearlyFieldName(
90       &           , obcs_xz_1, count1, mythid       I         useYearlyFields, twoDigitYear, obcs_period, year1,
91         I         obcs_file,
92         O         obcs_file1,
93         I         mycurrenttime, mycurrentiter, mythid )
94    
95                call mdsreadfieldxz( obcs_file1, exf_iprec_obcs, exf_yftype
96         &           , Nr, obcs_xz_1, count1, mythid
97       &           )       &           )
98           endif           endif
99    
# Line 84  c     == end of interface == Line 111  c     == end of interface ==
111    
112        endif        endif
113    
114  #endif  #endif /* ALLOW_OBCS */
115    
116        end        end
117    
118        subroutine exf_set_obcs_yz (        subroutine exf_set_obcs_yz (
119       &       obcs_fld_yz, obcs_yz_0, obcs_yz_1       &       obcs_fld_yz, obcs_yz_0, obcs_yz_1
120       I     , obcs_file, obcsmask       I     , obcs_file, obcsmask
121       I     , fac, first, changed, count0, count1       I     , fac, first, changed, useYearlyFields, obcs_period
122         I     , count0, count1, year0, year1
123       I     , mycurrenttime, mycurrentiter, mythid       I     , mycurrenttime, mycurrentiter, mythid
124       &                           )       &                           )
125    
# Line 114  c     == global variables == Line 142  c     == global variables ==
142  #include "EEPARAMS.h"  #include "EEPARAMS.h"
143  #include "SIZE.h"  #include "SIZE.h"
144  #include "GRID.h"  #include "GRID.h"
145  #include "exf_param.h"  #include "EXF_PARAM.h"
146  #include "exf_constants.h"  #include "EXF_CONSTANTS.h"
147    
148  c     == routine arguments ==  c     == routine arguments ==
149    
# Line 125  c     == routine arguments == Line 153  c     == routine arguments ==
153        character*(MAX_LEN_FNAM) obcs_file        character*(MAX_LEN_FNAM) obcs_file
154        character*1 obcsmask        character*1 obcsmask
155        logical first, changed        logical first, changed
156        integer count0, count1        logical useYearlyFields
157          _RL     obcs_period
158          integer count0, count1, year0, year1
159        _RL     fac        _RL     fac
160        _RL     mycurrenttime        _RL     mycurrenttime
161        integer mycurrentiter        integer mycurrentiter
# Line 137  c     == local variables == Line 167  c     == local variables ==
167    
168        integer bi, bj        integer bi, bj
169        integer j, k        integer j, k
170          integer il
171          character*(128) obcs_file0, obcs_file1
172    
173    c     == external ==
174    
175          integer  ilnblnk
176          external ilnblnk
177    
178  c     == end of interface ==  c     == end of interface ==
179    
180        if ( first ) then        if ( obcs_file .NE. ' ' ) then
181          if ( obcs_file .NE. ' ' )  
182       &        call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr           if ( first ) then
183       &                     , obcs_yz_1, count0, mythid  
184       &                     )              call exf_GetYearlyFieldName(
185         I         useYearlyFields, twoDigitYear, obcs_period, year0,
186         I         obcs_file,
187         O         obcs_file0,
188         I         mycurrenttime, mycurrentiter, mythid )
189    
190                call mdsreadfieldyz( obcs_file0, exf_iprec_obcs, exf_yftype
191         &           , Nr, obcs_yz_1, count0, mythid
192         &           )
193             endif
194    
195             if (( first ) .or. ( changed )) then
196                call exf_swapffields_yz( obcs_yz_0, obcs_yz_1, mythid )
197    
198                call exf_GetYearlyFieldName(
199         I         useYearlyFields, twoDigitYear, obcs_period, year1,
200         I         obcs_file,
201         O         obcs_file1,
202         I         mycurrenttime, mycurrentiter, mythid )
203    
204                call mdsreadfieldyz( obcs_file1, exf_iprec_obcs, exf_yftype
205         &           , Nr, obcs_yz_1, count1, mythid
206         &           )
207             endif
208    
209             do bj = mybylo(mythid),mybyhi(mythid)
210                do bi = mybxlo(mythid),mybxhi(mythid)
211                   do k = 1,Nr
212                      do j = 1,sny
213                         obcs_fld_yz(j,k,bi,bj) =
214         &                    fac             *obcs_yz_0(j,k,bi,bj) +
215         &                    (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
216                      enddo
217                   enddo
218                enddo
219             enddo
220    
221        endif        endif
222    
223        if (( first ) .or. ( changed )) then  #endif /* ALLOW_OBCS */
224          call exf_swapffields_yz( obcs_yz_0, obcs_yz_1, mythid )  
225          end
226    
227          subroutine exf_set_obcs_x (
228         &       obcs_fld_x, obcs_x_0, obcs_x_1
229         I     , obcs_file, obcsmask
230         I     , fac, first, changed, useYearlyFields, obcs_period
231         I     , count0, count1, year0, year1
232         I     , mycurrenttime, mycurrentiter, mythid
233         &                           )
234    
235    c     ==================================================================
236    c     SUBROUTINE exf_set_obcs_x
237    c     ==================================================================
238    c
239    c     o set open boundary conditions
240    c       same as exf_set_obcs_xz but for NR=1
241    c
242    c     ==================================================================
243    c     SUBROUTINE exf_set_obcs_x
244    c     ==================================================================
245    
246          implicit none
247    
248    c     == global variables ==
249    
250    #include "EEPARAMS.h"
251    #include "SIZE.h"
252    #include "GRID.h"
253    #include "EXF_PARAM.h"
254    #include "EXF_CONSTANTS.h"
255    
256    c     == routine arguments ==
257    
258          _RL obcs_fld_x(1-olx:snx+olx,nsx,nsy)
259          _RL obcs_x_0(1-olx:snx+olx,nsx,nsy)
260          _RL obcs_x_1(1-olx:snx+olx,nsx,nsy)
261    
262          character*(128) obcs_file
263          character*1 obcsmask
264          logical first, changed
265          logical useYearlyFields
266          _RL     obcs_period
267          integer count0, count1, year0, year1
268          _RL     fac
269          _RL     mycurrenttime
270          integer mycurrentiter
271          integer mythid
272    
273    #ifdef ALLOW_OBCS
274    
275    c     == local variables ==
276    
277          integer bi, bj, i
278    
279          integer il
280          character*(128) obcs_file0, obcs_file1
281    
282    c     == external ==
283    
284          integer  ilnblnk
285          external ilnblnk
286    
287    c     == end of interface ==
288    
289          if ( obcs_file .NE. ' ' ) then
290    
291             if ( first ) then
292    
293                call exf_GetYearlyFieldName(
294         I         useYearlyFields, twoDigitYear, obcs_period, year0,
295         I         obcs_file,
296         O         obcs_file0,
297         I         mycurrenttime, mycurrentiter, mythid )
298    
299                call mdsreadfieldxz( obcs_file0, exf_iprec_obcs, exf_yftype
300         &           , 1, obcs_x_1, count0, mythid
301         &           )
302             endif
303    
304             if (( first ) .or. ( changed )) then
305                call exf_swapffields_x( obcs_x_0, obcs_x_1, mythid )
306    
307                call exf_GetYearlyFieldName(
308         I         useYearlyFields, twoDigitYear, obcs_period, year1,
309         I         obcs_file,
310         O         obcs_file1,
311         I         mycurrenttime, mycurrentiter, mythid )
312    
313                call mdsreadfieldxz( obcs_file1, exf_iprec_obcs, exf_yftype
314         &           , 1, obcs_x_1, count1, mythid
315         &           )
316             endif
317    
318             do bj = mybylo(mythid),mybyhi(mythid)
319                do bi = mybxlo(mythid),mybxhi(mythid)
320                   do i = 1,snx
321                      obcs_fld_x(i,bi,bj) =
322         &                 fac * obcs_x_0(i,bi,bj) +
323         &                 (exf_one - fac) * obcs_x_1(i,bi,bj)
324                   enddo
325                enddo
326             enddo
327    
         if ( obcs_file .NE. ' ' )  
      &       call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr  
      &                     , obcs_yz_1, count1, mythid  
      &                     )  
328        endif        endif
329    
330        do bj = mybylo(mythid),mybyhi(mythid)  #endif /* ALLOW_OBCS */
331          do bi = mybxlo(mythid),mybxhi(mythid)  
332            do k = 1,Nr        end
333              do j = 1,sny  
334                obcs_fld_yz(j,k,bi,bj) =        subroutine exf_set_obcs_y (
335       &              fac             *obcs_yz_0(j,k,bi,bj) +       &       obcs_fld_y, obcs_y_0, obcs_y_1
336       &              (exf_one - fac) *obcs_yz_1(j,k,bi,bj)       I     , obcs_file, obcsmask
337         I     , fac, first, changed, useYearlyFields, obcs_period
338         I     , count0, count1, year0, year1
339         I     , mycurrenttime, mycurrentiter, mythid
340         &                           )
341    
342    c     ==================================================================
343    c     SUBROUTINE exf_set_obcs_y
344    c     ==================================================================
345    c
346    c     o set open boundary conditions
347    c       same as exf_set_obcs_yz but for NR=1
348    c
349    c     ==================================================================
350    c     SUBROUTINE exf_set_obcs_y
351    c     ==================================================================
352    
353          implicit none
354    
355    c     == global variables ==
356    
357    #include "EEPARAMS.h"
358    #include "SIZE.h"
359    #include "GRID.h"
360    #include "EXF_PARAM.h"
361    #include "EXF_CONSTANTS.h"
362    
363    c     == routine arguments ==
364    
365          _RL obcs_fld_y(1-oly:sny+oly,nsx,nsy)
366          _RL obcs_y_0(1-oly:sny+oly,nsx,nsy)
367          _RL obcs_y_1(1-oly:sny+oly,nsx,nsy)
368          character*(MAX_LEN_FNAM) obcs_file
369          character*1 obcsmask
370          logical first, changed
371          logical useYearlyFields
372          _RL     obcs_period
373          integer count0, count1, year0, year1
374          _RL     fac
375          _RL     mycurrenttime
376          integer mycurrentiter
377          integer mythid
378    
379    #ifdef ALLOW_OBCS
380    
381    c     == local variables ==
382    
383          integer bi, bj, j
384    
385          integer il
386          character*(128) obcs_file0, obcs_file1
387    
388    c     == external ==
389    
390          integer  ilnblnk
391          external ilnblnk
392    
393    c     == end of interface ==
394    
395          if ( obcs_file .NE. ' ' ) then
396    
397             if ( first ) then
398    
399                call exf_GetYearlyFieldName(
400         I         useYearlyFields, twoDigitYear, obcs_period, year0,
401         I         obcs_file,
402         O         obcs_file0,
403         I         mycurrenttime, mycurrentiter, mythid )
404    
405                call mdsreadfieldyz( obcs_file0, exf_iprec_obcs, exf_yftype
406         &           , 1, obcs_y_1, count0, mythid
407         &           )
408             endif
409    
410             if (( first ) .or. ( changed )) then
411                call exf_swapffields_y( obcs_y_0, obcs_y_1, mythid )
412    
413                call exf_GetYearlyFieldName(
414         I         useYearlyFields, twoDigitYear, obcs_period, year1,
415         I         obcs_file,
416         O         obcs_file1,
417         I         mycurrenttime, mycurrentiter, mythid )
418    
419                call mdsreadfieldyz( obcs_file1, exf_iprec_obcs, exf_yftype
420         &           , 1, obcs_y_1, count1, mythid
421         &           )
422             endif
423    
424             do bj = mybylo(mythid),mybyhi(mythid)
425                do bi = mybxlo(mythid),mybxhi(mythid)
426                   do j = 1,sny
427                      obcs_fld_y(j,bi,bj) =
428         &                 fac             *obcs_y_0(j,bi,bj) +
429         &                 (exf_one - fac) *obcs_y_1(j,bi,bj)
430                   enddo
431              enddo              enddo
432            enddo           enddo
433          enddo  
434        enddo        endif
435    
436  #endif  #endif /* ALLOW_OBCS */
437    
438        end        end
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22