/[MITgcm]/MITgcm/pkg/exf/exf_set_gen.F
ViewVC logotype

Diff of /MITgcm/pkg/exf/exf_set_gen.F

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

revision 1.7 by edhill, Thu Oct 9 04:19:19 2003 UTC revision 1.21 by heimbach, Wed Apr 18 19:55:34 2007 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "EXF_OPTIONS.h"  #include "EXF_OPTIONS.h"
5    
6        subroutine exf_set_gen(        subroutine exf_set_gen(
7       &     genfile, genstartdate, genperiod, exf_inscal_gen,       &     genfile, genstartdate, genperiod,
8         &     genstartdate1, genstartdate2,
9         &     exf_inscal_gen, genremove_intercept, genremove_slope,
10       &     genfld, gen0, gen1, genmask,       &     genfld, gen0, gen1, genmask,
11  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
12       &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,       &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
13       &     gen_nlon, gen_nlat, gen_xout, gen_yout,       &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
14  #endif  #endif
15       &     mycurrenttime, mycurrentiter, mythid )       &     mytime, myiter, mythid )
16    
17  c     ==================================================================  c     ==================================================================
18  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 22  c              heimbach@mit.edu: totally Line 27  c              heimbach@mit.edu: totally
27  c              replaced all routines by one generic routine  c              replaced all routines by one generic routine
28  c              5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary  c              5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary
29  c                          input grid capability  c                          input grid capability
30    c     11-Dec-2006 added time-mean and monthly-mean climatology options
31    c        genperiod=0 means input file is one time-constant field
32    c        genperiod=-12 means input file contains 12 monthly means
33    
34  c     ==================================================================  c     ==================================================================
35  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 33  c     == global variables == Line 41  c     == global variables ==
41    
42  #include "EEPARAMS.h"  #include "EEPARAMS.h"
43  #include "SIZE.h"  #include "SIZE.h"
44    #include "PARAMS.h"
45  #include "GRID.h"  #include "GRID.h"
46    
47  #include "exf_param.h"  #include "EXF_PARAM.h"
48  #include "exf_constants.h"  #include "EXF_CONSTANTS.h"
49    
50  c     == routine arguments ==  c     == routine arguments ==
51    
52        integer genstartdate(4)        integer genstartdate1, genstartdate2
53        _RL     genperiod        _RL genstartdate, genperiod
54        _RL     exf_inscal_gen        _RL exf_inscal_gen
55        _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genremove_intercept, genremove_slope
56        _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
57        _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
58          _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
59        character*1 genmask        character*1 genmask
60        character*(128) genfile        character*(128) genfile
61        _RL     mycurrenttime        _RL     mytime
62        integer mycurrentiter        integer myiter
63        integer mythid        integer mythid
64    
65  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
66  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
67  c                             corner of global input grid  c                             corner of global input grid
# Line 63  c     gen_xout, gen_yout   :: coordinate Line 74  c     gen_xout, gen_yout   :: coordinate
74        INTEGER gen_nlon, gen_nlat        INTEGER gen_nlon, gen_nlat
75        _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
76        _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
77  #endif        integer interp_method
78    #endif /* USE_EXF_INTERPOLATION */
79    
80  c     == local variables ==  c     == local variables ==
81    
82        logical first, changed        logical first, changed
83        integer count0, count1        integer count0, count1
84          integer year0, year1
85          integer bi, bj, i, j, il
86        _RL     fac        _RL     fac
87          character*(128) genfile0, genfile1
88    
89    c     == external ==
90    
91        integer bi, bj        integer  ilnblnk
92        integer i, j, interp_method        external ilnblnk
93    
94  c     == end of interface ==  c     == end of interface ==
95    
96        if ( genfile .NE. ' ' ) then        if ( genfile .NE. ' ' .and. genperiod .ne. 0 ) then
97    
98    cph(
99    cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000
100    cph)
101    
102             if ( genperiod .eq. -12 ) then
103    c     genperiod=-12 means input file contains 12 monthly means
104    c     record numbers are assumed 1 to 12 corresponding to
105    c     Jan. through Dec.
106                call cal_GetMonthsRec(
107         O           fac, first, changed,
108         O           count0, count1,
109         I           mytime, myiter, mythid
110         &           )
111    
112             elseif ( genperiod .lt. 0 ) then
113                print *, 'genperiod is out of range'
114                STOP 'ABNORMAL END: S/R EXF_GETFFIELDREC'
115    
116             else
117  c     get record numbers and interpolation factor for gen  c     get record numbers and interpolation factor for gen
118           call exf_GetFFieldRec(              call exf_GetFFieldRec(
119       I        genstartdate, genperiod       I           genstartdate, genperiod
120       O        , fac, first, changed       I           , genstartdate1, genstartdate2
121       O        , count0, count1       I           , useExfYearlyFields
122       I        , mycurrenttime, mycurrentiter, mythid       O           , fac, first, changed
123       &        )       O           , count0, count1, year0, year1
124         I           , mytime, myiter, mythid
125         &           )
126    
127             endif
128    
129           if ( first ) then           if ( first ) then
130                if (useExfYearlyFields.and.genperiod.gt.0) then
131    C     Complete filename with YR or _YEAR extension
132                   il = ilnblnk( genfile )
133                   if (twoDigitYear) then
134                      if (year0.ge.2000) then
135                         write(genfile0(1:128),'(a,i2.2)')
136         &                    genfile(1:il),year0-2000
137                      else
138                         write(genfile0(1:128),'(a,i2.2)')
139         &                    genfile(1:il),year0-1900
140                      endif
141                   else
142                      write(genfile0(1:128),'(2a,i4.4)')
143         &                 genfile(1:il),'_',year0
144                   endif
145                else
146                   genfile0 = genfile
147                endif
148    
149  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
150              interp_method = 2              call exf_interp( genfile0, exf_iprec
             call exf_interp( genfile, exf_iprec  
151       &           , gen1, count0, gen_xout, gen_yout       &           , gen1, count0, gen_xout, gen_yout
152       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
153       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
154       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
155       &           )       &           )
156  #else  #else
157              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1
158       &           , gen1, count0, mythid       &           , gen1, count0, mythid
159       &           )       &           )
160  #endif  #endif /* USE_EXF_INTERPOLATION */
161    
162              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
163                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 111  c     get record numbers and interpolati Line 169  c     get record numbers and interpolati
169           if (( first ) .or. ( changed )) then           if (( first ) .or. ( changed )) then
170              call exf_SwapFFields( gen0, gen1, mythid )              call exf_SwapFFields( gen0, gen1, mythid )
171                            
172                if (useExfYearlyFields.and.genperiod.gt.0) then
173    C     Complete filename with YR or _YEAR extension
174                   il = ilnblnk( genfile )
175                   if (twoDigitYear) then
176                      if (year1.ge.2000) then
177                         write(genfile1(1:128),'(a,i2.2)')
178         &                    genfile(1:il),year1-2000
179                      else
180                         write(genfile1(1:128),'(a,i2.2)')
181         &                    genfile(1:il),year1-1900
182                      endif
183                   else
184                      write(genfile1(1:128),'(2a,i4.4)')
185         &                 genfile(1:il),'_',year1
186                   endif
187                else
188                   genfile1 = genfile
189                endif
190  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
191              interp_method = 2              call exf_interp( genfile1, exf_iprec
             call exf_interp( genfile, exf_iprec  
192       &           , gen1, count1, gen_xout, gen_yout       &           , gen1, count1, gen_xout, gen_yout
193       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
194       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
195       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
196       &           )       &           )
197  #else  #else
198              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
199       &           , gen1, count1, mythid       &           , gen1, count1, mythid
200       &           )       &           )
201  #endif  #endif /* USE_EXF_INTERPOLATION */
202    
203              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
204                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 134  c     get record numbers and interpolati Line 209  c     get record numbers and interpolati
209    
210  c     Loop over tiles.  c     Loop over tiles.
211           do bj = mybylo(mythid),mybyhi(mythid)           do bj = mybylo(mythid),mybyhi(mythid)
212              do bi = mybxlo(mythid),mybxhi(mythid)            do bi = mybxlo(mythid),mybxhi(mythid)
213                 do j = 1,sny             do j = 1,sny
214                    do i = 1,snx              do i = 1,snx
215    c     Interpolate linearly onto the  time.
216  c     Interpolate linearly onto the current time.               genfld(i,j,bi,bj) = exf_inscal_gen * (
217         &                          fac * gen0(i,j,bi,bj) +
218                       genfld(i,j,bi,bj) = exf_inscal_gen * (       &              (exf_one - fac) * gen1(i,j,bi,bj) )
219       &                                fac * gen0(i,j,bi,bj) +               genfld(i,j,bi,bj) =
220       &                    (exf_one - fac) * gen1(i,j,bi,bj) )       &            genfld(i,j,bi,bj) -
221         &            exf_inscal_gen * ( genremove_intercept +
222                    enddo       &            genremove_slope*(mytime-starttime) )
                enddo  
