/[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.17 by mlosch, Thu Jan 24 20:51:00 2008 UTC revision 1.24 by mlosch, Tue Jun 2 14:58:54 2009 UTC
# Line 44  c     == local variables == Line 44  c     == local variables ==
44    
45  c     == end of interface ==  c     == end of interface ==
46    
47  #ifdef ALLOW_EXF  # ifdef ALLOW_EXF
48        IF ( useEXF ) THEN        IF ( useEXF ) THEN
49  #ifdef ALLOW_OBCS_NORTH  #  ifdef ALLOW_OBCS_NORTH
50        call obcs_prescribe_exf_xz (        call obcs_prescribe_exf_xz (
51       I     obcsNstartdate, obcsNperiod,       I     obcsNstartdate, obcsNperiod,
      I     obcsNstartdate1, obcsNstartdate2,  
52       I     useOBCSYearlyFields,       I     useOBCSYearlyFields,
53       U     OBNu,   OBNu0,   OBNu1,   OBNufile,       U     OBNu,   OBNu0,   OBNu1,   OBNufile,
54       U     OBNv,   OBNv0,   OBNv1,   OBNvfile,       U     OBNv,   OBNv0,   OBNv1,   OBNvfile,
55       U     OBNt,   OBNt0,   OBNt1,   OBNtfile,       U     OBNt,   OBNt0,   OBNt1,   OBNtfile,
56       U     OBNs,   OBNs0,   OBNs1,   OBNsfile,       U     OBNs,   OBNs0,   OBNs1,   OBNsfile,
57  #ifdef ALLOW_SEAICE  #   ifdef ALLOW_SEAICE
58         I     siobNstartdate, siobNperiod,
59       U     OBNa,   OBNa0,   OBNa1,   OBNafile,       U     OBNa,   OBNa0,   OBNa1,   OBNafile,
60       U     OBNh,   OBNh0,   OBNh1,   OBNhfile,       U     OBNh,   OBNh0,   OBNh1,   OBNhfile,
61       U     OBNsl,  OBNsl0,  OBNsl1,  OBNslfile,       U     OBNsl,  OBNsl0,  OBNsl1,  OBNslfile,
62       U     OBNsn,  OBNsn0,  OBNsn1,  OBNsnfile,       U     OBNsn,  OBNsn0,  OBNsn1,  OBNsnfile,
63       U     OBNuice,OBNuice0,OBNuice1,OBNuicefile,       U     OBNuice,OBNuice0,OBNuice1,OBNuicefile,
64       U     OBNvice,OBNvice0,OBNvice1,OBNvicefile,       U     OBNvice,OBNvice0,OBNvice1,OBNvicefile,
65  #endif  #   endif
66  #ifdef ALLOW_PTRACERS  #   ifdef ALLOW_PTRACERS
67       U     OBNptr ,OBNptr0, OBNptr1, OBNptrFile,       U     OBNptr ,OBNptr0, OBNptr1, OBNptrFile,
68  #endif  #   endif
69       I     mycurrenttime, mycurrentiter, mythid       I     mycurrenttime, mycurrentiter, mythid
70       &     )       &     )
71  #endif /* ALLOW_OBCS_NORTH */  #  endif /* ALLOW_OBCS_NORTH */
72    
73  #ifdef ALLOW_OBCS_SOUTH  #  ifdef ALLOW_OBCS_SOUTH
74        call obcs_prescribe_exf_xz (        call obcs_prescribe_exf_xz (
75       I     obcsSstartdate, obcsSperiod,       I     obcsSstartdate, obcsSperiod,
      I     obcsSstartdate1, obcsSstartdate2,  
76       I     useOBCSYearlyFields,       I     useOBCSYearlyFields,
77       U     OBSu,   OBSu0,   OBSu1,   OBSufile,       U     OBSu,   OBSu0,   OBSu1,   OBSufile,
78       U     OBSv,   OBSv0,   OBSv1,   OBSvfile,       U     OBSv,   OBSv0,   OBSv1,   OBSvfile,
79       U     OBSt,   OBSt0,   OBSt1,   OBStfile,       U     OBSt,   OBSt0,   OBSt1,   OBStfile,
80       U     OBSs,   OBSs0,   OBSs1,   OBSsfile,       U     OBSs,   OBSs0,   OBSs1,   OBSsfile,
81  #ifdef ALLOW_SEAICE  #   ifdef ALLOW_SEAICE
82         I     siobSstartdate, siobSperiod,
83       U     OBSa,   OBSa0,   OBSa1,   OBSafile,       U     OBSa,   OBSa0,   OBSa1,   OBSafile,
84       U     OBSh,   OBSh0,   OBSh1,   OBShfile,       U     OBSh,   OBSh0,   OBSh1,   OBShfile,
85       U     OBSsl,  OBSsl0,  OBSsl1,  OBSslfile,       U     OBSsl,  OBSsl0,  OBSsl1,  OBSslfile,
86       U     OBSsn,  OBSsn0,  OBSsn1,  OBSsnfile,       U     OBSsn,  OBSsn0,  OBSsn1,  OBSsnfile,
87       U     OBSuice,OBSuice0,OBSuice1,OBSuicefile,       U     OBSuice,OBSuice0,OBSuice1,OBSuicefile,
88       U     OBSvice,OBSvice0,OBSvice1,OBSvicefile,       U     OBSvice,OBSvice0,OBSvice1,OBSvicefile,
89  #endif  #   endif
90  #ifdef ALLOW_PTRACERS  #   ifdef ALLOW_PTRACERS
91       U     OBSptr ,OBSptr0, OBSptr1, OBSptrFile,       U     OBSptr ,OBSptr0, OBSptr1, OBSptrFile,
92  #endif  #   endif
93       I     mycurrenttime, mycurrentiter, mythid       I     mycurrenttime, mycurrentiter, mythid
94       &     )       &     )
95  #endif /* ALLOW_OBCS_SOUTH */  #  endif /* ALLOW_OBCS_SOUTH */
96    
97  #ifdef ALLOW_OBCS_EAST  #  ifdef ALLOW_OBCS_EAST
98        call obcs_prescribe_exf_yz (        call obcs_prescribe_exf_yz (
99       I     obcsEstartdate, obcsEperiod,       I     obcsEstartdate, obcsEperiod,
      I     obcsEstartdate1, obcsEstartdate2,  
100       I     useOBCSYearlyFields,       I     useOBCSYearlyFields,
101       U     OBEu,   OBEu0,   OBEu1,   OBEufile,       U     OBEu,   OBEu0,   OBEu1,   OBEufile,
102       U     OBEv,   OBEv0,   OBEv1,   OBEvfile,       U     OBEv,   OBEv0,   OBEv1,   OBEvfile,
103       U     OBEt,   OBEt0,   OBEt1,   OBEtfile,       U     OBEt,   OBEt0,   OBEt1,   OBEtfile,
104       U     OBEs,   OBEs0,   OBEs1,   OBEsfile,       U     OBEs,   OBEs0,   OBEs1,   OBEsfile,
105  #ifdef ALLOW_SEAICE  #   ifdef ALLOW_SEAICE
106         I     siobEstartdate, siobEperiod,
107       U     OBEa,   OBEa0,   OBEa1,   OBEafile,       U     OBEa,   OBEa0,   OBEa1,   OBEafile,
108       U     OBEh,   OBEh0,   OBEh1,   OBEhfile,       U     OBEh,   OBEh0,   OBEh1,   OBEhfile,
109       U     OBEsl,  OBEsl0,  OBEsl1,  OBEslfile,       U     OBEsl,  OBEsl0,  OBEsl1,  OBEslfile,
110       U     OBEsn,  OBEsn0,  OBEsn1,  OBEsnfile,       U     OBEsn,  OBEsn0,  OBEsn1,  OBEsnfile,
111       U     OBEuice,OBEuice0,OBEuice1,OBEuicefile,       U     OBEuice,OBEuice0,OBEuice1,OBEuicefile,
112       U     OBEvice,OBEvice0,OBEvice1,OBEvicefile,       U     OBEvice,OBEvice0,OBEvice1,OBEvicefile,
113  #endif  #   endif
114  #ifdef ALLOW_PTRACERS  #   ifdef ALLOW_PTRACERS
115       U     OBEptr ,OBEptr0, OBEptr1, OBEptrFile,       U     OBEptr ,OBEptr0, OBEptr1, OBEptrFile,
116  #endif  #   endif
117       I     mycurrenttime, mycurrentiter, mythid       I     mycurrenttime, mycurrentiter, mythid
118       &     )       &     )
119  #endif /* ALLOW_OBCS_EAST */  #  endif /* ALLOW_OBCS_EAST */
120    
121  #ifdef ALLOW_OBCS_WEST  #  ifdef ALLOW_OBCS_WEST
122        call obcs_prescribe_exf_yz (        call obcs_prescribe_exf_yz (
123       I     obcsWstartdate, obcsWperiod,       I     obcsWstartdate, obcsWperiod,
      I     obcsWstartdate1, obcsWstartdate2,  
124       I     useOBCSYearlyFields,       I     useOBCSYearlyFields,
125       U     OBWu,   OBWu0,   OBWu1,   OBWufile,       U     OBWu,   OBWu0,   OBWu1,   OBWufile,
126       U     OBWv,   OBWv0,   OBWv1,   OBWvfile,       U     OBWv,   OBWv0,   OBWv1,   OBWvfile,
127       U     OBWt,   OBWt0,   OBWt1,   OBWtfile,       U     OBWt,   OBWt0,   OBWt1,   OBWtfile,
128       U     OBWs,   OBWs0,   OBWs1,   OBWsfile,       U     OBWs,   OBWs0,   OBWs1,   OBWsfile,
129  #ifdef ALLOW_SEAICE  #   ifdef ALLOW_SEAICE
130         I     siobWstartdate, siobWperiod,
131       U     OBWa,   OBWa0,   OBWa1,   OBWafile,       U     OBWa,   OBWa0,   OBWa1,   OBWafile,
132       U     OBWh,   OBWh0,   OBWh1,   OBWhfile,       U     OBWh,   OBWh0,   OBWh1,   OBWhfile,
133       U     OBWsl,  OBWsl0,  OBWsl1,  OBWslfile,       U     OBWsl,  OBWsl0,  OBWsl1,  OBWslfile,
134       U     OBWsn,  OBWsn0,  OBWsn1,  OBWsnfile,       U     OBWsn,  OBWsn0,  OBWsn1,  OBWsnfile,
135       U     OBWuice,OBWuice0,OBWuice1,OBWuicefile,       U     OBWuice,OBWuice0,OBWuice1,OBWuicefile,
136       U     OBWvice,OBWvice0,OBWvice1,OBWvicefile,       U     OBWvice,OBWvice0,OBWvice1,OBWvicefile,
137  #endif  #   endif
138  #ifdef ALLOW_PTRACERS  #   ifdef ALLOW_PTRACERS
139       U     OBWptr ,OBWptr0, OBWptr1, OBWptrFile,       U     OBWptr ,OBWptr0, OBWptr1, OBWptrFile,
140  #endif  #   endif
141       I     mycurrenttime, mycurrentiter, mythid       I     mycurrenttime, mycurrentiter, mythid
142       &     )       &     )
143  #endif /* ALLOW_OBCS_WEST */  #  endif /* ALLOW_OBCS_WEST */
144  C     ENDIF useEXF  C     ENDIF useEXF
145        ENDIF        ENDIF
146  #endif /* ALLOW_EXF */  # endif /* ALLOW_EXF */
147    
148  #ifdef ALLOW_OBCS_CONTROL  # ifdef ALLOW_OBCS_CONTROL
149  cgg   WARNING: Assuming North Open Boundary exists and has same  cgg   WARNING: Assuming North Open Boundary exists and has same
150  cgg    calendar information as other boundaries.  cgg    calendar information as other boundaries.
151        call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )        call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )
152  #endif  # endif
153    
154  #ifdef ALLOW_OBCSN_CONTROL  # ifdef ALLOW_OBCSN_CONTROL
155        call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )        call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )
156  #endif  # endif
157    
158  #ifdef ALLOW_OBCSS_CONTROL  # ifdef ALLOW_OBCSS_CONTROL
159        call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )        call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )
160  #endif  # endif
161    
162  #ifdef ALLOW_OBCSW_CONTROL  # ifdef ALLOW_OBCSW_CONTROL
163        call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )        call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )
164  #endif  # endif
165    
166  #ifdef ALLOW_OBCSE_CONTROL  # ifdef ALLOW_OBCSE_CONTROL
167        call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )        call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )
168  #endif  # endif
169    
170        IF ( .NOT. useEXF ) THEN        IF ( .NOT. useEXF ) THEN
171    #ifndef ALLOW_AUTODIFF_TAMC
172         CALL OBCS_EXTERNAL_FIELDS_LOAD(         CALL OBCS_EXTERNAL_FIELDS_LOAD(
173       &     myCurrentTime, myCurrentIter, myThid )       &     myCurrentTime, myCurrentIter, myThid )
174    #else
175           STOP 'PH HAS DISABLED THIS RUNTIME OPTION FOR ALLOW_EXF'
176    #endif
177        ENDIF        ENDIF
178    
179  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE */
180    
181        RETURN        RETURN
182        END        END
183    
184    
185  C=========================================================================  C=========================================================================
186  C=========================================================================  C=========================================================================
187    
188        subroutine obcs_prescribe_exf_xz (        subroutine obcs_prescribe_exf_xz (
189       I     obcsstartdate, obcsperiod,       I     obcsstartdate, obcsperiod,
      I     obcsstartdate1, obcsstartdate2,  
190       I     useYearlyFields,       I     useYearlyFields,
191       U     OBu,   OBu0,   OBu1,   OBufile,       U     OBu,   OBu0,   OBu1,   OBufile,
192       U     OBv,   OBv0,   OBv1,   OBvfile,       U     OBv,   OBv0,   OBv1,   OBvfile,
193       U     OBt,   OBt0,   OBt1,   OBtfile,       U     OBt,   OBt0,   OBt1,   OBtfile,
194       U     OBs,   OBs0,   OBs1,   OBsfile,       U     OBs,   OBs0,   OBs1,   OBsfile,
195  #if defined ALLOW_SEAICE && defined ALLOW_OBCS  #ifdef ALLOW_SEAICE
196         I     siobstartdate, siobperiod,
197       U     OBa,   OBa0,   OBa1,   OBafile,       U     OBa,   OBa0,   OBa1,   OBafile,
198       U     OBh,   OBh0,   OBh1,   OBhfile,       U     OBh,   OBh0,   OBh1,   OBhfile,
199       U     OBsl,  OBsl0,  OBsl1,  OBslfile,       U     OBsl,  OBsl0,  OBsl1,  OBslfile,
# Line 196  C======================================= Line 201  C=======================================
201       U     OBuice,OBuice0,OBuice1,OBuicefile,       U     OBuice,OBuice0,OBuice1,OBuicefile,
202       U     OBvice,OBvice0,OBvice1,OBvicefile,       U     OBvice,OBvice0,OBvice1,OBvicefile,
203  #endif  #endif
204  #if defined ALLOW_PTRACERS && defined ALLOW_OBCS  #ifdef ALLOW_PTRACERS
205       U     OBptr ,OBptr0, OBptr1, OBptrFile,       U     OBptr ,OBptr0, OBptr1, OBptrFile,
206  #endif  #endif
207       I     mycurrenttime, mycurrentiter, mythid       I     mycurrenttime, mycurrentiter, mythid
# Line 226  c     == global variables == Line 231  c     == global variables ==
231    
232  c     == routine arguments ==  c     == routine arguments ==
233    
       INTEGER obcsstartdate1  
       INTEGER obcsstartdate2  
234        _RL     obcsstartdate        _RL     obcsstartdate
235        _RL     obcsperiod        _RL     obcsperiod
236        LOGICAL useYearlyFields        LOGICAL useYearlyFields
# Line 244  c     == routine arguments == Line 247  c     == routine arguments ==
247        _RL OBt1    (1-Olx:sNx+Olx,Nr,nSx,nSy)        _RL OBt1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
248        _RL OBs1    (1-Olx:sNx+Olx,Nr,nSx,nSy)        _RL OBs1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
249        CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile        CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
250  #if defined ALLOW_SEAICE && defined ALLOW_OBCS  #ifdef ALLOW_SEAICE
251          _RL     siobstartdate
252          _RL     siobperiod
253        _RL OBa     (1-Olx:sNx+Olx,nSx,nSy)        _RL OBa     (1-Olx:sNx+Olx,nSx,nSy)
254        _RL OBh     (1-Olx:sNx+Olx,nSx,nSy)        _RL OBh     (1-Olx:sNx+Olx,nSx,nSy)
255        _RL OBa0    (1-Olx:sNx+Olx,nSx,nSy)        _RL OBa0    (1-Olx:sNx+Olx,nSx,nSy)
# Line 266  c     == routine arguments == Line 271  c     == routine arguments ==
271        CHARACTER*(MAX_LEN_FNAM)        CHARACTER*(MAX_LEN_FNAM)
272       &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile       &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
273  #endif /* ALLOW_SEAICE */  #endif /* ALLOW_SEAICE */
274  #if defined ALLOW_PTRACERS && defined ALLOW_OBCS  #ifdef ALLOW_PTRACERS
275        _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)        _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
276        _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)        _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
277        _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)        _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
# Line 284  c     == local variables == Line 289  c     == local variables ==
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        integer iTracer
294  #endif /* ALLOW_PTRACERS */  # endif /* ALLOW_PTRACERS */
   
