/[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.15 by dimitri, Mon Dec 11 16:19:19 2006 UTC revision 1.23 by dimitri, Fri Jan 25 01:07:49 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(
# Line 41  c     == global variables == Line 44  c     == global variables ==
44  #include "PARAMS.h"  #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    
# Line 54  c     == routine arguments == Line 57  c     == routine arguments ==
57        _RL gen0  (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)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
59        character*1 genmask        character*1 genmask
60        character*(128) genfile, genfile0, genfile1        character*(128) genfile
61        _RL     mytime        _RL     mytime
62        integer myiter        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 71  c     gen_xout, gen_yout   :: coordinate Line 75  c     gen_xout, gen_yout   :: coordinate
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        integer interp_method        integer interp_method
78  #endif  #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        integer year0, year1
85          integer bi, bj, i, j, il
86        _RL     fac        _RL     fac
87          character*(128) genfile0, genfile1
       integer bi, bj  
       integer i, j, il  
88    
89  c     == external ==  c     == external ==
90    
# Line 90  c     == external == Line 93  c     == external ==
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(  cph(
99  cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000  cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000
100  cph)  cph)
101    
102           if ( genperiod .eq. 0 ) then           if ( genperiod .eq. -12 ) then
 c     genperiod=0 means input file is one time-constant field  
             count0 = 1  
             count1 = 1  
   
          elseif ( genperiod .eq. -12 ) then  
103  c     genperiod=-12 means input file contains 12 monthly means  c     genperiod=-12 means input file contains 12 monthly means
104  c     record numbers are assumed 1 to 12 corresponding to  c     record numbers are assumed 1 to 12 corresponding to
105  c     Jan. through Dec.  c     Jan. through Dec.
# Line 113  c     Jan. through Dec. Line 111  c     Jan. through Dec.
111    
112           elseif ( genperiod .lt. 0 ) then           elseif ( genperiod .lt. 0 ) then
113              print *, 'genperiod is out of range'              print *, 'genperiod is out of range'
114              STOP 'ABNORMAL END: S/R EXF_GETFFIELDREC'              STOP 'ABNORMAL END: S/R EXF_SET_GEN'
115    
116           else           else
117  c     get record numbers and interpolation factor for gen  c     get record numbers and interpolation factor for gen
# Line 148  C     Complete filename with YR or _YEAR Line 146  C     Complete filename with YR or _YEAR
146                 genfile0 = genfile                 genfile0 = genfile
147              endif              endif
148    
   
149  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
150              call exf_interp( genfile0, exf_iprec              call exf_interp( genfile0, exf_iprec
151       &           , gen1, count0, gen_xout, gen_yout       &           , gen1, count0, gen_xout, gen_yout
# Line 157  C     Complete filename with YR or _YEAR Line 154  C     Complete filename with YR or _YEAR
154       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
155       &           )       &           )
156  #else  #else
157                _BARRIER
158              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1
159       &           , gen1, count0, mythid       &           , gen1, count0, mythid
160       &           )       &           )
161  #endif              _BARRIER
162    #endif /* USE_EXF_INTERPOLATION */
163    
164              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
165                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 198  C     Complete filename with YR or _YEAR Line 197  C     Complete filename with YR or _YEAR
197       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
198       &           )       &           )
199  #else  #else
200                _BARRIER
201              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
202       &           , gen1, count1, mythid       &           , gen1, count1, mythid
203       &           )       &           )
204  #endif              _BARRIER
205    #endif /* USE_EXF_INTERPOLATION */
206    
207              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
208                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 223  c     Interpolate linearly onto the  tim Line 224  c     Interpolate linearly onto the  tim
224       &            genfld(i,j,bi,bj) -       &            genfld(i,j,bi,bj) -
225       &            exf_inscal_gen * ( genremove_intercept +       &            exf_inscal_gen * ( genremove_intercept +
226       &            genremove_slope*(mytime-starttime) )       &            genremove_slope*(mytime-starttime) )
                   enddo  
                enddo  