223              enddo              enddo
224               enddo
225              enddo
226           enddo           enddo
227    
228        endif        endif
# Line 154  c     Interpolate linearly onto the curr Line 230  c     Interpolate linearly onto the curr
230        end        end
231    
232    
233    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
234    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
235    
236        subroutine exf_init_gen (        subroutine exf_init_gen (
237       &     genconst, genfld, gen0, gen1, mythid )       &     genfile, genperiod, exf_inscal_gen, genmask,
238         &     genconst, genfld, gen0, gen1,
239    #ifdef USE_EXF_INTERPOLATION
240         &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
241         &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
242    #endif
243         &     mythid )
244    
245    
246  c     ==================================================================  c     ==================================================================
247  c     SUBROUTINE exf_init_gen  c     SUBROUTINE exf_init_gen
# Line 180  c     == global variables == Line 265  c     == global variables ==
265  #include "EEPARAMS.h"  #include "EEPARAMS.h"
266  #include "SIZE.h"  #include "SIZE.h"
267    
268  #include "exf_param.h"  #include "EXF_PARAM.h"
269    
270  c     == routine arguments ==  c     == routine arguments ==
271    
272        _RL genconst        _RL genperiod, exf_inscal_gen, genconst
273        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
274        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
275        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
276          character*1 genmask
277          character*(128) genfile
278        integer mythid        integer mythid
279    
280    #ifdef USE_EXF_INTERPOLATION
281    c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
282    c                             corner of global input grid
283    c     gen_nlon, gen_nlat   :: input x-grid and y-grid size
284    c     gen_lon_inc          :: scalar x-grid increment
285    c     gen_lat_inc          :: vector y-grid increments
286    c     gen_xout, gen_yout   :: coordinates for output grid
287          _RL gen_lon0, gen_lon_inc
288          _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
289          INTEGER gen_nlon, gen_nlat
290          _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
291          _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
292          integer interp_method
293    #endif /* USE_EXF_INTERPOLATION */
294    
295  c     == local variables ==  c     == local variables ==
296    
297        integer bi, bj        integer bi, bj, i, j, count
       integer i, j  
