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