/[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.8 by dimitri, Mon Oct 20 06:25:16 2003 UTC revision 1.25 by dimitri, Tue Jan 29 11:25:53 2008 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         &     exf_inscal_gen, genremove_intercept, genremove_slope,
9       &     genfld, gen0, gen1, genmask,       &     genfld, gen0, gen1, genmask,
10  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
11       &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,       &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
12       &     gen_nlon, gen_nlat, gen_xout, gen_yout,       &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
13  #endif  #endif
14       &     mycurrenttime, mycurrentiter, mythid )       &     mytime, myiter, mythid )
15    
16  c     ==================================================================  c     ==================================================================
17  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 22  c              heimbach@mit.edu: totally Line 26  c              heimbach@mit.edu: totally
26  c              replaced all routines by one generic routine  c              replaced all routines by one generic routine
27  c              5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary  c              5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary
28  c                          input grid capability  c                          input grid capability
29    c     11-Dec-2006 added time-mean and monthly-mean climatology options
30    c        genperiod=0 means input file is one time-constant field
31    c        genperiod=-12 means input file contains 12 monthly means
32    
33  c     ==================================================================  c     ==================================================================
34  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 33  c     == global variables == Line 40  c     == global variables ==
40    
41  #include "EEPARAMS.h"  #include "EEPARAMS.h"
42  #include "SIZE.h"  #include "SIZE.h"
43    #include "PARAMS.h"
44  #include "GRID.h"  #include "GRID.h"
45    
46  #include "exf_param.h"  #include "EXF_PARAM.h"
47  #include "exf_constants.h"  #include "EXF_CONSTANTS.h"
48    
49  c     == routine arguments ==  c     == routine arguments ==
50    
51        _RL     genstartdate, genperiod        _RL genstartdate, genperiod
52        _RL     exf_inscal_gen        _RL exf_inscal_gen
53        _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genremove_intercept, genremove_slope
54        _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
55        _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
56          _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
57        character*1 genmask        character*1 genmask
58        character*(128) genfile        character*(128) genfile
59        _RL     mycurrenttime        _RL     mytime
60        integer mycurrentiter        integer myiter
61        integer mythid        integer mythid
62    
63  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
64  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
65  c                             corner of global input grid  c                             corner of global input grid
# Line 62  c     gen_xout, gen_yout   :: coordinate Line 72  c     gen_xout, gen_yout   :: coordinate
72        INTEGER gen_nlon, gen_nlat        INTEGER gen_nlon, gen_nlat
73        _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)
74        _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)
75  #endif        integer interp_method
76    #endif /* USE_EXF_INTERPOLATION */
77    
78  c     == local variables ==  c     == local variables ==
79    
80        logical first, changed        logical first, changed
81        integer count0, count1        integer count0, count1
82          integer year0, year1
83          integer bi, bj, i, j, il
84        _RL     fac        _RL     fac
85          character*(128) genfile0, genfile1
86    
87    c     == external ==
88    
89        integer bi, bj        integer  ilnblnk
90        integer i, j, interp_method        external ilnblnk
91    
92  c     == end of interface ==  c     == end of interface ==
93    
94        if ( genfile .NE. ' ' ) then        if ( genfile .NE. ' ' .and. genperiod .ne. 0 ) then
95    
96    cph(
97    cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000
98    cph)
99    
100             if ( genperiod .eq. -12 ) then
101    c     genperiod=-12 means input file contains 12 monthly means
102    c     record numbers are assumed 1 to 12 corresponding to
103    c     Jan. through Dec.
104                call cal_GetMonthsRec(
105         O           fac, first, changed,
106         O           count0, count1,
107         I           mytime, myiter, mythid
108         &           )
109    
110             elseif ( genperiod .lt. 0 ) then
111                print *, 'genperiod is out of range'
112                STOP 'ABNORMAL END: S/R EXF_SET_GEN'
113    
114             else
115  c     get record numbers and interpolation factor for gen  c     get record numbers and interpolation factor for gen
116           call exf_GetFFieldRec(              call exf_GetFFieldRec(
117       I        genstartdate, genperiod       I           genstartdate, genperiod
118       O        , fac, first, changed       I           , useExfYearlyFields
119       O        , count0, count1       O           , fac, first, changed
120       I        , mycurrenttime, mycurrentiter, mythid       O           , count0, count1, year0, year1
121       &        )       I           , mytime, myiter, mythid
122         &           )
123    
124             endif
125    
126           if ( first ) then           if ( first ) then
127                call exf_GetYearlyFieldName(
128         I         useExfYearlyFields, twoDigitYear, genperiod, year0,
129         I         genfile,
130         O         genfile0,
131         I         mytime, myiter, mythid )
132    
133  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
134              interp_method = 2              call exf_interp( genfile0, exf_iprec
             call exf_interp( genfile, exf_iprec  
135       &           , gen1, count0, gen_xout, gen_yout       &           , gen1, count0, gen_xout, gen_yout
136       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
137       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
138       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
139       &           )       &           )
140  #else  #else
141              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              _BARRIER
142                call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1
143       &           , gen1, count0, mythid       &           , gen1, count0, mythid
144       &           )       &           )
145  #endif              _BARRIER
146    #endif /* USE_EXF_INTERPOLATION */
147    
148              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
149                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 110  c     get record numbers and interpolati Line 155  c     get record numbers and interpolati
155           if (( first ) .or. ( changed )) then           if (( first ) .or. ( changed )) then
156              call exf_SwapFFields( gen0, gen1, mythid )              call exf_SwapFFields( gen0, gen1, mythid )
157                            
158                call exf_GetYearlyFieldName(
159         I         useExfYearlyFields, twoDigitYear, genperiod, year1,
160         I         genfile,
161         O         genfile1,
162         I         mytime, myiter, mythid )
163    
164  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
165              interp_method = 2              call exf_interp( genfile1, exf_iprec
             call exf_interp( genfile, exf_iprec  
166       &           , gen1, count1, gen_xout, gen_yout       &           , gen1, count1, gen_xout, gen_yout
167       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
168       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
169       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
170       &           )       &           )
171  #else  #else
172              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              _BARRIER
173                call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
174       &           , gen1, count1, mythid       &           , gen1, count1, mythid
175       &           )       &           )
176  #endif              _BARRIER
177    #endif /* USE_EXF_INTERPOLATION */
178    
179              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
180                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 133  c     get record numbers and interpolati Line 185  c     get record numbers and interpolati
185    
186  c     Loop over tiles.  c     Loop over tiles.
187           do bj = mybylo(mythid),mybyhi(mythid)           do bj = mybylo(mythid),mybyhi(mythid)
188              do bi = mybxlo(mythid),mybxhi(mythid)            do bi = mybxlo(mythid),mybxhi(mythid)
189                 do j = 1,sny             do j = 1,sny
190                    do i = 1,snx              do i = 1,snx
191    c     Interpolate linearly onto the  time.
192  c     Interpolate linearly onto the current time.               genfld(i,j,bi,bj) = exf_inscal_gen * (
193         &                          fac * gen0(i,j,bi,bj) +
194                       genfld(i,j,bi,bj) = exf_inscal_gen * (       &              (exf_one - fac) * gen1(i,j,bi,bj) )
195       &                                fac * gen0(i,j,bi,bj) +               genfld(i,j,bi,bj) =
196       &                    (exf_one - fac) * gen1(i,j,bi,bj) )       &            genfld(i,j,bi,bj) -
197         &            exf_inscal_gen * ( genremove_intercept +
198                    enddo       &            genremove_slope*(mytime-starttime) )
                enddo  
