/[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.3 by dimitri, Mon Aug 4 22:53:42 2003 UTC revision 1.11 by dimitri, Mon Dec 20 23:32:52 2004 UTC
# Line 1  Line 1 
1  #include "EXF_CPPOPTIONS.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,
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_nlon, gen_nlat, gen_xout, gen_yout, interp_method,
11  #endif  #endif
12       &     mycurrenttime, mycurrentiter, mythid )       &     mycurrenttime, mycurrentiter, mythid )
13    
# Line 17  c     o set external forcing gen Line 19  c     o set external forcing gen
19  c  c
20  c     started: Ralf.Giering@FastOpt.de 25-Mai-2000  c     started: Ralf.Giering@FastOpt.de 25-Mai-2000
21  c     changed: heimbach@mit.edu 10-Jan-2002  c     changed: heimbach@mit.edu 10-Jan-2002
22  c              mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002  c              20-Dec-2002: mods for pkg/seaice, menemenlis@jpl.nasa.gov
23  c              heimbach@mit.edu: totally re-organized exf_set_...  c              heimbach@mit.edu: totally re-organized exf_set_...
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
26    c                          input grid capability
27    
28  c     ==================================================================  c     ==================================================================
29  c     SUBROUTINE exf_set_gen  c     SUBROUTINE exf_set_gen
# Line 38  c     == global variables == Line 42  c     == global variables ==
42    
43  c     == routine arguments ==  c     == routine arguments ==
44    
45        integer genstartdate(4)        integer genstartdate1, genstartdate2
46        _RL     genperiod        _RL     genstartdate, genperiod
47        _RL     exf_inscal_gen        _RL     exf_inscal_gen
48        _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
49        _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
50        _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
51        character*1 genmask        character*1 genmask
52        character*(128) genfile        character*(128) genfile, genfile0, genfile1
53        _RL     mycurrenttime        _RL     mycurrenttime
54        integer mycurrentiter        integer mycurrentiter
55        integer mythid        integer mythid
56  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
57    c     gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
58    c                             corner of global input grid
59    c     gen_nlon, gen_nlat   :: input x-grid and y-grid size
60    c     gen_lon_inc          :: scalar x-grid increment
61    c     gen_lat_inc          :: vector y-grid increments
62    c     gen_xout, gen_yout   :: coordinates for output grid
63        _RL gen_lon0, gen_lon_inc        _RL gen_lon0, gen_lon_inc
64        _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)        _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
65        INTEGER gen_nlon, gen_nlat        INTEGER gen_nlon, gen_nlat
66          _RS gen_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
67          _RS gen_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
68          integer interp_method
69  #endif  #endif
70    
71  c     == local variables ==  c     == local variables ==
72    
73        logical first, changed        logical first, changed
74        integer count0, count1        integer count0, count1
75          integer year0, year1
76        _RL     fac        _RL     fac
77    
78        integer bi, bj        integer bi, bj
79        integer i, j        integer i, j, il
80    
81    c     == external ==
82    
83          integer  ilnblnk
84          external ilnblnk
85    
86  c     == end of interface ==  c     == end of interface ==
87    
88        if ( genfile .NE. ' ' ) then        if ( genfile .NE. ' ' ) then
89    
90    cph(
91    cph-exf-print         if (genfile .EQ. hfluxfile)  year0 = 3000
92    cph)
93  c     get record numbers and interpolation factor for gen  c     get record numbers and interpolation factor for gen
94           call exf_GetFFieldRec(           call exf_GetFFieldRec(
95       I        genstartdate, genperiod       I        genstartdate, genperiod
96         I        , genstartdate1, genstartdate2
97         I        , useExfYearlyFields
98       O        , fac, first, changed       O        , fac, first, changed
99       O        , count0, count1       O        , count0, count1, year0, year1
100       I        , mycurrenttime, mycurrentiter, mythid       I        , mycurrenttime, mycurrentiter, mythid
101       &        )       &        )
102    
103           if ( first ) then           if ( first ) then
104                if (useExfYearlyFields) then
105                   il = ilnblnk( genfile )
106                   write(genfile0(1:128),'(2a,i4.4)')
107         &              genfile(1:il),'_',year0
108                else
109                   genfile0 = genfile
110                endif
111  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
112              call new_interp( genfile, exf_iprec              call exf_interp( genfile0, exf_iprec
113       &           , gen1, count0, xC, yC       &           , gen1, count0, gen_xout, gen_yout
114       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
115       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
116       &           , gen_nlon,gen_nlat,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
117       &           )       &           )
118  #else  #else
119              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile0, exf_iprec, exf_yftype, 1
120       &           , gen1, count0, mythid       &           , gen1, count0, mythid
121       &           )       &           )
122  #endif  #endif
# Line 100  c     get record numbers and interpolati Line 131  c     get record numbers and interpolati
131           if (( first ) .or. ( changed )) then           if (( first ) .or. ( changed )) then
132              call exf_SwapFFields( gen0, gen1, mythid )              call exf_SwapFFields( gen0, gen1, mythid )
133                            
134                if (useExfYearlyFields) then
135                   il = ilnblnk( genfile )
136                   write(genfile1(1:128),'(2a,i4.4)')
137         &              genfile(1:il),'_',year1
138                else
139                   genfile1 = genfile
140                endif
141  #ifdef USE_EXF_INTERPOLATION  #ifdef USE_EXF_INTERPOLATION
142              call new_interp( genfile, exf_iprec              call exf_interp( genfile1, exf_iprec
143       &           , gen1, count1, xC, yC       &           , gen1, count1, gen_xout, gen_yout
144       &           , gen_lon0,gen_lon_inc       &           , gen_lon0,gen_lon_inc
145       &           , gen_lat0,gen_lat_inc       &           , gen_lat0,gen_lat_inc
146       &           , gen_nlon,gen_nlat,mythid       &           , gen_nlon,gen_nlat,interp_method,mythid
147       &           )       &           )
148  #else  #else
149              call mdsreadfield( genfile, exf_iprec, exf_yftype, 1              call mdsreadfield( genfile1, exf_iprec, exf_yftype, 1
150       &           , gen1, count1, mythid       &           , gen1, count1, mythid
151       &           )       &           )
152  #endif  #endif
# Line 187  c     == end of interface == Line 225  c     == end of interface ==
225    
226        do bj = mybylo(mythid), mybyhi(mythid)        do bj = mybylo(mythid), mybyhi(mythid)
227          do bi = mybxlo(mythid), mybxhi(mythid)          do bi = mybxlo(mythid), mybxhi(mythid)
228            do j = 1, sny            do j = 1-oly, sny+oly
229              do i = 1, snx              do i = 1-olx, snx+olx
230                genfld(i,j,bi,bj)  = genconst                genfld(i,j,bi,bj)  = genconst
231                gen0(i,j,bi,bj)    = 0. _d 0                gen0(i,j,bi,bj)    = genconst
232                gen1(i,j,bi,bj)    = 0. _d 0                gen1(i,j,bi,bj)    = genconst
233              enddo              enddo
234            enddo            enddo
235          enddo          enddo
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22