/[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.9 by heimbach, Thu Feb 26 22:30:27 2004 UTC revision 1.13 by heimbach, Thu Mar 2 02:53:23 2006 UTC
# Line 1  Line 1 
1  #include "EXF_OPTIONS.h"  #include "EXF_OPTIONS.h"
2    
3        subroutine exf_set_gen(        subroutine exf_set_gen(
4       &     genfile, genstartdate, genperiod, exf_inscal_gen,       &     genfile, genstartdate, genperiod,
5         &     genstartdate1, genstartdate2,
6         &     exf_inscal_gen, genremove_intercept, genremove_slope,
7       &     genfld, gen0, gen1, genmask,       &     genfld, gen0, gen1, genmask,
8  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
9       &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,       &     gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
10       &     gen_nlon, gen_nlat, gen_xout, gen_yout,       &     gen_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
11  #endif  #endif
12       &     mycurrenttime, mycurrentiter, mythid )       &     mytime, myiter, mythid )
13    
14  c     ==================================================================  c     ==================================================================
15  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 33  c     == global variables == Line 35  c     == global variables ==
35    
36  #include "EEPARAMS.h"  #include "EEPARAMS.h"
37  #include "SIZE.h"  #include "SIZE.h"
38    #include "PARAMS.h"
39  #include "GRID.h"  #include "GRID.h"
40    
41  #include "exf_param.h"  #include "exf_param.h"
# Line 40  c     == global variables == Line 43  c     == global variables ==
43    
44  c     == routine arguments ==  c     == routine arguments ==
45    
46        _RL     genstartdate, genperiod        integer genstartdate1, genstartdate2
47        _RL     exf_inscal_gen        _RL genstartdate, genperiod
48        _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL exf_inscal_gen
49        _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genremove_intercept, genremove_slope
50        _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
51          _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
52          _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
53        character*1 genmask        character*1 genmask
54        character*(128) genfile        character*(128) genfile, genfile0, genfile1
55        _RL     mycurrenttime        _RL     mytime
56        integer mycurrentiter        integer myiter
57        integer mythid        integer mythid
58  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
59  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest  c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
# Line 62  c     gen_xout, gen_yout   :: coordinate Line 67  c     gen_xout, gen_yout   :: coordinate
67        INTEGER gen_nlon, gen_nlat        INTEGER gen_nlon, gen_nlat
68        _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)
69        _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)
70          integer interp_method
71  #endif  #endif
72    
73  c     == local variables ==  c     == local variables ==
74    
75        logical first, changed        logical first, changed
76        integer count0, count1        integer count0, count1
77          integer year0, year1
78        _RL     fac        _RL     fac
79    
80        integer bi, bj        integer bi, bj
81        integer i, j, interp_method        integer i, j, il
82    
83    c     == external ==
84    
85          integer  ilnblnk
86          external ilnblnk
87    
88  c     == end of interface ==  c     == end of interface ==
89    
90        if ( genfile .NE. ' ' ) then        if ( genfile .NE. ' ' ) then
91    
92    cph(
93    cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000
94    cph)
95  c     get record numbers and interpolation factor for gen  c     get record numbers and interpolation factor for gen
96           call exf_GetFFieldRec(           call exf_GetFFieldRec(
97       I        genstartdate, genperiod       I        genstartdate, genperiod
98         I        , genstartdate1, genstartdate2
99         I        , useExfYearlyFields
100       O        , fac, first, changed       O        , fac, first, changed
101       O        , count0, count1       O        , count0, count1, year0, year1
102       I        , mycurrenttime, mycurrentiter, mythid       I        , mytime, myiter, mythid
103       &        )       &        )
104    
105           if ( first ) then           if ( first ) then
106                if (useExfYearlyFields) then
107    C     Complete filename with YR or _YEAR extension
108                   il = ilnblnk( genfile )
109                   if (twoDigitYear) then
110                      if (year0.ge.2000) then
111                         write(genfile0(1:128),'(a,i2.2)')
112         &                    genfile(1:il),year0-2000
113                      else
114                         write(genfile0(1:128),'(a,i2.2)')
115         &                    genfile(1:il),year0-1900
116                      endif
117                   else
118                      write(genfile0(1:128),'(2a,i4.4)')
119         &                 genfile(1:il),'_',year0
120                   endif
121                else
122                   genfile0 = genfile
123                endif
124  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
125              interp_method = 2              call exf_interp( genfile0, exf_iprec
             call exf_interp( genfile, exf_iprec  
126       &           , gen1, count0, gen_xout, gen_yout       &           , gen1, count0, gen_xout, gen_yout
127       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
128       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
129       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
130       &           )       &           )
131  #else  #else
132              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1
133       &           , gen1, count0, mythid       &           , gen1, count0, mythid
134       &           )       &           )
135  #endif  #endif
# Line 110  c     get record numbers and interpolati Line 144  c     get record numbers and interpolati
144           if (( first ) .or. ( changed )) then           if (( first ) .or. ( changed )) then
145              call exf_SwapFFields( gen0, gen1, mythid )              call exf_SwapFFields( gen0, gen1, mythid )
146                            
147                if (useExfYearlyFields) then
148    C     Complete filename with YR or _YEAR extension
149                   il = ilnblnk( genfile )
150                   if (twoDigitYear) then
151                      if (year1.ge.2000) then
152                         write(genfile1(1:128),'(a,i2.2)')
153         &                    genfile(1:il),year1-2000
154                      else
155                         write(genfile1(1:128),'(a,i2.2)')
156         &                    genfile(1:il),year1-1900
157                      endif
158                   else
159                      write(genfile1(1:128),'(2a,i4.4)')
160         &                 genfile(1:il),'_',year1
161                   endif
162                else
163                   genfile1 = genfile
164                endif
165  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
166              interp_method = 2              call exf_interp( genfile1, exf_iprec
             call exf_interp( genfile, exf_iprec  
167       &           , gen1, count1, gen_xout, gen_yout       &           , gen1, count1, gen_xout, gen_yout
168       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
169       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
170       &           , gen_nlon,gen_nlat,interp_method,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
171       &           )       &           )
172  #else  #else
173              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
174       &           , gen1, count1, mythid       &           , gen1, count1, mythid
175       &           )       &           )
176  #endif  #endif
# Line 133  c     get record numbers and interpolati Line 184  c     get record numbers and interpolati
184    
185  c     Loop over tiles.  c     Loop over tiles.
186           do bj = mybylo(mythid),mybyhi(mythid)           do bj = mybylo(mythid),mybyhi(mythid)
187              do bi = mybxlo(mythid),mybxhi(mythid)            do bi = mybxlo(mythid),mybxhi(mythid)
188                 do j = 1,sny             do j = 1,sny
189                    do i = 1,snx              do i = 1,snx
190    c     Interpolate linearly onto the  time.
191  c     Interpolate linearly onto the current time.               genfld(i,j,bi,bj) = exf_inscal_gen * (
192         &                          fac * gen0(i,j,bi,bj) +
193                       genfld(i,j,bi,bj) = exf_inscal_gen * (       &              (exf_one - fac) * gen1(i,j,bi,bj) )
194       &                                fac * gen0(i,j,bi,bj) +               genfld(i,j,bi,bj) =
195       &                    (exf_one - fac) * gen1(i,j,bi,bj) )       &            genfld(i,j,bi,bj) -
196         &            exf_inscal_gen * ( genremove_intercept +
197         &            genremove_slope*(mytime-starttime) )
198                    enddo                    enddo
199                 enddo                 enddo
200              enddo              enddo
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22