298    
299  c     == end of interface ==  c     == end of interface ==
300    
301        do bj = mybylo(mythid), mybyhi(mythid)        do bj = mybylo(mythid), mybyhi(mythid)
302          do bi = mybxlo(mythid), mybxhi(mythid)          do bi = mybxlo(mythid), mybxhi(mythid)
303            do j = 1, sny            do j = 1-oly, sny+oly
304              do i = 1, snx              do i = 1-olx, snx+olx
305                genfld(i,j,bi,bj)  = genconst                genfld(i,j,bi,bj)  = genconst
306                gen0(i,j,bi,bj)    = 0. _d 0                gen0(i,j,bi,bj)    = genconst
307                gen1(i,j,bi,bj)    = 0. _d 0                gen1(i,j,bi,bj)    = genconst
308              enddo              enddo
309            enddo            enddo
310          enddo          enddo
311        enddo        enddo
312    
313          if ( genfile .NE. ' ' .and. genperiod .eq. 0. ) then
314             count = 1
315    
316    #ifdef USE_EXF_INTERPOLATION
317             call exf_interp( genfile, exf_iprec
318         &        , genfld, count, gen_xout, gen_yout
319         &        , gen_lon0,gen_lon_inc
320         &        , gen_lat0,gen_lat_inc
321         &        , gen_nlon,gen_nlat,interp_method,mythid
322         &        )
323    #else
324             call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
325         &        , genfld, count, mythid
326         &        )
327    #endif /* USE_EXF_INTERPOLATION */
328    
329             if (exf_yftype .eq. 'RL') then
330                call exf_filter_rl( genfld, genmask, mythid )
331             else
332                call exf_filter_rs( genfld, genmask, mythid )
333             end if
334    
335    c     Loop over tiles.
336             do bj = mybylo(mythid),mybyhi(mythid)
337                do bi = mybxlo(mythid),mybxhi(mythid)
338                   do j = 1,sny
339                      do i = 1,snx
340    c     Interpolate linearly onto the  time.
341                         genfld(i,j,bi,bj) =
342         &                    exf_inscal_gen * genfld(i,j,bi,bj)
343                      enddo
344                   enddo
345                enddo
346             enddo
347    
348          endif
349    
350        end        end
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22