227              enddo              enddo
228               enddo
229              enddo
230           enddo           enddo
231    
232        endif        endif
233    
234        end        RETURN
235          END
236    
237    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
238    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
239    
240        subroutine exf_init_gen (        subroutine exf_init_gen (
241       &     genconst, genfld, gen0, gen1, geninitfile, mythid )       &     genfile, genperiod, exf_inscal_gen, genmask,
242         &     genconst, genfld, gen0, gen1,
243    #ifdef USE_EXF_INTERPOLATION
244         &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
245         &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
246    #endif
247         &     mythid )
248    
249    
250  c     ==================================================================  c     ==================================================================
251  c     SUBROUTINE exf_init_gen  c     SUBROUTINE exf_init_gen
# Line 259  c     == global variables == Line 269  c     == global variables ==
269  #include "EEPARAMS.h"  #include "EEPARAMS.h"
270  #include "SIZE.h"  #include "SIZE.h"
271    
272  #include "exf_param.h"  #include "EXF_PARAM.h"
273    
274  c     == routine arguments ==  c     == routine arguments ==
275    
276        _RL genconst        _RL genperiod, exf_inscal_gen, genconst
277        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
278        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
279        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
280        character*(128) geninitfile        character*1 genmask
281          character*(128) genfile
282        integer mythid        integer mythid
283    
284    #ifdef USE_EXF_INTERPOLATION
285    c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
286    c                             corner of global input grid
287    c     gen_nlon, gen_nlat   :: input x-grid and y-grid size
288    c     gen_lon_inc          :: scalar x-grid increment
289    c     gen_lat_inc          :: vector y-grid increments
290    c     gen_xout, gen_yout   :: coordinates for output grid
291          _RL gen_lon0, gen_lon_inc
292          _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
293          INTEGER gen_nlon, gen_nlat
294          _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
295          _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
296          integer interp_method
297    #endif /* USE_EXF_INTERPOLATION */
298    
299  c     == local variables ==  c     == local variables ==
300    
301        integer bi, bj        integer bi, bj, i, j, count
       integer i, j  
302    
303  c     == end of interface ==  c     == end of interface ==
304    
# Line 289  c     == end of interface == Line 314  c     == end of interface ==
314          enddo          enddo
315        enddo        enddo
316    
317        if ( geninitfile .NE. ' ' ) then        if ( genfile .NE. ' ' .and. genperiod .eq. 0. ) then
318           call mdsreadfield( geninitfile, exf_iprec, exf_yftype,           count = 1
319       &        1, genfld, 1, mythid )  
320    #ifdef USE_EXF_INTERPOLATION
321             call exf_interp( genfile, exf_iprec
322         &        , genfld, count, gen_xout, gen_yout
323         &        , gen_lon0,gen_lon_inc
324         &        , gen_lat0,gen_lat_inc
325         &        , gen_nlon,gen_nlat,interp_method,mythid
326         &        )
327    #else
328             _BARRIER
329             call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
330         &        , genfld, count, mythid
331         &        )
332             _BARRIER
333    #endif /* USE_EXF_INTERPOLATION */
334    
335             if (exf_yftype .eq. 'RL') then
336                call exf_filter_rl( genfld, genmask, mythid )
337             else
338                call exf_filter_rs( genfld, genmask, mythid )
339             end if
340    
341    c     Loop over tiles and scale genfld
342             do bj = mybylo(mythid),mybyhi(mythid)
343                do bi = mybxlo(mythid),mybxhi(mythid)
344                   do j = 1,sny
345                      do i = 1,snx
346                         genfld(i,j,bi,bj) =
347         &                    exf_inscal_gen * genfld(i,j,bi,bj)
348                      enddo
349                   enddo
350                enddo
351             enddo
352    
353        endif        endif
354    
355        end        RETURN
356          END
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22