295  c     == end of interface ==  c     == end of interface ==
296        if ( obcsperiod .eq. -12 ) then  
297          if ( obcsperiod .eq. -12. _d 0 ) then
298  c     obcsperiod=-12 means input file contains 12 monthly means  c     obcsperiod=-12 means input file contains 12 monthly means
299  c     record numbers are assumed 1 to 12 corresponding to  c     record numbers are assumed 1 to 12 corresponding to
300  c     Jan. through Dec.  c     Jan. through Dec.
# Line 299  c     Jan. through Dec. Line 304  c     Jan. through Dec.
304       I                        mycurrenttime, mycurrentiter, mythid       I                        mycurrenttime, mycurrentiter, mythid
305       &           )       &           )
306    
307        elseif ( obcsperiod .lt. 0 ) then        elseif ( obcsperiod .lt. 0. _d 0 ) then
308         print *, 'obcsperiod is out of range'         print *, 'obcsperiod is out of range'
309         STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'         STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
310        else        else
311  c     get record numbers and interpolation factor  c     get record numbers and interpolation factor
312         call exf_GetFFieldRec(         call exf_GetFFieldRec(
313       I                       obcsstartdate, obcsperiod,       I                       obcsstartdate, obcsperiod,
      I                       obcsstartdate1, obcsstartdate2,  
314       I                       useYearlyFields,       I                       useYearlyFields,
315       O                       fac, first, changed,       O                       fac, first, changed,
316       O                       count0, count1, year0, year1,       O                       count0, count1, year0, year1,
317       I                       mycurrenttime, mycurrentiter, mythid       I                       mycurrenttime, mycurrentiter, mythid
318       &                      )       &                      )
319        endif        endif
   
