/[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.9 - (hide annotations) (download)
Thu Feb 26 22:30:27 2004 UTC (20 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint52l_pre, checkpoint52n_post, checkpoint53d_post, checkpoint54a_pre, checkpoint55c_post, checkpoint54e_post, checkpoint54a_post, checkpoint53c_post, checkpoint55d_pre, checkpoint52l_post, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint54d_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint54, checkpoint54f_post, checkpoint53b_post, checkpoint53, checkpoint53g_post, hrcube5, checkpoint53f_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post
Changes since 1.8: +4 -4 lines
Need to extend array boundaries for initialisation

1 edhill 1.7 #include "EXF_OPTIONS.h"
2 heimbach 1.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 dimitri 1.8 _RL genstartdate, genperiod
44 heimbach 1.2 _RL exf_inscal_gen
45     _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
46     _RL gen0 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
47     _RL gen1 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
48     character*1 genmask
49     character*(128) genfile
50     _RL mycurrenttime
51     integer mycurrentiter
52     integer mythid
53 dimitri 1.3 #ifdef USE_EXF_INTERPOLATION
54 dimitri 1.4 c gen_lon_0 ,gen_lat_0 :: longitude and latitude of SouthWest
55     c corner of global input grid
56     c gen_nlon, gen_nlat :: input x-grid and y-grid size
57     c gen_lon_inc :: scalar x-grid increment
58     c gen_lat_inc :: vector y-grid increments
59     c gen_xout, gen_yout :: coordinates for output grid
60 dimitri 1.3 _RL gen_lon0, gen_lon_inc
61     _RL gen_lat0, gen_lat_inc(MAX_LAT_INC)
62     INTEGER gen_nlon, gen_nlat
63 dimitri 1.4 _RS gen_xout (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
64     _RS gen_yout (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
65 dimitri 1.3 #endif
66 heimbach 1.2
67     c == local variables ==
68    
69     logical first, changed
70     integer count0, count1
71     _RL fac
72    
73     integer bi, bj
74 dimitri 1.5 integer i, j, interp_method
75 heimbach 1.2
76     c == end of interface ==
77    
78     if ( genfile .NE. ' ' ) then
79    
80     c get record numbers and interpolation factor for gen
81     call exf_GetFFieldRec(
82     I genstartdate, genperiod
83     O , fac, first, changed
84     O , count0, count1
85     I , mycurrenttime, mycurrentiter, mythid
86     & )
87    
88     if ( first ) then
89 dimitri 1.3 #ifdef USE_EXF_INTERPOLATION
90 dimitri 1.5 interp_method = 2
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 dimitri 1.5 & , gen_nlon,gen_nlat,interp_method,mythid
96 dimitri 1.3 & )
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.6 interp_method = 2
115 dimitri 1.4 call exf_interp( genfile, exf_iprec
116     & , gen1, count1, gen_xout, gen_yout
117 dimitri 1.3 & , gen_lon0,gen_lon_inc
118     & , gen_lat0,gen_lat_inc
119 dimitri 1.5 & , gen_nlon,gen_nlat,interp_method,mythid
120 dimitri 1.3 & )
121     #else
122 heimbach 1.2 call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
123     & , gen1, count1, mythid
124     & )
125 dimitri 1.3 #endif
126 heimbach 1.2
127     if (exf_yftype .eq. 'RL') then
128     call exf_filter_rl( gen1, genmask, mythid )
129     else
130     call exf_filter_rs( gen1, genmask, mythid )
131     end if
132     endif
133    
134     c Loop over tiles.
135     do bj = mybylo(mythid),mybyhi(mythid)
136     do bi = mybxlo(mythid),mybxhi(mythid)
137     do j = 1,sny
138     do i = 1,snx
139    
140     c Interpolate linearly onto the current time.
141    
142     genfld(i,j,bi,bj) = exf_inscal_gen * (
143     & fac * gen0(i,j,bi,bj) +
144     & (exf_one - fac) * gen1(i,j,bi,bj) )
145    
146     enddo
147     enddo
148     enddo
149     enddo
150    
151     endif
152    
153     end
154    
155    
156    
157     subroutine exf_init_gen (
158     & genconst, genfld, gen0, gen1, mythid )
159    
160     c ==================================================================
161     c SUBROUTINE exf_init_gen
162     c ==================================================================
163     c
164     c o
165     c
166     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
167     c changed: heimbach@mit.edu 10-Jan-2002
168     c heimbach@mit.edu: totally re-organized exf_set_...
169     c replaced all routines by one generic routine
170     c
171     c ==================================================================
172     c SUBROUTINE exf_init_gen
173     c ==================================================================
174    
175     implicit none
176    
177     c == global variables ==
178    
179     #include "EEPARAMS.h"
180     #include "SIZE.h"
181    
182     #include "exf_param.h"
183    
184     c == routine arguments ==
185    
186     _RL genconst
187     _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
188     _RL gen0 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
189     _RL gen1 (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
190     integer mythid
191    
192     c == local variables ==
193    
194     integer bi, bj
195     integer i, j
196    
197     c == end of interface ==
198    
199     do bj = mybylo(mythid), mybyhi(mythid)
200     do bi = mybxlo(mythid), mybxhi(mythid)
201 heimbach 1.9 do j = 1-oly, sny+oly
202     do i = 1-olx, snx+olx
203 heimbach 1.2 genfld(i,j,bi,bj) = genconst
204 heimbach 1.9 gen0(i,j,bi,bj) = genconst
205     gen1(i,j,bi,bj) = genconst
206 heimbach 1.2 enddo
207     enddo
208     enddo
209     enddo
210    
211     end

  ViewVC Help
Powered by ViewVC 1.1.22