/[MITgcm]/MITgcm/pkg/obcs/obcs_prescribe_read.F
ViewVC logotype

Diff of /MITgcm/pkg/obcs/obcs_prescribe_read.F

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

revision 1.12 by dimitri, Thu Oct 11 10:30:34 2007 UTC revision 1.22 by dimitri, Fri Apr 25 21:57:49 2008 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  # include "OBCS_OPTIONS.h"  # include "OBCS_OPTIONS.h"
5    
6        subroutine obcs_prescribe_read (        subroutine obcs_prescribe_read (
7       I                      mycurrenttime       I                      mycurrenttime
8       I                    , mycurrentiter       I                    , mycurrentiter
9       I                    , mythid       I                    , mythid
# Line 20  c     |================================= Line 20  c     |=================================
20    
21  c     == global variables ==  c     == global variables ==
22    
 #include "EEPARAMS.h"  
23  #include "SIZE.h"  #include "SIZE.h"
24  #include "GRID.h"  #include "EEPARAMS.h"
25    #include "PARAMS.h"
26  #include "OBCS.h"  #include "OBCS.h"
27  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
28  # include "EXF_PARAM.h"  # include "EXF_PARAM.h"
29  #endif  #endif
 #if (defined (ALLOW_SEAICE) || defined (ALLOW_PTRACERS))  
 # include "PARAMS.h"  
 #endif  
30  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
31  # include "PTRACERS_SIZE.h"  # include "PTRACERS_SIZE.h"
 # include "PTRACERS.h"  
32  # include "OBCS_PTRACERS.h"  # include "OBCS_PTRACERS.h"
33  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
34    
# Line 46  c     == routine arguments == Line 42  c     == routine arguments ==
42    
43  c     == local variables ==  c     == local variables ==
44    
45    c     == end of interface ==
46    
47    # ifdef ALLOW_EXF
48          IF ( useEXF ) THEN
49    #  ifdef ALLOW_OBCS_NORTH
50          call obcs_prescribe_exf_xz (
51         I     obcsNstartdate, obcsNperiod,
52         I     useOBCSYearlyFields,
53         U     OBNu,   OBNu0,   OBNu1,   OBNufile,
54         U     OBNv,   OBNv0,   OBNv1,   OBNvfile,
55         U     OBNt,   OBNt0,   OBNt1,   OBNtfile,
56         U     OBNs,   OBNs0,   OBNs1,   OBNsfile,
57    #   ifdef ALLOW_SEAICE
58         I     siobNstartdate, siobNperiod,
59         U     OBNa,   OBNa0,   OBNa1,   OBNafile,
60         U     OBNh,   OBNh0,   OBNh1,   OBNhfile,
61         U     OBNsl,  OBNsl0,  OBNsl1,  OBNslfile,
62         U     OBNsn,  OBNsn0,  OBNsn1,  OBNsnfile,
63         U     OBNuice,OBNuice0,OBNuice1,OBNuicefile,
64         U     OBNvice,OBNvice0,OBNvice1,OBNvicefile,
65    #   endif
66    #   ifdef ALLOW_PTRACERS
67         U     OBNptr ,OBNptr0, OBNptr1, OBNptrFile,
68    #   endif
69         I     mycurrenttime, mycurrentiter, mythid
70         &     )
71    #  endif /* ALLOW_OBCS_NORTH */
72    
73    #  ifdef ALLOW_OBCS_SOUTH
74          call obcs_prescribe_exf_xz (
75         I     obcsSstartdate, obcsSperiod,
76         I     useOBCSYearlyFields,
77         U     OBSu,   OBSu0,   OBSu1,   OBSufile,
78         U     OBSv,   OBSv0,   OBSv1,   OBSvfile,
79         U     OBSt,   OBSt0,   OBSt1,   OBStfile,
80         U     OBSs,   OBSs0,   OBSs1,   OBSsfile,
81    #   ifdef ALLOW_SEAICE
82         I     siobSstartdate, siobSperiod,
83         U     OBSa,   OBSa0,   OBSa1,   OBSafile,
84         U     OBSh,   OBSh0,   OBSh1,   OBShfile,
85         U     OBSsl,  OBSsl0,  OBSsl1,  OBSslfile,
86         U     OBSsn,  OBSsn0,  OBSsn1,  OBSsnfile,
87         U     OBSuice,OBSuice0,OBSuice1,OBSuicefile,
88         U     OBSvice,OBSvice0,OBSvice1,OBSvicefile,
89    #   endif
90    #   ifdef ALLOW_PTRACERS
91         U     OBSptr ,OBSptr0, OBSptr1, OBSptrFile,
92    #   endif
93         I     mycurrenttime, mycurrentiter, mythid
94         &     )
95    #  endif /* ALLOW_OBCS_SOUTH */
96    
97    #  ifdef ALLOW_OBCS_EAST
98          call obcs_prescribe_exf_yz (
99         I     obcsEstartdate, obcsEperiod,
100         I     useOBCSYearlyFields,
101         U     OBEu,   OBEu0,   OBEu1,   OBEufile,
102         U     OBEv,   OBEv0,   OBEv1,   OBEvfile,
103         U     OBEt,   OBEt0,   OBEt1,   OBEtfile,
104         U     OBEs,   OBEs0,   OBEs1,   OBEsfile,
105    #   ifdef ALLOW_SEAICE
106         I     siobEstartdate, siobEperiod,
107         U     OBEa,   OBEa0,   OBEa1,   OBEafile,
108         U     OBEh,   OBEh0,   OBEh1,   OBEhfile,
109         U     OBEsl,  OBEsl0,  OBEsl1,  OBEslfile,
110         U     OBEsn,  OBEsn0,  OBEsn1,  OBEsnfile,
111         U     OBEuice,OBEuice0,OBEuice1,OBEuicefile,
112         U     OBEvice,OBEvice0,OBEvice1,OBEvicefile,
113    #   endif
114    #   ifdef ALLOW_PTRACERS
115         U     OBEptr ,OBEptr0, OBEptr1, OBEptrFile,
116    #   endif
117         I     mycurrenttime, mycurrentiter, mythid
118         &     )
119    #  endif /* ALLOW_OBCS_EAST */
120    
121    #  ifdef ALLOW_OBCS_WEST
122          call obcs_prescribe_exf_yz (
123         I     obcsWstartdate, obcsWperiod,
124         I     useOBCSYearlyFields,
125         U     OBWu,   OBWu0,   OBWu1,   OBWufile,
126         U     OBWv,   OBWv0,   OBWv1,   OBWvfile,
127         U     OBWt,   OBWt0,   OBWt1,   OBWtfile,
128         U     OBWs,   OBWs0,   OBWs1,   OBWsfile,
129    #   ifdef ALLOW_SEAICE
130         I     siobEstartdate, siobEperiod,
131         U     OBWa,   OBWa0,   OBWa1,   OBWafile,
132         U     OBWh,   OBWh0,   OBWh1,   OBWhfile,
133         U     OBWsl,  OBWsl0,  OBWsl1,  OBWslfile,
134         U     OBWsn,  OBWsn0,  OBWsn1,  OBWsnfile,
135         U     OBWuice,OBWuice0,OBWuice1,OBWuicefile,
136         U     OBWvice,OBWvice0,OBWvice1,OBWvicefile,
137    #   endif
138    #   ifdef ALLOW_PTRACERS
139         U     OBWptr ,OBWptr0, OBWptr1, OBWptrFile,
140    #   endif
141         I     mycurrenttime, mycurrentiter, mythid
142         &     )
143    #  endif /* ALLOW_OBCS_WEST */
144    C     ENDIF useEXF
145          ENDIF
146    # endif /* ALLOW_EXF */
147    
148    # ifdef ALLOW_OBCS_CONTROL
149    cgg   WARNING: Assuming North Open Boundary exists and has same
150    cgg    calendar information as other boundaries.
151          call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )
152    # endif
153    
154    # ifdef ALLOW_OBCSN_CONTROL
155          call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )
156    # endif
157    
158    # ifdef ALLOW_OBCSS_CONTROL
159          call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )
160    # endif
161    
162    # ifdef ALLOW_OBCSW_CONTROL
163          call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )
164    # endif
165    
166    # ifdef ALLOW_OBCSE_CONTROL
167          call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )
168    # endif
169    
170          IF ( .NOT. useEXF ) THEN
171    #ifndef ALLOW_AUTODIFF_TAMC
172           CALL OBCS_EXTERNAL_FIELDS_LOAD(
173         &     myCurrentTime, myCurrentIter, myThid )
174    #else
175           STOP 'PH HAS DISABLED THIS RUNTIME OPTION FOR ALLOW_EXF'
176    #endif
177          ENDIF
178    
179    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE */
180    
181          RETURN
182          END
183    
184    
185    C=========================================================================
186    C=========================================================================
187    
188          subroutine obcs_prescribe_exf_xz (
189         I     obcsstartdate, obcsperiod,
190         I     useYearlyFields,
191         U     OBu,   OBu0,   OBu1,   OBufile,
192         U     OBv,   OBv0,   OBv1,   OBvfile,
193         U     OBt,   OBt0,   OBt1,   OBtfile,
194         U     OBs,   OBs0,   OBs1,   OBsfile,
195    #ifdef ALLOW_SEAICE
196         I     siobstartdate, siobperiod,
197         U     OBa,   OBa0,   OBa1,   OBafile,
198         U     OBh,   OBh0,   OBh1,   OBhfile,
199         U     OBsl,  OBsl0,  OBsl1,  OBslfile,
200         U     OBsn,  OBsn0,  OBsn1,  OBsnfile,
201         U     OBuice,OBuice0,OBuice1,OBuicefile,
202         U     OBvice,OBvice0,OBvice1,OBvicefile,
203    #endif
204    #ifdef ALLOW_PTRACERS
205         U     OBptr ,OBptr0, OBptr1, OBptrFile,
206    #endif
207         I     mycurrenttime, mycurrentiter, mythid
208         &     )
209    c     |==================================================================|
210    c     | SUBROUTINE obcs_prescribe_exf_xz                                 |
211    c     |==================================================================|
212    c     | read open boundary conditions from file                          |
213    c     | N.B.: * uses exf and cal routines for file/record handling       |
214    c     |       * uses ctrl routines for control variable handling         |
215    c     |==================================================================|
216    
217          implicit none
218    
219    c     == global variables ==
220    
221    #include "SIZE.h"
222    #include "EEPARAMS.h"
223    #include "PARAMS.h"
224  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
225    # include "EXF_PARAM.h"
226    #endif
227    #ifdef ALLOW_PTRACERS
228    # include "PTRACERS_SIZE.h"
229    # include "PTRACERS_PARAMS.h"
230    #endif /* ALLOW_PTRACERS */
231    
232    c     == routine arguments ==
233    
234          _RL     obcsstartdate
235          _RL     obcsperiod
236          LOGICAL useYearlyFields
237          _RL OBu     (1-Olx:sNx+Olx,Nr,nSx,nSy)
238          _RL OBv     (1-Olx:sNx+Olx,Nr,nSx,nSy)
239          _RL OBt     (1-Olx:sNx+Olx,Nr,nSx,nSy)
240          _RL OBs     (1-Olx:sNx+Olx,Nr,nSx,nSy)
241          _RL OBu0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
242          _RL OBv0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
243          _RL OBt0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
244          _RL OBs0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
245          _RL OBu1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
246          _RL OBv1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
247          _RL OBt1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
248          _RL OBs1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
249          CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
250    #ifdef ALLOW_SEAICE
251          _RL     siobstartdate
252          _RL     siobperiod
253          _RL OBa     (1-Olx:sNx+Olx,nSx,nSy)
254          _RL OBh     (1-Olx:sNx+Olx,nSx,nSy)
255          _RL OBa0    (1-Olx:sNx+Olx,nSx,nSy)
256          _RL OBh0    (1-Olx:sNx+Olx,nSx,nSy)
257          _RL OBa1    (1-Olx:sNx+Olx,nSx,nSy)
258          _RL OBh1    (1-Olx:sNx+Olx,nSx,nSy)
259          _RL OBsl    (1-Olx:sNx+Olx,nSx,nSy)
260          _RL OBsn    (1-Olx:sNx+Olx,nSx,nSy)
261          _RL OBsl0   (1-Olx:sNx+Olx,nSx,nSy)
262          _RL OBsn0   (1-Olx:sNx+Olx,nSx,nSy)
263          _RL OBsl1   (1-Olx:sNx+Olx,nSx,nSy)
264          _RL OBsn1   (1-Olx:sNx+Olx,nSx,nSy)
265          _RL OBuice  (1-Olx:sNx+Olx,nSx,nSy)
266          _RL OBvice  (1-Olx:sNx+Olx,nSx,nSy)
267          _RL OBuice0 (1-Olx:sNx+Olx,nSx,nSy)
268          _RL OBvice0 (1-Olx:sNx+Olx,nSx,nSy)
269          _RL OBuice1 (1-Olx:sNx+Olx,nSx,nSy)
270          _RL OBvice1 (1-Olx:sNx+Olx,nSx,nSy)
271          CHARACTER*(MAX_LEN_FNAM)
272         &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
273    #endif /* ALLOW_SEAICE */
274    #ifdef ALLOW_PTRACERS
275          _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
276          _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
277          _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
278          CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
279    #endif /* ALLOW_PTRACERS */
280          _RL     mycurrenttime
281          integer mycurrentiter
282          integer mythid
283    
284    #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
285        && defined ALLOW_EXF
286    
287    c     == local variables ==
288        logical first, changed        logical first, changed
289        integer count0, count1        integer count0, count1
290        integer year0, year1        integer year0, year1
291        _RL     fac        _RL     fac
292  #ifdef ALLOW_PTRACERS  # ifdef ALLOW_PTRACERS
293        integer iTracer, i,j,k        integer iTracer
294  #endif /* ALLOW_PTRACERS */  # endif /* ALLOW_PTRACERS */
 #endif /* ALLOW_EXF */  
