/[MITgcm]/MITgcm/pkg/exf/exf_set_gen.F
ViewVC logotype

Annotation of /MITgcm/pkg/exf/exf_set_gen.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.4 - (hide annotations) (download)
Thu Aug 7 02:31:29 2003 UTC (20 years, 10 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint51f_pre
Changes since 1.3: +16 -6 lines 
o Added on-the-fly spatial interpolation capability
    "USE_EXF_INTERPOLATION" to pkg/exf.
  - This is a temporary Cartesian-grid hack until
    the super-duper ESMF coupler becomes available.
  - See verification/global_with_exf/README for usage example.
  - Removed obsolete EXFwindOnBgrid and SEAICEwindOnCgrid
    flags and modified pkg/seaice accordingly.
o Bug fix to pkg/ptracers, pkg/generic_advdiff/gad_calc_rhs.F,
    and pkg/kpp/kpp_transport_ptr.F for dealing with tracer
    non-local transport term.
1 heimbach 1.2 #include "EXF_CPPOPTIONS.h"
2    
3     subroutine exf_set_gen(
4     & genfile, genstartdate, genperiod, exf_inscal_gen,
5 dimitri 1.3 & genfld, gen0, gen1, genmask,
6     #ifdef USE_EXF_INTERPOLATION
7     & gen_lon0, gen_lon_inc, gen_lat0, gen_lat_inc,
8 dimitri 1.4 & gen_nlon, gen_nlat, gen_xout, gen_yout,
9 dimitri 1.3 #endif
10 heimbach 1.2 & mycurrenttime, mycurrentiter, mythid )
11    
12     c ==================================================================
13     c SUBROUTINE exf_set_gen
14     c ==================================================================
15     c
16     c o set external forcing gen
17     c
18     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
19     c changed: heimbach@mit.edu 10-Jan-2002
20 dimitri 1.4 c 20-Dec-2002: mods for pkg/seaice, menemenlis@jpl.nasa.gov
21 heimbach 1.2 c heimbach@mit.edu: totally re-organized exf_set_...
22     c replaced all routines by one generic routine
23 dimitri 1.4 c 5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary
24     c input grid capability
25 heimbach 1.2
26     c ==================================================================
27     c SUBROUTINE exf_set_gen
28     c ==================================================================
29    
30     implicit none
31    
32     c == global variables ==
33    
34     #include "EEPARAMS.h"
35     #include "SIZE.h"
36     #include "GRID.h"
37    
38     #include "exf_param.h"
39     #include "exf_constants.h"
40    
41     c == routine arguments ==
42    
43     integer genstartdate(4)
44     _RL genperiod
45     _RL exf_inscal_gen
46     _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
47     _RL gen0 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
48     _RL gen1 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
49     character*1 genmask
50     character*(128) genfile
51     _RL mycurrenttime
52     integer mycurrentiter
53     integer mythid
54 dimitri 1.3 #ifdef USE_EXF_INTERPOLATION
55 dimitri 1.4 c gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
56     c corner of global input grid
57     c gen_nlon, gen_nlat :: input x-grid and y-grid size
58     c gen_lon_inc :: scalar x-grid increment
59     c gen_lat_inc :: vector y-grid increments
60     c gen_xout, gen_yout :: coordinates for output grid
61 dimitri 1.3 _RL gen_lon0, gen_lon_inc
62     _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
63     INTEGER gen_nlon, gen_nlat
64 dimitri 1.4 _RS gen_xout (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
65     _RS gen_yout (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
66 dimitri 1.3 #endif
67 heimbach 1.2
68     c == local variables ==
69    
70     logical first, changed
71     integer count0, count1
72     _RL fac
73    
74     integer bi, bj
75     integer i, j
76    
77     c == end of interface ==
78    
79     if ( genfile .NE. ' ' ) then
80    
81     c get record numbers and interpolation factor for gen
82     call exf_GetFFieldRec(
83     I genstartdate, genperiod
84     O , fac, first, changed
85     O , count0, count1
86     I , mycurrenttime, mycurrentiter, mythid
87     & )
88    
89     if ( first ) then
90 dimitri 1.3 #ifdef USE_EXF_INTERPOLATION
91 dimitri 1.4 call exf_interp( genfile, exf_iprec
92     & , gen1, count0, gen_xout, gen_yout
93 dimitri 1.3 & , gen_lon0,gen_lon_inc
94     & , gen_lat0,gen_lat_inc
95     & , gen_nlon,gen_nlat,mythid
96     & )
97     #else
98 heimbach 1.2 call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
99     & , gen1, count0, mythid
100     & )
101 dimitri 1.3 #endif
102 heimbach 1.2
103     if (exf_yftype .eq. 'RL') then
104     call exf_filter_rl( gen1, genmask, mythid )
105     else
106     call exf_filter_rs( gen1, genmask, mythid )
107     end if
108     endif
109    
110     if (( first ) .or. ( changed )) then
111     call exf_SwapFFields( gen0, gen1, mythid )
112    
113 dimitri 1.3 #ifdef USE_EXF_INTERPOLATION
114 dimitri 1.4 call exf_interp( genfile, exf_iprec
115     & , gen1, count1, gen_xout, gen_yout
116 dimitri 1.3 & , gen_lon0,gen_lon_inc
117     & , gen_lat0,gen_lat_inc
118     & , gen_nlon,gen_nlat,mythid
119     & )
120     #else
121 heimbach 1.2 call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
122     & , gen1, count1, mythid
123     & )
124 dimitri 1.3 #endif
125 heimbach 1.2
126     if (exf_yftype .eq. 'RL') then
127     call exf_filter_rl( gen1, genmask, mythid )
128     else
129     call exf_filter_rs( gen1, genmask, mythid )
130     end if
131     endif
132    
133     c Loop over tiles.
134     do bj = mybylo(mythid),mybyhi(mythid)
135     do bi = mybxlo(mythid),mybxhi(mythid)
136     do j = 1,sny
137     do i = 1,snx
138    
139     c Interpolate linearly onto the current time.
140    
141     genfld(i,j,bi,bj) = exf_inscal_gen * (
142     & fac * gen0(i,j,bi,bj) +
143     & (exf_one - fac) * gen1(i,j,bi,bj) )
144    
145     enddo
146     enddo
147     enddo
148     enddo
149    
150     endif
151    
152     end
153    
154    
155    
156     subroutine exf_init_gen (
157     & genconst, genfld, gen0, gen1, mythid )
158    
159     c ==================================================================
160     c SUBROUTINE exf_init_gen
161     c ==================================================================
162     c
163     c o
164     c
165     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
166     c changed: heimbach@mit.edu 10-Jan-2002
167     c heimbach@mit.edu: totally re-organized exf_set_...
168     c replaced all routines by one generic routine
169     c
170     c ==================================================================
171     c SUBROUTINE exf_init_gen
172     c ==================================================================
173    
174     implicit none
175    
176     c == global variables ==
177    
178     #include "EEPARAMS.h"
179     #include "SIZE.h"
180    
181     #include "exf_param.h"
182    
183     c == routine arguments ==
184    
185     _RL genconst
186     _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
187     _RL gen0 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
188     _RL gen1 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
189     integer mythid
190    
191     c == local variables ==
192    
193     integer bi, bj
194     integer i, j
195    
196     c == end of interface ==
197    
198     do bj = mybylo(mythid), mybyhi(mythid)
199     do bi = mybxlo(mythid), mybxhi(mythid)
200     do j = 1, sny
201     do i = 1, snx
202     genfld(i,j,bi,bj) = genconst
203     gen0(i,j,bi,bj) = 0. _d 0
204     gen1(i,j,bi,bj) = 0. _d 0
205     enddo
206     enddo
207     enddo
208     enddo
209    
210     end
  ViewVC Help
Powered by ViewVC 1.1.22