/[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.1 by heimbach, Wed Sep 22 20:43:04 2004 UTC revision 1.19 by dimitri, Fri Feb 22 20:25:54 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
30    #ifdef ALLOW_PTRACERS
31    # include "PTRACERS_SIZE.h"
32    # include "OBCS_PTRACERS.h"
33    #endif /* ALLOW_PTRACERS */
34    
35  c     == routine arguments ==  c     == routine arguments ==
36    
# Line 38  c     == routine arguments == Line 42  c     == routine arguments ==
42    
43  c     == local variables ==  c     == local variables ==
44    
       logical first, changed  
       integer count0, count1  
       _RL     fac  
   
45  c     == end of interface ==  c     == end of interface ==
46    
47  #ifdef ALLOW_OBCS_NORTH  # ifdef ALLOW_EXF
48        call exf_getffieldrec(        IF ( useEXF ) THEN
49       I                       obcsNstartdate, obcsNperiod  #  ifdef ALLOW_OBCS_NORTH
50       O                     , fac, first, changed, count0, count1        call obcs_prescribe_exf_xz (
51       I                     , mycurrenttime, mycurrentiter, mythid       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        call exf_set_obcs_xz(  OBNu, OBNu0, OBNu1, OBNufile, 'u'  # ifdef ALLOW_OBCS_CONTROL
149       I                     , fac, first, changed, count0, count1  cgg   WARNING: Assuming North Open Boundary exists and has same
150       I                     , mycurrenttime, mycurrentiter, mythid )  cgg    calendar information as other boundaries.
151        call exf_set_obcs_xz(  OBNv, OBNv0, OBNv1, OBNvfile, 'v'        call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )
152       I                     , fac, first, changed, count0, count1  # endif
      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 )  
 #endif  
153    
154  #ifdef ALLOW_OBCS_SOUTH  # ifdef ALLOW_OBCSN_CONTROL
155        call exf_getffieldrec(        call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )
156       I                       obcsSstartdate, obcsSperiod  # endif
      O                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
157    
158        call exf_set_obcs_xz(  OBSu, OBSu0, OBSu1, OBSufile, 'u'  # ifdef ALLOW_OBCSS_CONTROL
159       I                     , fac, first, changed, count0, count1        call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )
160       I                     , mycurrenttime, mycurrentiter, mythid )  # endif
       call exf_set_obcs_xz(  OBSv, OBSv0, OBSv1, OBSvfile, 'v'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBSt, OBSt0, OBSt1, OBStfile, 's'  
      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 )  
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           CALL OBCS_EXTERNAL_FIELDS_LOAD(
172         &     myCurrentTime, myCurrentIter, myThid )
173          ENDIF
174    
175    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE */
176    
177          RETURN
178          END
179    
180    
181    C=========================================================================
182    C=========================================================================
183    
184          subroutine obcs_prescribe_exf_xz (
185         I     obcsstartdate, obcsperiod,
186         I     useYearlyFields,
187         U     OBu,   OBu0,   OBu1,   OBufile,
188         U     OBv,   OBv0,   OBv1,   OBvfile,
189         U     OBt,   OBt0,   OBt1,   OBtfile,
190         U     OBs,   OBs0,   OBs1,   OBsfile,
191    #ifdef ALLOW_SEAICE
192         I     siobstartdate, siobperiod,
193         U     OBa,   OBa0,   OBa1,   OBafile,
194         U     OBh,   OBh0,   OBh1,   OBhfile,
195         U     OBsl,  OBsl0,  OBsl1,  OBslfile,
196         U     OBsn,  OBsn0,  OBsn1,  OBsnfile,
197         U     OBuice,OBuice0,OBuice1,OBuicefile,
198         U     OBvice,OBvice0,OBvice1,OBvicefile,
199  #endif  #endif
200    #ifdef ALLOW_PTRACERS
201         U     OBptr ,OBptr0, OBptr1, OBptrFile,
202    #endif
203         I     mycurrenttime, mycurrentiter, mythid
204         &     )
205    c     |==================================================================|
206    c     | SUBROUTINE obcs_prescribe_exf_xz                                 |
207    c     |==================================================================|
208    c     | read open boundary conditions from file                          |
209    c     | N.B.: * uses exf and cal routines for file/record handling       |
210    c     |       * uses ctrl routines for control variable handling         |
211    c     |==================================================================|
212    
213  #ifdef ALLOW_OBCS_EAST        implicit none
       call exf_getffieldrec(  
      I                       obcsEstartdate, obcsEperiod  
      O                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
214    
215        call exf_set_obcs_yz(  OBEu, OBEu0, OBEu1, OBEufile, 'u'  c     == global variables ==
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBEv, OBEv0, OBEv1, OBEvfile, 'v'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBEt, OBEt0, OBEt1, OBEtfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBEs, OBEs0, OBEs1, OBEsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
216    
217    #include "SIZE.h"
218    #include "EEPARAMS.h"
219    #include "PARAMS.h"
220    #ifdef ALLOW_EXF
221    # include "EXF_PARAM.h"
222  #endif  #endif
223    #ifdef ALLOW_PTRACERS
224    # include "PTRACERS_SIZE.h"
225    # include "PTRACERS_PARAMS.h"
226    #endif /* ALLOW_PTRACERS */
227    
228  #ifdef ALLOW_OBCS_WEST  c     == routine arguments ==
       call exf_getffieldrec(  
      I                       obcsWstartdate, obcsWperiod  
      O                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
229    
230        call exf_set_obcs_yz(  OBWu, OBWu0, OBWu1, OBWufile, 'u'        _RL     obcsstartdate
231       I                     , fac, first, changed, count0, count1        _RL     obcsperiod
232       I                     , mycurrenttime, mycurrentiter, mythid )        LOGICAL useYearlyFields
233        call exf_set_obcs_yz(  OBWv, OBWv0, OBWv1, OBWvfile, 'v'        _RL OBu     (1-Olx:sNx+Olx,Nr,nSx,nSy)
234       I                     , fac, first, changed, count0, count1        _RL OBv     (1-Olx:sNx+Olx,Nr,nSx,nSy)
235       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBt     (1-Olx:sNx+Olx,Nr,nSx,nSy)
236        call exf_set_obcs_yz(  OBWt, OBWt0, OBWt1, OBWtfile, 's'        _RL OBs     (1-Olx:sNx+Olx,Nr,nSx,nSy)
237       I                     , fac, first, changed, count0, count1        _RL OBu0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
238       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBv0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
239        call exf_set_obcs_yz(  OBWs, OBWs0, OBWs1, OBWsfile, 's'        _RL OBt0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
240       I                     , fac, first, changed, count0, count1        _RL OBs0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
241       I                     , mycurrenttime, mycurrentiter, mythid )        _RL OBu1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
242          _RL OBv1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
243          _RL OBt1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
244          _RL OBs1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
245          CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
246    #ifdef ALLOW_SEAICE
247          _RL     siobstartdate
248          _RL     siobperiod
249          _RL OBa     (1-Olx:sNx+Olx,nSx,nSy)
250          _RL OBh     (1-Olx:sNx+Olx,nSx,nSy)
251          _RL OBa0    (1-Olx:sNx+Olx,nSx,nSy)
252          _RL OBh0    (1-Olx:sNx+Olx,nSx,nSy)
253          _RL OBa1    (1-Olx:sNx+Olx,nSx,nSy)
254          _RL OBh1    (1-Olx:sNx+Olx,nSx,nSy)
255          _RL OBsl    (1-Olx:sNx+Olx,nSx,nSy)
256          _RL OBsn    (1-Olx:sNx+Olx,nSx,nSy)
257          _RL OBsl0   (1-Olx:sNx+Olx,nSx,nSy)
258          _RL OBsn0   (1-Olx:sNx+Olx,nSx,nSy)
259          _RL OBsl1   (1-Olx:sNx+Olx,nSx,nSy)
260          _RL OBsn1   (1-Olx:sNx+Olx,nSx,nSy)
261          _RL OBuice  (1-Olx:sNx+Olx,nSx,nSy)
262          _RL OBvice  (1-Olx:sNx+Olx,nSx,nSy)
263          _RL OBuice0 (1-Olx:sNx+Olx,nSx,nSy)
264          _RL OBvice0 (1-Olx:sNx+Olx,nSx,nSy)
265          _RL OBuice1 (1-Olx:sNx+Olx,nSx,nSy)
266          _RL OBvice1 (1-Olx:sNx+Olx,nSx,nSy)
267          CHARACTER*(MAX_LEN_FNAM)
268         &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
269    #endif /* ALLOW_SEAICE */
270    #ifdef ALLOW_PTRACERS
271          _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
272          _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
273          _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
274          CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
275    #endif /* ALLOW_PTRACERS */
276          _RL     mycurrenttime
277          integer mycurrentiter
278          integer mythid
279    
280  #endif  #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
281        && defined ALLOW_EXF
282    
283  #ifdef ALLOW_OBCS_CONTROL  c     == local variables ==
284  cgg   WARNING: Assuming North Open Boundary exists and has same        logical first, changed
285  cgg    calendar information as other boundaries.        integer count0, count1
286        call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )        integer year0, year1
287  #endif        _RL     fac
288    # ifdef ALLOW_PTRACERS
289          integer iTracer
290    # endif /* ALLOW_PTRACERS */
291    
292  #ifdef ALLOW_OBCSN_CONTROL  c     == end of interface ==
293        call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )        if ( obcsperiod .eq. -12 ) then
294    c     obcsperiod=-12 means input file contains 12 monthly means
295    c     record numbers are assumed 1 to 12 corresponding to
296    c     Jan. through Dec.
297           call cal_GetMonthsRec(
298         O                        fac, first, changed,
299         O                        count0, count1,
300         I                        mycurrenttime, mycurrentiter, mythid
301         &           )
302    
303          elseif ( obcsperiod .lt. 0 ) then
304           print *, 'obcsperiod is out of range'
305           STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
306          else
307    c     get record numbers and interpolation factor
308           call exf_GetFFieldRec(
309         I                       obcsstartdate, obcsperiod,
310         I                       useYearlyFields,
311         O                       fac, first, changed,
312         O                       count0, count1, year0, year1,
313         I                       mycurrenttime, mycurrentiter, mythid
314         &                      )
315           call exf_GetFFieldRec(
316         I                       siobstartdate, siobperiod,
317         I                       useYearlyFields,
318         O                       fac, first, changed,
319         O                       count0, count1, year0, year1,
320         I                       mycurrenttime, mycurrentiter, mythid
321         &                      )
322          endif
323    
324          call exf_set_obcs_xz(  OBu, OBu0, OBu1, OBufile, 'u'
325         I                     , fac, first, changed, useYearlyFields
326         I                     , obcsperiod, count0, count1, year0, year1
327         I                     , mycurrenttime, mycurrentiter, mythid )
328          call exf_set_obcs_xz(  OBv, OBv0, OBv1, OBvfile, 'v'
329         I                     , fac, first, changed, useYearlyFields
330         I                     , obcsperiod, count0, count1, year0, year1
331         I                     , mycurrenttime, mycurrentiter, mythid )
332          call exf_set_obcs_xz(  OBt, OBt0, OBt1, OBtfile, 's'
333         I                     , fac, first, changed, useYearlyFields
334         I                     , obcsperiod, count0, count1, year0, year1
335         I                     , mycurrenttime, mycurrentiter, mythid )
336          call exf_set_obcs_xz(  OBs, OBs0, OBs1, OBsfile, 's'
337         I                     , fac, first, changed, useYearlyFields
338         I                     , obcsperiod, count0, count1, year0, year1
339         I                     , mycurrenttime, mycurrentiter, mythid )
340    # ifdef ALLOW_SEAICE
341          IF (useSEAICE) THEN
342           call exf_set_obcs_x (  OBa, OBa0, OBa1, OBafile, 's'
343         I                     , fac, first, changed, useYearlyFields
344         I                     , siobperiod, count0, count1, year0, year1
345         I                     , mycurrenttime, mycurrentiter, mythid )
346           call exf_set_obcs_x (  OBh, OBh0, OBh1, OBhfile, 's'
347         I                     , fac, first, changed, useYearlyFields
348         I                     , siobperiod, count0, count1, year0, year1
349         I                     , mycurrenttime, mycurrentiter, mythid )
350           call exf_set_obcs_x (  OBsl, OBsl0, OBsl1, OBslfile, 's'
351         I                     , fac, first, changed, useYearlyFields
352         I                     , siobperiod, count0, count1, year0, year1
353         I                     , mycurrenttime, mycurrentiter, mythid )
354           call exf_set_obcs_x (  OBsn, OBsn0, OBsn1, OBsnfile, '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 ( OBuice,OBuice0,OBuice1,OBuicefile,'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 ( OBvice,OBvice0,OBvice1,OBvicefile,'s'
363         I                     , fac, first, changed, useYearlyFields
364         I                     , siobperiod, count0, count1, year0, year1
365         I                     , mycurrenttime, mycurrentiter, mythid )
366          ENDIF
367    # endif /* ALLOW_SEAICE */
368    # ifdef ALLOW_PTRACERS
369          if ( usePTRACERS ) then
370           do iTracer = 1, PTRACERS_numInUse
371            call exf_set_obcs_xz(  OBptr (1-Olx,1,1,1,iTracer)
372         I                       , OBptr0(1-Olx,1,1,1,iTracer)
373         I                       , OBptr1(1-Olx,1,1,1,iTracer)
374         I                       , OBptrFile(iTracer), 's'
375         I                       , fac, first, changed, useYearlyFields
376         I                       , obcsperiod, count0, count1, year0, year1
377         I                       , mycurrenttime, mycurrentiter, mythid )
378           enddo
379          endif
380    # endif /* ALLOW_PTRACERS */
381    
382    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
383          RETURN
384          END
385    C=========================================================================
386    C=========================================================================
387    
388          subroutine obcs_prescribe_exf_yz (
389         I     obcsstartdate, obcsperiod,
390         I     useYearlyFields,
391         U     OBu,   OBu0,   OBu1,   OBufile,
392         U     OBv,   OBv0,   OBv1,   OBvfile,
393         U     OBt,   OBt0,   OBt1,   OBtfile,
394         U     OBs,   OBs0,   OBs1,   OBsfile,
395    #ifdef ALLOW_SEAICE
396         I     siobstartdate, siobperiod,
397         U     OBa,   OBa0,   OBa1,   OBafile,
398         U     OBh,   OBh0,   OBh1,   OBhfile,
399         U     OBsl,  OBsl0,  OBsl1,  OBslfile,
400         U     OBsn,  OBsn0,  OBsn1,  OBsnfile,
401         U     OBuice,OBuice0,OBuice1,OBuicefile,
402         U     OBvice,OBvice0,OBvice1,OBvicefile,
403  #endif  #endif
404    #ifdef ALLOW_PTRACERS
405  #ifdef ALLOW_OBCSS_CONTROL       U     OBptr ,OBptr0, OBptr1, OBptrFile,
       call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )  
406  #endif  #endif
407         I     mycurrenttime, mycurrentiter, mythid
408         &     )
409    c     |==================================================================|
410    c     | SUBROUTINE obcs_prescribe_exf_yz                                 |
411    c     |==================================================================|
412    c     | read open boundary conditions from file                          |
413    c     | N.B.: * uses exf and cal routines for file/record handling       |
414    c     |       * uses ctrl routines for control variable handling         |
415    c     |==================================================================|
416    
417  #ifdef ALLOW_OBCSW_CONTROL        implicit none
       call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
418    
419  #ifdef ALLOW_OBCSE_CONTROL  c     == global variables ==
420        call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )  
421    #include "SIZE.h"
422    #include "EEPARAMS.h"
423    #include "PARAMS.h"
424    #ifdef ALLOW_EXF
425    # include "EXF_PARAM.h"
426  #endif  #endif
427    #ifdef ALLOW_PTRACERS
428    # include "PTRACERS_SIZE.h"
429    # include "PTRACERS_PARAMS.h"
430    #endif /* ALLOW_PTRACERS */
431    
432    c     == routine arguments ==
433    
434  #endif /* ALLOW_OBCS */        _RL     obcsstartdate
435          _RL     obcsperiod
436          LOGICAL useYearlyFields
437          _RL OBu     (1-Oly:sNy+Oly,Nr,nSx,nSy)
438          _RL OBv     (1-Oly:sNy+Oly,Nr,nSx,nSy)
439          _RL OBt     (1-Oly:sNy+Oly,Nr,nSx,nSy)
440          _RL OBs     (1-Oly:sNy+Oly,Nr,nSx,nSy)
441          _RL OBu0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
442          _RL OBv0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
443          _RL OBt0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
444          _RL OBs0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
445          _RL OBu1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
446          _RL OBv1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
447          _RL OBt1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
448          _RL OBs1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
449          CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
450    #ifdef ALLOW_SEAICE
451          _RL     siobstartdate
452          _RL     siobperiod
453          _RL OBa     (1-Oly:sNy+Oly,nSx,nSy)
454          _RL OBh     (1-Oly:sNy+Oly,nSx,nSy)
455          _RL OBa0    (1-Oly:sNy+Oly,nSx,nSy)
456          _RL OBh0    (1-Oly:sNy+Oly,nSx,nSy)
457          _RL OBa1    (1-Oly:sNy+Oly,nSx,nSy)
458          _RL OBh1    (1-Oly:sNy+Oly,nSx,nSy)
459          _RL OBsl    (1-Oly:sNy+Oly,nSx,nSy)
460          _RL OBsn    (1-Oly:sNy+Oly,nSx,nSy)
461          _RL OBsl0   (1-Oly:sNy+Oly,nSx,nSy)
462          _RL OBsn0   (1-Oly:sNy+Oly,nSx,nSy)
463          _RL OBsl1   (1-Oly:sNy+Oly,nSx,nSy)
464          _RL OBsn1   (1-Oly:sNy+Oly,nSx,nSy)
465          _RL OBuice  (1-Oly:sNy+Oly,nSx,nSy)
466          _RL OBvice  (1-Oly:sNy+Oly,nSx,nSy)
467          _RL OBuice0 (1-Oly:sNy+Oly,nSx,nSy)
468          _RL OBvice0 (1-Oly:sNy+Oly,nSx,nSy)
469          _RL OBuice1 (1-Oly:sNy+Oly,nSx,nSy)
470          _RL OBvice1 (1-Oly:sNy+Oly,nSx,nSy)
471          CHARACTER*(MAX_LEN_FNAM)
472         &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
473    #endif /* ALLOW_SEAICE */
474    #ifdef ALLOW_PTRACERS
475          _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
476          _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
477          _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
478          CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
479    #endif /* ALLOW_PTRACERS */
480          _RL     mycurrenttime
481          integer mycurrentiter
482          integer mythid
483    
484        end  #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
485        && defined ALLOW_EXF
486    
487    c     == local variables ==
488          logical first, changed
489          integer count0, count1
490          integer year0, year1
491          _RL     fac
492    # ifdef ALLOW_PTRACERS
493          integer iTracer
494    # endif /* ALLOW_PTRACERS */
495    
496    c     == end of interface ==
497          if ( obcsperiod .eq. -12 ) then
498    c     obcsperiod=-12 means input file contains 12 monthly means
499    c     record numbers are assumed 1 to 12 corresponding to
500    c     Jan. through Dec.
501           call cal_GetMonthsRec(
502         O                        fac, first, changed,
503         O                        count0, count1,
504         I                        mycurrenttime, mycurrentiter, mythid
505         &           )
506    
507          elseif ( obcsperiod .lt. 0 ) then
508           print *, 'obcsperiod is out of range'
509           STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'
510          else
511    c     get record numbers and interpolation factor
512           call exf_GetFFieldRec(
513         I                       obcsstartdate, obcsperiod,
514         I                       useYearlyFields,
515         O                       fac, first, changed,
516         O                       count0, count1, year0, year1,
517         I                       mycurrenttime, mycurrentiter, mythid
518         &                      )
519          endif
520    
521          call exf_set_obcs_yz(  OBu, OBu0, OBu1, OBufile, 'u'
522         I                     , fac, first, changed, useYearlyFields
523         I                     , obcsperiod, count0, count1, year0, year1
524         I                     , mycurrenttime, mycurrentiter, mythid )
525          call exf_set_obcs_yz(  OBv, OBv0, OBv1, OBvfile, 'v'
526         I                     , fac, first, changed, useYearlyFields
527         I                     , obcsperiod, count0, count1, year0, year1
528         I                     , mycurrenttime, mycurrentiter, mythid )
529          call exf_set_obcs_yz(  OBt, OBt0, OBt1, OBtfile, 's'
530         I                     , fac, first, changed, useYearlyFields
531         I                     , obcsperiod, count0, count1, year0, year1
532         I                     , mycurrenttime, mycurrentiter, mythid )
533          call exf_set_obcs_yz(  OBs, OBs0, OBs1, OBsfile, 's'
534         I                     , fac, first, changed, useYearlyFields
535         I                     , obcsperiod, count0, count1, year0, year1
536         I                     , mycurrenttime, mycurrentiter, mythid )
537    # ifdef ALLOW_SEAICE
538          IF (useSEAICE) THEN
539           call exf_set_obcs_y (  OBa, OBa0, OBa1, OBafile, 's'
540         I                     , fac, first, changed, useYearlyFields
541         I                     , siobperiod, count0, count1, year0, year1
542         I                     , mycurrenttime, mycurrentiter, mythid )
543           call exf_set_obcs_y (  OBh, OBh0, OBh1, OBhfile, 's'
544         I                     , fac, first, changed, useYearlyFields
545         I                     , siobperiod, count0, count1, year0, year1
546         I                     , mycurrenttime, mycurrentiter, mythid )
547           call exf_set_obcs_y (  OBsl, OBsl0, OBsl1, OBslfile, 's'
548         I                     , fac, first, changed, useYearlyFields
549         I                     , siobperiod, count0, count1, year0, year1
550         I                     , mycurrenttime, mycurrentiter, mythid )
551           call exf_set_obcs_y (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
552         I                     , fac, first, changed, useYearlyFields
553         I                     , siobperiod, count0, count1, year0, year1
554         I                     , mycurrenttime, mycurrentiter, mythid )
555           call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'s'
556         I                     , fac, first, changed, useYearlyFields
557         I                     , siobperiod, count0, count1, year0, year1
558         I                     , mycurrenttime, mycurrentiter, mythid )
559           call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'s'
560         I                     , fac, first, changed, useYearlyFields
561         I                     , siobperiod, count0, count1, year0, year1
562         I                     , mycurrenttime, mycurrentiter, mythid )
563          ENDIF
564    # endif /* ALLOW_SEAICE */
565    # ifdef ALLOW_PTRACERS
566          if ( usePTRACERS ) then
567           do iTracer = 1, PTRACERS_numInUse
568            call exf_set_obcs_yz(  OBptr (1-Olx,1,1,1,iTracer)
569         I                       , OBptr0(1-Olx,1,1,1,iTracer)
570         I                       , OBptr1(1-Olx,1,1,1,iTracer)
571         I                       , OBptrFile(iTracer), 's'
572         I                       , fac, first, changed, useYearlyFields
573         I                       , obcsperiod, count0, count1, year0, year1
574         I                       , mycurrenttime, mycurrentiter, mythid )
575           enddo
576          endif
577    # endif /* ALLOW_PTRACERS */
578    
579    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
580          RETURN
581          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22