295    
296  c     == end of interface ==  c     == end of interface ==
297          if ( obcsperiod .eq. -12 ) then
298    c     obcsperiod=-12 means input file contains 12 monthly means
299    c     record numbers are assumed 1 to 12 corresponding to
300    c     Jan. through Dec.
301           call cal_GetMonthsRec(
302         O                        fac, first, changed,
303         O                        count0, count1,
304         I                        mycurrenttime, mycurrentiter, mythid
305         &           )
306    
307          elseif ( obcsperiod .lt. 0 ) then
308           print *, 'obcsperiod is out of range'
309           STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
310          else
311    c     get record numbers and interpolation factor
312           call exf_GetFFieldRec(
313         I                       obcsstartdate, obcsperiod,
314         I                       useYearlyFields,
315         O                       fac, first, changed,
316         O                       count0, count1, year0, year1,
317         I                       mycurrenttime, mycurrentiter, mythid
318         &                      )
319    # ifdef ALLOW_SEAICE
320           IF (useSEAICE) THEN
321            call exf_GetFFieldRec(
322         I                       siobstartdate, siobperiod,
323         I                       useYearlyFields,
324         O                       fac, first, changed,
325         O                       count0, count1, year0, year1,
326         I                       mycurrenttime, mycurrentiter, mythid
327         &                      )
328           ENDIF
329    # endif /* ALLOW_SEAICE */
330          endif
331    
332  #ifdef ALLOW_EXF        call exf_set_obcs_xz(  OBu, OBu0, OBu1, OBufile, 'u'
333  #ifdef ALLOW_OBCS_NORTH       I                     , fac, first, changed, useYearlyFields
334        call exf_getffieldrec(       I                     , obcsperiod, count0, count1, year0, year1
335       I                       obcsNstartdate, obcsNperiod       I                     , mycurrenttime, mycurrentiter, mythid )
336       I                     , obcsNstartdate1, obcsNstartdate2        call exf_set_obcs_xz(  OBv, OBv0, OBv1, OBvfile, 'v'
337       I                     , .false.       I                     , fac, first, changed, useYearlyFields
338       O                     , fac, first, changed       I                     , obcsperiod, count0, count1, year0, year1
339       O                     , count0, count1, year0, year1       I                     , mycurrenttime, mycurrentiter, mythid )
340       I                     , mycurrenttime, mycurrentiter, mythid        call exf_set_obcs_xz(  OBt, OBt0, OBt1, OBtfile, 's'
341       &                     )       I                     , fac, first, changed, useYearlyFields
342         I                     , obcsperiod, count0, count1, year0, year1
343        call exf_set_obcs_xz(  OBNu, OBNu0, OBNu1, OBNufile, 'u'       I                     , mycurrenttime, mycurrentiter, mythid )
344       I                     , fac, first, changed, count0, count1        call exf_set_obcs_xz(  OBs, OBs0, OBs1, OBsfile, 's'
345         I                     , fac, first, changed, useYearlyFields
346         I                     , obcsperiod, count0, count1, year0, year1
347       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
348        call exf_set_obcs_xz(  OBNv, OBNv0, OBNv1, OBNvfile, 'v'  # ifdef ALLOW_SEAICE
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBNt, OBNt0, OBNt1, OBNtfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBNs, OBNs0, OBNs1, OBNsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
 #ifdef ALLOW_SEAICE  
349        IF (useSEAICE) THEN        IF (useSEAICE) THEN
350         call exf_set_obcs_x (  OBNa, OBNa0, OBNa1, OBNafile, 's'         call exf_set_obcs_x (  OBa, OBa0, OBa1, OBafile, 's'
351       I                     , fac, first, changed, count0, count1       I                     , fac, first, changed, useYearlyFields
352       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , siobperiod, count0, count1, year0, year1
353         call exf_set_obcs_x (  OBNh, OBNh0, OBNh1, OBNhfile, 's'       I                     , mycurrenttime, mycurrentiter, mythid )
354       I                     , fac, first, changed, count0, count1         call exf_set_obcs_x (  OBh, OBh0, OBh1, OBhfile, 's'
355         I                     , fac, first, changed, useYearlyFields
356         I                     , siobperiod, count0, count1, year0, year1
357         I                     , mycurrenttime, mycurrentiter, mythid )
358           call exf_set_obcs_x (  OBsl, OBsl0, OBsl1, OBslfile, 's'
359         I                     , fac, first, changed, useYearlyFields
360         I                     , siobperiod, count0, count1, year0, year1
361         I                     , mycurrenttime, mycurrentiter, mythid )
362           call exf_set_obcs_x (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
363         I                     , fac, first, changed, useYearlyFields
364         I                     , siobperiod, count0, count1, year0, year1
365         I                     , mycurrenttime, mycurrentiter, mythid )
366           call exf_set_obcs_x ( OBuice,OBuice0,OBuice1,OBuicefile,'u'
367         I                     , fac, first, changed, useYearlyFields
368         I                     , siobperiod, count0, count1, year0, year1
369         I                     , mycurrenttime, mycurrentiter, mythid )
370           call exf_set_obcs_x ( OBvice,OBvice0,OBvice1,OBvicefile,'v'
371         I                     , fac, first, changed, useYearlyFields
372         I                     , siobperiod, count0, count1, year0, year1
373       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
374        ENDIF        ENDIF
375  #endif /* ALLOW_SEAICE */  # endif /* ALLOW_SEAICE */
376  #ifdef ALLOW_PTRACERS  # ifdef ALLOW_PTRACERS
377        if ( usePTRACERS ) then        if ( usePTRACERS ) then
378         do itracer = 1, PTRACERS_numInUse         do iTracer = 1, PTRACERS_numInUse
379          call exf_set_obcs_xz(  OBNptr (1-Olx,1,1,1,iTracer)          call exf_set_obcs_xz(  OBptr (1-Olx,1,1,1,iTracer)
380       I                       , OBNptr0(1-Olx,1,1,1,iTracer)       I                       , OBptr0(1-Olx,1,1,1,iTracer)
381       I                       , OBNptr1(1-Olx,1,1,1,iTracer)       I                       , OBptr1(1-Olx,1,1,1,iTracer)
382       I                       , OBNptrFile(iTracer), 's'       I                       , OBptrFile(iTracer), 's'
383       I                       , fac, first, changed, count0, count1       I                       , fac, first, changed, useYearlyFields
384         I                       , obcsperiod, count0, count1, year0, year1
385       I                       , mycurrenttime, mycurrentiter, mythid )       I                       , mycurrenttime, mycurrentiter, mythid )
386         enddo         enddo
387        endif        endif
388  #endif /* ALLOW_PTRACERS */  # endif /* ALLOW_PTRACERS */
 #endif /* ALLOW_OBCS_NORTH */  
389    
390  #ifdef ALLOW_OBCS_SOUTH  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
391        call exf_getffieldrec(        RETURN
392       I                       obcsSstartdate, obcsSperiod        END
393       I                     , obcsSstartdate1, obcsSstartdate2  C=========================================================================
394       I                     , .false.  C=========================================================================
      O                     , fac, first, changed  
      O                     , count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
395    
396        call exf_set_obcs_xz(  OBSu, OBSu0, OBSu1, OBSufile, 'u'        subroutine obcs_prescribe_exf_yz (
397       I                     , fac, first, changed, count0, count1       I     obcsstartdate, obcsperiod,
398       I                     , mycurrenttime, mycurrentiter, mythid )       I     useYearlyFields,
399        call exf_set_obcs_xz(  OBSv, OBSv0, OBSv1, OBSvfile, 'v'       U     OBu,   OBu0,   OBu1,   OBufile,
400       I                     , fac, first, changed, count0, count1       U     OBv,   OBv0,   OBv1,   OBvfile,
401       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBt,   OBt0,   OBt1,   OBtfile,
402        call exf_set_obcs_xz(  OBSt, OBSt0, OBSt1, OBStfile, 's'       U     OBs,   OBs0,   OBs1,   OBsfile,
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBSs, OBSs0, OBSs1, OBSsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
403  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
404        IF (useSEAICE) THEN       I     siobstartdate, siobperiod,
405         call exf_set_obcs_x (  OBSa, OBSa0, OBSa1, OBSafile, 's'       U     OBa,   OBa0,   OBa1,   OBafile,
406       I                     , fac, first, changed, count0, count1       U     OBh,   OBh0,   OBh1,   OBhfile,
407       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBsl,  OBsl0,  OBsl1,  OBslfile,
408         call exf_set_obcs_x (  OBSh, OBSh0, OBSh1, OBShfile, 's'       U     OBsn,  OBsn0,  OBsn1,  OBsnfile,
409       I                     , fac, first, changed, count0, count1       U     OBuice,OBuice0,OBuice1,OBuicefile,
410       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBvice,OBvice0,OBvice1,OBvicefile,
411        ENDIF  #endif
 #endif /* ALLOW_SEAICE */  
412  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
413        if ( usePTRACERS ) then       U     OBptr ,OBptr0, OBptr1, OBptrFile,
414         do itracer = 1, PTRACERS_numInUse  #endif
415          call exf_set_obcs_xz(  OBSptr (1-Olx,1,1,1,iTracer)       I     mycurrenttime, mycurrentiter, mythid
416       I                       , OBSptr0(1-Olx,1,1,1,iTracer)       &     )
417       I                       , OBSptr1(1-Olx,1,1,1,iTracer)  c     |==================================================================|
418       I                       , OBSptrFile(iTracer), 's'  c     | SUBROUTINE obcs_prescribe_exf_yz                                 |
419       I                       , fac, first, changed, count0, count1  c     |==================================================================|
420       I                       , mycurrenttime, mycurrentiter, mythid )  c     | read open boundary conditions from file                          |
421         enddo  c     | N.B.: * uses exf and cal routines for file/record handling       |
422        endif  c     |       * uses ctrl routines for control variable handling         |
423    c     |==================================================================|
424    
425          implicit none
426    
427    c     == global variables ==
428    
429    #include "SIZE.h"
430    #include "EEPARAMS.h"
431    #include "PARAMS.h"
432    #ifdef ALLOW_EXF
433    # include "EXF_PARAM.h"
434    #endif
435    #ifdef ALLOW_PTRACERS
436    # include "PTRACERS_SIZE.h"
437    # include "PTRACERS_PARAMS.h"
438  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
 #endif /* ALLOW_OBCS_SOUTH */  
439    
440  #ifdef ALLOW_OBCS_EAST  c     == routine arguments ==
       call exf_getffieldrec(  
      I                       obcsEstartdate, obcsEperiod  
      I                     , obcsEstartdate1, obcsEstartdate2  
      I                     , .false.  
      O                     , fac, first, changed  
      O                     , count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
441    
442        call exf_set_obcs_yz(  OBEu, OBEu0, OBEu1, OBEufile, 'u'        _RL     obcsstartdate
443       I                     , fac, first, changed, count0, count1        _RL     obcsperiod
444       I                     , mycurrenttime, mycurrentiter, mythid )        LOGICAL useYearlyFields
445        call exf_set_obcs_yz(  OBEv, OBEv0, OBEv1, OBEvfile, 'v'        _RL OBu     (1-Oly:sNy+Oly,Nr,nSx,nSy)
446       I                     , fac, first, changed, count0, count1        _RL OBv     (1-Oly:sNy+Oly,Nr,nSx,nSy)
447       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBt     (1-Oly:sNy+Oly,Nr,nSx,nSy)
448        call exf_set_obcs_yz(  OBEt, OBEt0, OBEt1, OBEtfile, 's'        _RL OBs     (1-Oly:sNy+Oly,Nr,nSx,nSy)
449       I                     , fac, first, changed, count0, count1        _RL OBu0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
450       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBv0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
451        call exf_set_obcs_yz(  OBEs, OBEs0, OBEs1, OBEsfile, 's'        _RL OBt0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
452       I                     , fac, first, changed, count0, count1        _RL OBs0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
453       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBu1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
454          _RL OBv1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
455          _RL OBt1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
456          _RL OBs1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
457          CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
458  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
459        IF (useSEAICE) THEN        _RL     siobstartdate
460         call exf_set_obcs_y (  OBEa, OBEa0, OBEa1, OBEafile, 's'        _RL     siobperiod
461       I                     , fac, first, changed, count0, count1        _RL OBa     (1-Oly:sNy+Oly,nSx,nSy)
462       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBh     (1-Oly:sNy+Oly,nSx,nSy)
463         call exf_set_obcs_y (  OBEh, OBEh0, OBEh1, OBEhfile, 's'        _RL OBa0    (1-Oly:sNy+Oly,nSx,nSy)
464       I                     , fac, first, changed, count0, count1        _RL OBh0    (1-Oly:sNy+Oly,nSx,nSy)
465       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBa1    (1-Oly:sNy+Oly,nSx,nSy)
466        ENDIF        _RL OBh1    (1-Oly:sNy+Oly,nSx,nSy)
467          _RL OBsl    (1-Oly:sNy+Oly,nSx,nSy)
468          _RL OBsn    (1-Oly:sNy+Oly,nSx,nSy)
469          _RL OBsl0   (1-Oly:sNy+Oly,nSx,nSy)
470          _RL OBsn0   (1-Oly:sNy+Oly,nSx,nSy)
471          _RL OBsl1   (1-Oly:sNy+Oly,nSx,nSy)
472          _RL OBsn1   (1-Oly:sNy+Oly,nSx,nSy)
473          _RL OBuice  (1-Oly:sNy+Oly,nSx,nSy)
474          _RL OBvice  (1-Oly:sNy+Oly,nSx,nSy)
475          _RL OBuice0 (1-Oly:sNy+Oly,nSx,nSy)
476          _RL OBvice0 (1-Oly:sNy+Oly,nSx,nSy)
477          _RL OBuice1 (1-Oly:sNy+Oly,nSx,nSy)
478          _RL OBvice1 (1-Oly:sNy+Oly,nSx,nSy)
479          CHARACTER*(MAX_LEN_FNAM)
480         &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
481  #endif /* ALLOW_SEAICE */  #endif /* ALLOW_SEAICE */
482  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
483        if ( usePTRACERS ) then        _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
484         do itracer = 1, PTRACERS_numInUse        _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
485          call exf_set_obcs_yz(  OBEptr (1-Oly,1,1,1,iTracer)        _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
486       I                       , OBEptr0(1-Oly,1,1,1,iTracer)        CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
      I                       , OBEptr1(1-Oly,1,1,1,iTracer)  
      I                       , OBEptrFile(iTracer), 's'  
      I                       , fac, first, changed, count0, count1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
487  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
488  #endif /* ALLOW_OBCS_EAST */        _RL     mycurrenttime
489          integer mycurrentiter
490          integer mythid
491    
492  #ifdef ALLOW_OBCS_WEST  #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
493        call exf_getffieldrec(      && defined ALLOW_EXF
      I                       obcsWstartdate, obcsWperiod  
      I                     , obcsWstartdate1, obcsWstartdate2  
      I                     , .false.  
      O                     , fac, first, changed  
      O                     , count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
494    
495        call exf_set_obcs_yz(  OBWu, OBWu0, OBWu1, OBWufile, 'u'  c     == local variables ==
496       I                     , fac, first, changed, count0, count1        logical first, changed
497       I                     , mycurrenttime, mycurrentiter, mythid )        integer count0, count1
498        call exf_set_obcs_yz(  OBWv, OBWv0, OBWv1, OBWvfile, 'v'        integer year0, year1
499       I                     , fac, first, changed, count0, count1        _RL     fac
500       I                     , mycurrenttime, mycurrentiter, mythid )  # ifdef ALLOW_PTRACERS
501        call exf_set_obcs_yz(  OBWt, OBWt0, OBWt1, OBWtfile, 's'        integer iTracer
502       I                     , fac, first, changed, count0, count1  # endif /* ALLOW_PTRACERS */
503       I                     , mycurrenttime, mycurrentiter, mythid )  
504        call exf_set_obcs_yz(  OBWs, OBWs0, OBWs1, OBWsfile, 's'  c     == end of interface ==
505       I                     , fac, first, changed, count0, count1        if ( obcsperiod .eq. -12 ) then
506    c     obcsperiod=-12 means input file contains 12 monthly means
507    c     record numbers are assumed 1 to 12 corresponding to
508    c     Jan. through Dec.
509           call cal_GetMonthsRec(
510         O                        fac, first, changed,
511         O                        count0, count1,
512         I                        mycurrenttime, mycurrentiter, mythid
513         &           )
514    
515          elseif ( obcsperiod .lt. 0 ) then
516           print *, 'obcsperiod is out of range'
517           STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'
518          else
519    c     get record numbers and interpolation factor
520           call exf_GetFFieldRec(
521         I                       obcsstartdate, obcsperiod,
522         I                       useYearlyFields,
523         O                       fac, first, changed,
524         O                       count0, count1, year0, year1,
525         I                       mycurrenttime, mycurrentiter, mythid
526         &                      )
527    # ifdef ALLOW_SEAICE
528           IF (useSEAICE) THEN
529            call exf_GetFFieldRec(
530         I                       siobstartdate, siobperiod,
531         I                       useYearlyFields,
532         O                       fac, first, changed,
533         O                       count0, count1, year0, year1,
534         I                       mycurrenttime, mycurrentiter, mythid
535         &                      )
536           ENDIF
537    # endif /* ALLOW_SEAICE */
538          endif
539    
540          call exf_set_obcs_yz(  OBu, OBu0, OBu1, OBufile, 'u'
541         I                     , fac, first, changed, useYearlyFields
542         I                     , obcsperiod, count0, count1, year0, year1
543         I                     , mycurrenttime, mycurrentiter, mythid )
544          call exf_set_obcs_yz(  OBv, OBv0, OBv1, OBvfile, 'v'
545         I                     , fac, first, changed, useYearlyFields
546         I                     , obcsperiod, count0, count1, year0, year1
547         I                     , mycurrenttime, mycurrentiter, mythid )
548          call exf_set_obcs_yz(  OBt, OBt0, OBt1, OBtfile, 's'
549         I                     , fac, first, changed, useYearlyFields
550         I                     , obcsperiod, count0, count1, year0, year1
551         I                     , mycurrenttime, mycurrentiter, mythid )
552          call exf_set_obcs_yz(  OBs, OBs0, OBs1, OBsfile, 's'
553         I                     , fac, first, changed, useYearlyFields
554         I                     , obcsperiod, count0, count1, year0, year1
555       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
556  #ifdef ALLOW_SEAICE  # ifdef ALLOW_SEAICE
557        IF (useSEAICE) THEN        IF (useSEAICE) THEN
558         call exf_set_obcs_y (  OBWa, OBWa0, OBWa1, OBWafile, 's'         call exf_set_obcs_y (  OBa, OBa0, OBa1, OBafile, 's'
559       I                     , fac, first, changed, count0, count1       I                     , fac, first, changed, useYearlyFields
560       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , siobperiod, count0, count1, year0, year1
561         call exf_set_obcs_y (  OBWh, OBWh0, OBWh1, OBWhfile, 's'       I                     , mycurrenttime, mycurrentiter, mythid )
562       I                     , fac, first, changed, count0, count1         call exf_set_obcs_y (  OBh, OBh0, OBh1, OBhfile, 's'
563         I                     , fac, first, changed, useYearlyFields
564         I                     , siobperiod, count0, count1, year0, year1
565         I                     , mycurrenttime, mycurrentiter, mythid )
566           call exf_set_obcs_y (  OBsl, OBsl0, OBsl1, OBslfile, 's'
567         I                     , fac, first, changed, useYearlyFields
568         I                     , siobperiod, count0, count1, year0, year1
569         I                     , mycurrenttime, mycurrentiter, mythid )
570           call exf_set_obcs_y (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
571         I                     , fac, first, changed, useYearlyFields
572         I                     , siobperiod, count0, count1, year0, year1
573         I                     , mycurrenttime, mycurrentiter, mythid )
574           call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'u'
575         I                     , fac, first, changed, useYearlyFields
576         I                     , siobperiod, count0, count1, year0, year1
577         I                     , mycurrenttime, mycurrentiter, mythid )
578           call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'v'
579         I                     , fac, first, changed, useYearlyFields
580         I                     , siobperiod, count0, count1, year0, year1
581       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
582        ENDIF        ENDIF
583  #endif /* ALLOW_SEAICE */  # endif /* ALLOW_SEAICE */
584  #ifdef ALLOW_PTRACERS  # ifdef ALLOW_PTRACERS
585        if ( usePTRACERS ) then        if ( usePTRACERS ) then
586         do itracer = 1, PTRACERS_numInUse         do iTracer = 1, PTRACERS_numInUse
587          call exf_set_obcs_yz(  OBWptr (1-Oly,1,1,1,iTracer)          call exf_set_obcs_yz(  OBptr (1-Olx,1,1,1,iTracer)
588       I                       , OBWptr0(1-Oly,1,1,1,iTracer)       I                       , OBptr0(1-Olx,1,1,1,iTracer)
589       I                       , OBWptr1(1-Oly,1,1,1,iTracer)       I                       , OBptr1(1-Olx,1,1,1,iTracer)
590       I                       , OBWptrFile(iTracer), 's'       I                       , OBptrFile(iTracer), 's'
591       I                       , fac, first, changed, count0, count1       I                       , fac, first, changed, useYearlyFields
592         I                       , obcsperiod, count0, count1, year0, year1
593       I                       , mycurrenttime, mycurrentiter, mythid )       I                       , mycurrenttime, mycurrentiter, mythid )
594         enddo         enddo
595        endif        endif
596  #endif /* ALLOW_PTRACERS */  # endif /* ALLOW_PTRACERS */
 #endif /* ALLOW_OBCS_WEST */  
   
 #ifdef ALLOW_OBCS_CONTROL  
 cgg   WARNING: Assuming North Open Boundary exists and has same  
 cgg    calendar information as other boundaries.  
       call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSN_CONTROL  
       call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSS_CONTROL  
       call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSW_CONTROL  
       call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSE_CONTROL  
       call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #else /* not ALLOW_EXF */  
       CALL OBCS_EXTERNAL_FIELDS_LOAD(  
      &     myCurrentTime, myCurrentIter, myThid )  
 #endif /*  ALLOw_EXF */  
   
 #endif /* ALLOW_OBCS */  
597    
598    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
599        RETURN        RETURN
600        END        END
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22