/[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.18 by jmc, Mon Apr 16 23:27:21 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(
# 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 160  C     Complete filename with YR or _YEAR Line 158  C     Complete filename with YR or _YEAR
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  #endif /* USE_EXF_INTERPOLATION */
162    
163              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
164                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 201  C     Complete filename with YR or _YEAR Line 199  C     Complete filename with YR or _YEAR
199              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
200       &           , gen1, count1, mythid       &           , gen1, count1, mythid
201       &           )       &           )
202  #endif  #endif /* USE_EXF_INTERPOLATION */
203    
204              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
205                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 233  c     Interpolate linearly onto the  tim Line 231  c     Interpolate linearly onto the  tim
231        end        end
232    
233    
234    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
235    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
236    
237        subroutine exf_init_gen (        subroutine exf_init_gen (
238       &     genconst, genfld, gen0, gen1, geninitfile, mythid )       &     genfile, genperiod, exf_inscal_gen, genmask,
239         &     genconst, genfld, gen0, gen1,
240    #ifdef USE_EXF_INTERPOLATION
241         &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
242         &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
243    #endif
244         &     mythid )
245    
246    
247  c     ==================================================================  c     ==================================================================
248  c     SUBROUTINE exf_init_gen  c     SUBROUTINE exf_init_gen
# Line 259  c     == global variables == Line 266  c     == global variables ==
266  #include "EEPARAMS.h"  #include "EEPARAMS.h"
267  #include "SIZE.h"  #include "SIZE.h"
268    
269  #include "exf_param.h"  #include "EXF_PARAM.h"
270    
271  c     == routine arguments ==  c     == routine arguments ==
272    
273        _RL genconst        _RL genperiod, exf_inscal_gen, genconst
274        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
275        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
276        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
277        character*(128) geninitfile        character*1 genmask
278          character*(128) genfile
279        integer mythid        integer mythid
280    
281    #ifdef USE_EXF_INTERPOLATION
282    c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
283    c                             corner of global input grid
284    c     gen_nlon, gen_nlat   :: input x-grid and y-grid size
285    c     gen_lon_inc          :: scalar x-grid increment
286    c     gen_lat_inc          :: vector y-grid increments
287    c     gen_xout, gen_yout   :: coordinates for output grid
288          _RL gen_lon0, gen_lon_inc
289          _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
290          INTEGER gen_nlon, gen_nlat
291          _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
292          _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
293          integer interp_method
294    #endif /* USE_EXF_INTERPOLATION */
295    
296  c     == local variables ==  c     == local variables ==
297    
298        integer bi, bj        integer bi, bj, i, j, count
       integer i, j  
299    
300  c     == end of interface ==  c     == end of interface ==
301    
# Line 289  c     == end of interface == Line 311  c     == end of interface ==
311          enddo          enddo
312        enddo        enddo
313    
314        if ( geninitfile .NE. ' ' ) then        if ( genfile .NE. ' ' .and. genperiod .eq. 0. ) then
315           call mdsreadfield( geninitfile, exf_iprec, exf_yftype,           count = 1
316       &        1, genfld, 1, mythid )  
317    #ifdef USE_EXF_INTERPOLATION
318             call exf_interp( genfile, exf_iprec
319         &        , genfld, count, gen_xout, gen_yout
320         &        , gen_lon0,gen_lon_inc
321         &        , gen_lat0,gen_lat_inc
322         &        , gen_nlon,gen_nlat,interp_method,mythid
323         &        )
324    #else
325             call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
326         &        , genfld, count, mythid
327         &        )
328    #endif /* USE_EXF_INTERPOLATION */
329    
330             if (exf_yftype .eq. 'RL') then
331                call exf_filter_rl( genfld, genmask, mythid )
332             else
333                call exf_filter_rs( genfld, genmask, mythid )
334             end if
335    
336    c     Loop over tiles.
337             do bj = mybylo(mythid),mybyhi(mythid)
338                do bi = mybxlo(mythid),mybxhi(mythid)
339                   do j = 1,sny
340                      do i = 1,snx
341    c     Interpolate linearly onto the  time.
342                         genfld(i,j,bi,bj) =
343         &                    exf_inscal_gen * genfld(i,j,bi,bj)
344                      enddo
345                   enddo
346                enddo
347             enddo
348    
349        endif        endif
350    
351        end        end
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22