/[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.14 by heimbach, Thu Oct 12 21:34:59 2006 UTC revision 1.17 by dimitri, Fri Feb 9 04:53:52 2007 UTC
# Line 24  c              heimbach@mit.edu: totally Line 24  c              heimbach@mit.edu: totally
24  c              replaced all routines by one generic routine  c              replaced all routines by one generic routine
25  c              5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary  c              5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary
26  c                          input grid capability  c                          input grid capability
27    c     11-Dec-2006 added time-mean and monthly-mean climatology options
28    c        genperiod=0 means input file is one time-constant field
29    c        genperiod=-12 means input file contains 12 monthly means
30    
31  c     ==================================================================  c     ==================================================================
32  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 51  c     == routine arguments == Line 54  c     == routine arguments ==
54        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
55        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
56        character*1 genmask        character*1 genmask
57        character*(128) genfile, genfile0, genfile1        character*(128) genfile
58        _RL     mytime        _RL     mytime
59        integer myiter        integer myiter
60        integer mythid        integer mythid
61    
62  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
63  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
64  c                             corner of global input grid  c                             corner of global input grid
# Line 68  c     gen_xout, gen_yout   :: coordinate Line 72  c     gen_xout, gen_yout   :: coordinate
72        _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)
73        _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)
74        integer interp_method        integer interp_method
75  #endif  #endif /* USE_EXF_INTERPOLATION */
76    
77  c     == local variables ==  c     == local variables ==
78    
79        logical first, changed        logical first, changed
80        integer count0, count1        integer count0, count1
81        integer year0, year1        integer year0, year1
82          integer bi, bj, i, j, il
83        _RL     fac        _RL     fac
84          character*(128) genfile0, genfile1
       integer bi, bj  
       integer i, j, il  