320        call exf_set_obcs_xz(  OBu, OBu0, OBu1, OBufile, 'u'        call exf_set_obcs_xz(  OBu, OBu0, OBu1, OBufile, 'u'
321       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
322       I                     , obcsperiod, count0, count1, year0, year1       I                     , obcsperiod, count0, count1, year0, year1
# Line 330  c     get record numbers and interpolati Line 333  c     get record numbers and interpolati
333       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
334       I                     , obcsperiod, count0, count1, year0, year1       I                     , obcsperiod, count0, count1, year0, year1
335       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
336  #ifdef ALLOW_SEAICE  # ifdef ALLOW_PTRACERS
337          if ( usePTRACERS ) then
338           do iTracer = 1, PTRACERS_numInUse
339            call exf_set_obcs_xz(  OBptr (1-Olx,1,1,1,iTracer)
340         I                       , OBptr0(1-Olx,1,1,1,iTracer)
341         I                       , OBptr1(1-Olx,1,1,1,iTracer)
342         I                       , OBptrFile(iTracer), 's'
343         I                       , fac, first, changed, useYearlyFields
344         I                       , obcsperiod, count0, count1, year0, year1
345         I                       , mycurrenttime, mycurrentiter, mythid )
346           enddo
347          endif
348    # endif /* ALLOW_PTRACERS */
349    # ifdef ALLOW_SEAICE
350        IF (useSEAICE) THEN        IF (useSEAICE) THEN
351           if ( siobperiod .eq. -12. _d 0 ) then
352    c     siobperiod=-12 means input file contains 12 monthly means
353    c     record numbers are assumed 1 to 12 corresponding to
354    c     Jan. through Dec.
355            call cal_GetMonthsRec(
356         O                        fac, first, changed,
357         O                        count0, count1,
358         I                        mycurrenttime, mycurrentiter, mythid
359         &           )
360    
361           elseif ( siobperiod .lt. 0. _d 0 ) then
362            print *, 'siobperiod is out of range'
363            STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
364           else
365    c     get record numbers and interpolation factor
366            call exf_GetFFieldRec(
367         I                       siobstartdate, siobperiod,
368         I                       useYearlyFields,
369         O                       fac, first, changed,
370         O                       count0, count1, year0, year1,
371         I                       mycurrenttime, mycurrentiter, mythid
372         &                      )
373           endif
374         call exf_set_obcs_x (  OBa, OBa0, OBa1, OBafile, 's'         call exf_set_obcs_x (  OBa, OBa0, OBa1, OBafile, 's'
375       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
376       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
377       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
378         call exf_set_obcs_x (  OBh, OBh0, OBh1, OBhfile, 's'         call exf_set_obcs_x (  OBh, OBh0, OBh1, OBhfile, 's'
379       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
380       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
381       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
382         call exf_set_obcs_x (  OBsl, OBsl0, OBsl1, OBslfile, 's'         call exf_set_obcs_x (  OBsl, OBsl0, OBsl1, OBslfile, 's'
383       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
384       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
385       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
386         call exf_set_obcs_x (  OBsn, OBsn0, OBsn1, OBsnfile, 's'         call exf_set_obcs_x (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
387       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
388       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
389       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
390         call exf_set_obcs_x ( OBuice,OBuice0,OBuice1,OBuicefile,'s'         call exf_set_obcs_x ( OBuice,OBuice0,OBuice1,OBuicefile,'u'
391       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
392       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
393       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
394         call exf_set_obcs_x ( OBvice,OBvice0,OBvice1,OBvicefile,'s'         call exf_set_obcs_x ( OBvice,OBvice0,OBvice1,OBvicefile,'v'
395       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
396       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
397       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
398        ENDIF        ENDIF
399  #endif /* ALLOW_SEAICE */  # endif /* ALLOW_SEAICE */
 #ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do iTracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_xz(  OBptr (1-Olx,1,1,1,iTracer)  
      I                       , OBptr0(1-Olx,1,1,1,iTracer)  
      I                       , OBptr1(1-Olx,1,1,1,iTracer)  
      I                       , OBptrFile(iTracer), 's'  
      I                       , fac, first, changed, useYearlyFields  
      I                       , obcsperiod, count0, count1, year0, year1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 #endif /* ALLOW_PTRACERS */  
400    
401  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
402        RETURN        RETURN
# Line 380  C======================================= Line 406  C=======================================
406    
407        subroutine obcs_prescribe_exf_yz (        subroutine obcs_prescribe_exf_yz (
408       I     obcsstartdate, obcsperiod,       I     obcsstartdate, obcsperiod,
      I     obcsstartdate1, obcsstartdate2,  
409       I     useYearlyFields,       I     useYearlyFields,
410       U     OBu,   OBu0,   OBu1,   OBufile,       U     OBu,   OBu0,   OBu1,   OBufile,
411       U     OBv,   OBv0,   OBv1,   OBvfile,       U     OBv,   OBv0,   OBv1,   OBvfile,
412       U     OBt,   OBt0,   OBt1,   OBtfile,       U     OBt,   OBt0,   OBt1,   OBtfile,
413       U     OBs,   OBs0,   OBs1,   OBsfile,       U     OBs,   OBs0,   OBs1,   OBsfile,
414  #if defined ALLOW_SEAICE && defined ALLOW_OBCS  #ifdef ALLOW_SEAICE
415         I     siobstartdate, siobperiod,
416       U     OBa,   OBa0,   OBa1,   OBafile,       U     OBa,   OBa0,   OBa1,   OBafile,
417       U     OBh,   OBh0,   OBh1,   OBhfile,       U     OBh,   OBh0,   OBh1,   OBhfile,
418       U     OBsl,  OBsl0,  OBsl1,  OBslfile,       U     OBsl,  OBsl0,  OBsl1,  OBslfile,
# Line 394  C======================================= Line 420  C=======================================
420       U     OBuice,OBuice0,OBuice1,OBuicefile,       U     OBuice,OBuice0,OBuice1,OBuicefile,
421       U     OBvice,OBvice0,OBvice1,OBvicefile,       U     OBvice,OBvice0,OBvice1,OBvicefile,
422  #endif  #endif
423  #if defined ALLOW_PTRACERS && defined ALLOW_OBCS  #ifdef ALLOW_PTRACERS
424       U     OBptr ,OBptr0, OBptr1, OBptrFile,       U     OBptr ,OBptr0, OBptr1, OBptrFile,
425  #endif  #endif
426       I     mycurrenttime, mycurrentiter, mythid       I     mycurrenttime, mycurrentiter, mythid
# Line 424  c     == global variables == Line 450  c     == global variables ==
450    
451  c     == routine arguments ==  c     == routine arguments ==
452    
       INTEGER obcsstartdate1  
       INTEGER obcsstartdate2  
453        _RL     obcsstartdate        _RL     obcsstartdate
454        _RL     obcsperiod        _RL     obcsperiod
455        LOGICAL useYearlyFields        LOGICAL useYearlyFields
# Line 442  c     == routine arguments == Line 466  c     == routine arguments ==
466        _RL OBt1    (1-Oly:sNy+Oly,Nr,nSx,nSy)        _RL OBt1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
467        _RL OBs1    (1-Oly:sNy+Oly,Nr,nSx,nSy)        _RL OBs1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
468        CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile        CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
469  #if defined ALLOW_SEAICE && defined ALLOW_OBCS  #ifdef ALLOW_SEAICE
470          _RL     siobstartdate
471          _RL     siobperiod
472        _RL OBa     (1-Oly:sNy+Oly,nSx,nSy)        _RL OBa     (1-Oly:sNy+Oly,nSx,nSy)
473        _RL OBh     (1-Oly:sNy+Oly,nSx,nSy)        _RL OBh     (1-Oly:sNy+Oly,nSx,nSy)
474        _RL OBa0    (1-Oly:sNy+Oly,nSx,nSy)        _RL OBa0    (1-Oly:sNy+Oly,nSx,nSy)
# Line 464  c     == routine arguments == Line 490  c     == routine arguments ==
490        CHARACTER*(MAX_LEN_FNAM)        CHARACTER*(MAX_LEN_FNAM)
491       &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile       &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
492  #endif /* ALLOW_SEAICE */  #endif /* ALLOW_SEAICE */
493  #if defined ALLOW_PTRACERS && defined ALLOW_OBCS  #ifdef ALLOW_PTRACERS
494        _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)        _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
495        _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)        _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
496        _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)        _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
# Line 482  c     == local variables == Line 508  c     == local variables ==
508        integer count0, count1        integer count0, count1
509        integer year0, year1        integer year0, year1
510        _RL     fac        _RL     fac
511  #ifdef ALLOW_PTRACERS  # ifdef ALLOW_PTRACERS
512        integer iTracer        integer iTracer
513  #endif /* ALLOW_PTRACERS */  # endif /* ALLOW_PTRACERS */
514    
515  c     == end of interface ==  c     == end of interface ==
516        if ( obcsperiod .eq. -12 ) then        if ( obcsperiod .eq. -12. _d 0 ) then
517  c     obcsperiod=-12 means input file contains 12 monthly means  c     obcsperiod=-12 means input file contains 12 monthly means
518  c     record numbers are assumed 1 to 12 corresponding to  c     record numbers are assumed 1 to 12 corresponding to
519  c     Jan. through Dec.  c     Jan. through Dec.
# Line 497  c     Jan. through Dec. Line 523  c     Jan. through Dec.
523       I                        mycurrenttime, mycurrentiter, mythid       I                        mycurrenttime, mycurrentiter, mythid
524       &           )       &           )
525    
526        elseif ( obcsperiod .lt. 0 ) then        elseif ( obcsperiod .lt. 0. _d 0 ) then
527         print *, 'obcsperiod is out of range'         print *, 'obcsperiod is out of range'
528         STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'         STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'
529        else        else
530  c     get record numbers and interpolation factor  c     get record numbers and interpolation factor
531         call exf_GetFFieldRec(         call exf_GetFFieldRec(
532       I                       obcsstartdate, obcsperiod,       I                       obcsstartdate, obcsperiod,
      I                       obcsstartdate1, obcsstartdate2,  
533       I                       useYearlyFields,       I                       useYearlyFields,
534       O                       fac, first, changed,       O                       fac, first, changed,
535       O                       count0, count1, year0, year1,       O                       count0, count1, year0, year1,
536       I                       mycurrenttime, mycurrentiter, mythid       I                       mycurrenttime, mycurrentiter, mythid
537       &                      )       &                      )
538        endif        endif
   
539        call exf_set_obcs_yz(  OBu, OBu0, OBu1, OBufile, 'u'        call exf_set_obcs_yz(  OBu, OBu0, OBu1, OBufile, 'u'
540       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
541       I                     , obcsperiod, count0, count1, year0, year1       I                     , obcsperiod, count0, count1, year0, year1
# Line 528  c     get record numbers and interpolati Line 552  c     get record numbers and interpolati
552       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
553       I                     , obcsperiod, count0, count1, year0, year1       I                     , obcsperiod, count0, count1, year0, year1
554       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
555  #ifdef ALLOW_SEAICE  # ifdef ALLOW_PTRACERS
556          if ( usePTRACERS ) then
557           do iTracer = 1, PTRACERS_numInUse
558            call exf_set_obcs_yz(  OBptr (1-Olx,1,1,1,iTracer)
559         I                       , OBptr0(1-Olx,1,1,1,iTracer)
560         I                       , OBptr1(1-Olx,1,1,1,iTracer)
561         I                       , OBptrFile(iTracer), 's'
562         I                       , fac, first, changed, useYearlyFields
563         I                       , obcsperiod, count0, count1, year0, year1
564         I                       , mycurrenttime, mycurrentiter, mythid )
565           enddo
566          endif
567    # endif /* ALLOW_PTRACERS */
568    # ifdef ALLOW_SEAICE
569        IF (useSEAICE) THEN        IF (useSEAICE) THEN
570           if ( siobperiod .eq. -12. _d 0 ) then
571    c     siobperiod=-12 means input file contains 12 monthly means
572    c     record numbers are assumed 1 to 12 corresponding to
573    c     Jan. through Dec.
574            call cal_GetMonthsRec(
575         O                        fac, first, changed,
576         O                        count0, count1,
577         I                        mycurrenttime, mycurrentiter, mythid
578         &           )
579    
580           elseif ( siobperiod .lt. 0. _d 0 ) then
581            print *, 'siobperiod is out of range'
582            STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
583           else
584    c     get record numbers and interpolation factor
585            call exf_GetFFieldRec(
586         I                       siobstartdate, siobperiod,
587         I                       useYearlyFields,
588         O                       fac, first, changed,
589         O                       count0, count1, year0, year1,
590         I                       mycurrenttime, mycurrentiter, mythid
591         &                      )
592           endif
593         call exf_set_obcs_y (  OBa, OBa0, OBa1, OBafile, 's'         call exf_set_obcs_y (  OBa, OBa0, OBa1, OBafile, 's'
594       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
595       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
596       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
597         call exf_set_obcs_y (  OBh, OBh0, OBh1, OBhfile, 's'         call exf_set_obcs_y (  OBh, OBh0, OBh1, OBhfile, 's'
598       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
599       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
600       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
601         call exf_set_obcs_y (  OBsl, OBsl0, OBsl1, OBslfile, 's'         call exf_set_obcs_y (  OBsl, OBsl0, OBsl1, OBslfile, 's'
602       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
603       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
604       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
605         call exf_set_obcs_y (  OBsn, OBsn0, OBsn1, OBsnfile, 's'         call exf_set_obcs_y (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
606       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
607       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
608       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
609         call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'s'         call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'u'
610       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
611       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
612       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
613         call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'s'         call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'v'
614       I                     , fac, first, changed, useYearlyFields       I                     , fac, first, changed, useYearlyFields
615       I                     , obcsperiod, count0, count1, year0, year1       I                     , siobperiod, count0, count1, year0, year1
616       I                     , mycurrenttime, mycurrentiter, mythid )       I                     , mycurrenttime, mycurrentiter, mythid )
617        ENDIF        ENDIF
618  #endif /* ALLOW_SEAICE */  # endif /* ALLOW_SEAICE */
 #ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do iTracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_yz(  OBptr (1-Olx,1,1,1,iTracer)  
      I                       , OBptr0(1-Olx,1,1,1,iTracer)  
      I                       , OBptr1(1-Olx,1,1,1,iTracer)  
      I                       , OBptrFile(iTracer), 's'  
      I                       , fac, first, changed, useYearlyFields  
      I                       , obcsperiod, count0, count1, year0, year1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 #endif /* ALLOW_PTRACERS */  
619    
620  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
621        RETURN        RETURN
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22