199              enddo              enddo
200               enddo
201              enddo
202           enddo           enddo
203    
204        endif        endif
205    
206        end        RETURN
207          END
208    
209    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
210    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
211    
212        subroutine exf_init_gen (        subroutine exf_init_gen (
213       &     genconst, genfld, gen0, gen1, mythid )       &     genfile, genperiod, exf_inscal_gen, genmask,
214         &     genconst, genfld, gen0, gen1,
215    #ifdef USE_EXF_INTERPOLATION
216         &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
217         &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
218    #endif
219         &     mythid )
220    
221    
222  c     ==================================================================  c     ==================================================================
223  c     SUBROUTINE exf_init_gen  c     SUBROUTINE exf_init_gen
# Line 179  c     == global variables == Line 241  c     == global variables ==
241  #include "EEPARAMS.h"  #include "EEPARAMS.h"
242  #include "SIZE.h"  #include "SIZE.h"
243    
244  #include "exf_param.h"  #include "EXF_PARAM.h"
245    
246  c     == routine arguments ==  c     == routine arguments ==
247    
248        _RL genconst        _RL genperiod, exf_inscal_gen, genconst
249        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
250        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
251        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
252          character*1 genmask
253          character*(128) genfile
254        integer mythid        integer mythid
255    
256    #ifdef USE_EXF_INTERPOLATION
257    c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
258    c                             corner of global input grid
259    c     gen_nlon, gen_nlat   :: input x-grid and y-grid size
260    c     gen_lon_inc          :: scalar x-grid increment
261    c     gen_lat_inc          :: vector y-grid increments
262    c     gen_xout, gen_yout   :: coordinates for output grid
263          _RL gen_lon0, gen_lon_inc
264          _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
265          INTEGER gen_nlon, gen_nlat
266          _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
267          _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
268          integer interp_method
269    #endif /* USE_EXF_INTERPOLATION */
270    
271  c     == local variables ==  c     == local variables ==
272    
273        integer bi, bj        integer bi, bj, i, j, count
       integer i, j  