85    
86  c     == external ==  c     == external ==
87    
# Line 87  c     == external == Line 90  c     == external ==
90    
91  c     == end of interface ==  c     == end of interface ==
92    
93        if ( genfile .NE. ' ' ) then        if ( genfile .NE. ' ' .and. genperiod .ne. 0 ) then
94    
95  cph(  cph(
96  cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000  cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000
97  cph)  cph)
98    
99             if ( genperiod .eq. -12 ) then
100    c     genperiod=-12 means input file contains 12 monthly means
101    c     record numbers are assumed 1 to 12 corresponding to
102    c     Jan. through Dec.
103                call cal_GetMonthsRec(
104         O           fac, first, changed,
105         O           count0, count1,
106         I           mytime, myiter, mythid
107         &           )
108    
109             elseif ( genperiod .lt. 0 ) then
110                print *, 'genperiod is out of range'
111                STOP 'ABNORMAL END: S/R EXF_GETFFIELDREC'
112    
113             else
114  c     get record numbers and interpolation factor for gen  c     get record numbers and interpolation factor for gen
115           call exf_GetFFieldRec(              call exf_GetFFieldRec(
116       I        genstartdate, genperiod       I           genstartdate, genperiod
117       I        , genstartdate1, genstartdate2       I           , genstartdate1, genstartdate2
118       I        , useExfYearlyFields       I           , useExfYearlyFields
119       O        , fac, first, changed       O           , fac, first, changed
120       O        , count0, count1, year0, year1       O           , count0, count1, year0, year1
121       I        , mytime, myiter, mythid       I           , mytime, myiter, mythid
122       &        )       &           )
123    
124             endif
125    
126           if ( first ) then           if ( first ) then
127              if (useExfYearlyFields) then              if (useExfYearlyFields.and.genperiod.gt.0) then
128  C     Complete filename with YR or _YEAR extension  C     Complete filename with YR or _YEAR extension
129                 il = ilnblnk( genfile )                 il = ilnblnk( genfile )
130                 if (twoDigitYear) then                 if (twoDigitYear) then
# Line 121  C     Complete filename with YR or _YEAR Line 142  C     Complete filename with YR or _YEAR
142              else              else
143                 genfile0 = genfile                 genfile0 = genfile
144              endif              endif
145    
146    
147  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
148              call exf_interp( genfile0, exf_iprec              call exf_interp( genfile0, exf_iprec
149       &           , gen1, count0, gen_xout, gen_yout       &           , gen1, count0, gen_xout, gen_yout
# Line 132  C     Complete filename with YR or _YEAR Line 155  C     Complete filename with YR or _YEAR
155              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1
156       &           , gen1, count0, mythid       &           , gen1, count0, mythid
157       &           )       &           )
158  #endif  #endif /* USE_EXF_INTERPOLATION */
159    
160              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
161                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 144  C     Complete filename with YR or _YEAR Line 167  C     Complete filename with YR or _YEAR
167           if (( first ) .or. ( changed )) then           if (( first ) .or. ( changed )) then
168              call exf_SwapFFields( gen0, gen1, mythid )              call exf_SwapFFields( gen0, gen1, mythid )
169                            
170              if (useExfYearlyFields) then              if (useExfYearlyFields.and.genperiod.gt.0) then
171  C     Complete filename with YR or _YEAR extension  C     Complete filename with YR or _YEAR extension
172                 il = ilnblnk( genfile )                 il = ilnblnk( genfile )
173                 if (twoDigitYear) then                 if (twoDigitYear) then
# Line 173  C     Complete filename with YR or _YEAR Line 196  C     Complete filename with YR or _YEAR
196              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
197       &           , gen1, count1, mythid       &           , gen1, count1, mythid
198       &           )       &           )
199  #endif  #endif /* USE_EXF_INTERPOLATION */
200    
201              if (exf_yftype .eq. 'RL') then              if (exf_yftype .eq. 'RL') then
202                 call exf_filter_rl( gen1, genmask, mythid )                 call exf_filter_rl( gen1, genmask, mythid )
# Line 205  c     Interpolate linearly onto the  tim Line 228  c     Interpolate linearly onto the  tim
228        end        end
229    
230    
231    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
232    C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
233    
234        subroutine exf_init_gen (        subroutine exf_init_gen (
235       &     genconst, genfld, gen0, gen1, geninitfile, mythid )       &     genfile, genperiod, exf_inscal_gen, genmask,
236         &     genconst, genfld, gen0, gen1,
237    #ifdef USE_EXF_INTERPOLATION
238         &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
239         &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
240    #endif
241         &     mythid )
242    
243    
244  c     ==================================================================  c     ==================================================================
245  c     SUBROUTINE exf_init_gen  c     SUBROUTINE exf_init_gen
# Line 235  c     == global variables == Line 267  c     == global variables ==
267    
268  c     == routine arguments ==  c     == routine arguments ==
269    
270        _RL genconst        _RL genperiod, exf_inscal_gen, genconst
271        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
272        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
273        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
274        character*(128) geninitfile        character*1 genmask
275          character*(128) genfile
276        integer mythid        integer mythid
277    
278    #ifdef USE_EXF_INTERPOLATION
279    c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
280    c                             corner of global input grid
281    c     gen_nlon, gen_nlat   :: input x-grid and y-grid size
282    c     gen_lon_inc          :: scalar x-grid increment
283    c     gen_lat_inc          :: vector y-grid increments
284    c     gen_xout, gen_yout   :: coordinates for output grid
285          _RL gen_lon0, gen_lon_inc
286          _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
287          INTEGER gen_nlon, gen_nlat
288          _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
289          _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
290          integer interp_method
291    #endif /* USE_EXF_INTERPOLATION */
292    
293  c     == local variables ==  c     == local variables ==
294    
295        integer bi, bj        integer bi, bj, i, j, count
       integer i, j  
296    
297  c     == end of interface ==  c     == end of interface ==
298    
# Line 261  c     == end of interface == Line 308  c     == end of interface ==
308          enddo          enddo
309        enddo        enddo
310    
311        if ( geninitfile .NE. ' ' ) then        if ( genfile .NE. ' ' .and. genperiod .eq. 0. ) then
312           call mdsreadfield( geninitfile, exf_iprec, exf_yftype,           count = 1
313       &        1, genfld, 1, mythid )  
314    #ifdef USE_EXF_INTERPOLATION
315             call exf_interp( genfile, exf_iprec
316         &        , genfld, count, gen_xout, gen_yout
317         &        , gen_lon0,gen_lon_inc
318         &        , gen_lat0,gen_lat_inc
319         &        , gen_nlon,gen_nlat,interp_method,mythid
320         &        )
321    #else
322             call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
323         &        , genfld, count, mythid
324         &        )
325    #endif /* USE_EXF_INTERPOLATION */
326    
327             if (exf_yftype .eq. 'RL') then
328                call exf_filter_rl( genfld, genmask, mythid )
329             else
330                call exf_filter_rs( genfld, genmask, mythid )
331             end if
332    
333    c     Loop over tiles.
334             do bj = mybylo(mythid),mybyhi(mythid)
335                do bi = mybxlo(mythid),mybxhi(mythid)
336                   do j = 1,sny
337                      do i = 1,snx
338    c     Interpolate linearly onto the  time.
339                         genfld(i,j,bi,bj) =
340         &                    exf_inscal_gen * genfld(i,j,bi,bj)
341                      enddo
342                   enddo
343                enddo
344             enddo
345    
346        endif        endif
347    
348        end        end
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22