/[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.11 by dimitri, Mon Dec 20 23:32:52 2004 UTC revision 1.14 by heimbach, Thu Oct 12 21:34:59 2006 UTC
# Line 3  Line 3 
3        subroutine exf_set_gen(        subroutine exf_set_gen(
4       &     genfile, genstartdate, genperiod,       &     genfile, genstartdate, genperiod,
5       &     genstartdate1, genstartdate2,       &     genstartdate1, genstartdate2,
6       &     exf_inscal_gen,       &     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, interp_method,       &     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 35  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 43  c     == global variables == Line 44  c     == global variables ==
44  c     == routine arguments ==  c     == routine arguments ==
45    
46        integer genstartdate1, genstartdate2        integer genstartdate1, genstartdate2
47        _RL     genstartdate, genperiod        _RL genstartdate, genperiod
48        _RL     exf_inscal_gen        _RL exf_inscal_gen
49        _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genremove_intercept, genremove_slope
50        _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
51        _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _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, genfile0, genfile1        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 97  c     get record numbers and interpolati Line 99  c     get record numbers and interpolati
99       I        , useExfYearlyFields       I        , useExfYearlyFields
100       O        , fac, first, changed       O        , fac, first, changed
101       O        , count0, count1, year0, year1       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              if (useExfYearlyFields) then
107    C     Complete filename with YR or _YEAR extension
108                 il = ilnblnk( genfile )                 il = ilnblnk( genfile )
109                 write(genfile0(1:128),'(2a,i4.4)')                 if (twoDigitYear) then
110       &              genfile(1:il),'_',year0                    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              else
122                 genfile0 = genfile                 genfile0 = genfile
123              endif              endif
# Line 132  c     get record numbers and interpolati Line 145  c     get record numbers and interpolati
145              call exf_SwapFFields( gen0, gen1, mythid )              call exf_SwapFFields( gen0, gen1, mythid )
146                            
147              if (useExfYearlyFields) then              if (useExfYearlyFields) then
148    C     Complete filename with YR or _YEAR extension
149                 il = ilnblnk( genfile )                 il = ilnblnk( genfile )
150                 write(genfile1(1:128),'(2a,i4.4)')                 if (twoDigitYear) then
151       &              genfile(1:il),'_',year1                    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              else
163                 genfile1 = genfile                 genfile1 = genfile
164              endif              endif
# Line 160  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
# Line 182  c     Interpolate linearly onto the curr Line 207  c     Interpolate linearly onto the curr
207    
208    
209        subroutine exf_init_gen (        subroutine exf_init_gen (
210       &     genconst, genfld, gen0, gen1, mythid )       &     genconst, genfld, gen0, gen1, geninitfile, mythid )
211    
212  c     ==================================================================  c     ==================================================================
213  c     SUBROUTINE exf_init_gen  c     SUBROUTINE exf_init_gen
# Line 214  c     == routine arguments == Line 239  c     == routine arguments ==
239        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
240        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
241        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
242          character*(128) geninitfile
243        integer mythid        integer mythid
244    
245  c     == local variables ==  c     == local variables ==
# Line 235  c     == end of interface == Line 261  c     == end of interface ==
261          enddo          enddo
262        enddo        enddo
263    
264          if ( geninitfile .NE. ' ' ) then
265             call mdsreadfield( geninitfile, exf_iprec, exf_yftype,
266         &        1, genfld, 1, mythid )
267          endif
268    
269        end        end
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22