274    
275  c     == end of interface ==  c     == end of interface ==
276    
277        do bj = mybylo(mythid), mybyhi(mythid)        do bj = mybylo(mythid), mybyhi(mythid)
278          do bi = mybxlo(mythid), mybxhi(mythid)          do bi = mybxlo(mythid), mybxhi(mythid)
279            do j = 1, sny            do j = 1-oly, sny+oly
280              do i = 1, snx              do i = 1-olx, snx+olx
281                genfld(i,j,bi,bj)  = genconst                genfld(i,j,bi,bj)  = genconst
282                gen0(i,j,bi,bj)    = 0. _d 0                gen0(i,j,bi,bj)    = genconst
283                gen1(i,j,bi,bj)    = 0. _d 0                gen1(i,j,bi,bj)    = genconst
284              enddo              enddo
285            enddo            enddo
286          enddo          enddo
287        enddo        enddo
288    
289        end        if ( genfile .NE. ' ' .and. genperiod .eq. 0. ) then
290             count = 1
291    
292    #ifdef USE_EXF_INTERPOLATION
293             call exf_interp( genfile, exf_iprec
294         &        , genfld, count, gen_xout, gen_yout
295         &        , gen_lon0,gen_lon_inc
296         &        , gen_lat0,gen_lat_inc
297         &        , gen_nlon,gen_nlat,interp_method,mythid
298         &        )
299    #else
300             _BARRIER
301             call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
302         &        , genfld, count, mythid
303         &        )
304             _BARRIER
305    #endif /* USE_EXF_INTERPOLATION */
306    
307             if (exf_yftype .eq. 'RL') then
308                call exf_filter_rl( genfld, genmask, mythid )
309             else
310                call exf_filter_rs( genfld, genmask, mythid )
311             end if
312    
313    c     Loop over tiles and scale genfld
314             do bj = mybylo(mythid),mybyhi(mythid)
315                do bi = mybxlo(mythid),mybxhi(mythid)
316                   do j = 1,sny
317                      do i = 1,snx
318                         genfld(i,j,bi,bj) =
319         &                    exf_inscal_gen * genfld(i,j,bi,bj)
320                      enddo
321                   enddo
322                enddo
323             enddo
324    
325          endif
326    
327          RETURN
328          END
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22