1 | subroutine ballon (iam,dtphys,rjour,rsec,plat,plon, |
---|
2 | i temp, p, u, v, geop) |
---|
3 | |
---|
4 | use dimphy |
---|
5 | implicit none |
---|
6 | |
---|
7 | c====================================================================== |
---|
8 | c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201 |
---|
9 | c Object: Compute balloon trajectories. |
---|
10 | C No outputs, every quantities are written on the iam+ Files. |
---|
11 | c |
---|
12 | c Called by physiq.F if flag ballons activated: |
---|
13 | c |
---|
14 | c integer ballons |
---|
15 | c (...) |
---|
16 | c ballons = 1 ! (in initialisations) |
---|
17 | c (...) |
---|
18 | C OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES |
---|
19 | C DES BALLONS |
---|
20 | c if (ballons.eq.1) then |
---|
21 | c open(30,file='ballons-lat.out',form='formatted') |
---|
22 | c open(31,file='ballons-lon.out',form='formatted') |
---|
23 | c open(32,file='ballons-u.out',form='formatted') |
---|
24 | c open(33,file='ballons-v.out',form='formatted') |
---|
25 | c open(34,file='ballons-alt.out',form='formatted') |
---|
26 | c write(*,*)'Ouverture des ballons*.out' |
---|
27 | c endif !ballons |
---|
28 | c (...) |
---|
29 | C CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond, |
---|
30 | CC C t,pplay,u,v,pphi) ! alt above surface (smoothed for GCM) |
---|
31 | C C t,pplay,u,v,zphi) ! alt above planet average radius |
---|
32 | c (...) |
---|
33 | C FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES |
---|
34 | C DES BALLONS |
---|
35 | c if (ballons.eq.1) then |
---|
36 | c write(*,*)'Fermeture des ballons*.out' |
---|
37 | c close(30) |
---|
38 | c close(31) |
---|
39 | c close(32) |
---|
40 | c close(33) |
---|
41 | c close(34) |
---|
42 | c endif !ballons |
---|
43 | c |
---|
44 | C====================================================================== |
---|
45 | c Explicit Arguments: |
---|
46 | c ================== |
---|
47 | c iam-----input-I-File number where latitudes are written |
---|
48 | c It is a formatted file that has been opened |
---|
49 | c in physiq.F |
---|
50 | c other files: iam+1=longitudes |
---|
51 | c iam+2=zonal speeds |
---|
52 | c iam+3=meridional speeds |
---|
53 | c iam+4=altitudes |
---|
54 | c dtphys--input-R-pas de temps physique |
---|
55 | c rjour---input-R-Jour compte depuis le debut de la simu (run.def) |
---|
56 | c rsec----input-R-Seconde de la journee |
---|
57 | c plat ---input-R-Latitude en degres |
---|
58 | c plon ---input-R-Longitude en degres |
---|
59 | c temp----input-R-Temperature (K) at model levels |
---|
60 | c p-------input-R-Pressure (Pa) at model levels |
---|
61 | c u-------input-R-Horizontal wind (m/s) |
---|
62 | c v-------input-R-Meridional wind (m/s) |
---|
63 | c geop----input-R-Geopotential !! above surface OR average radius |
---|
64 | c |
---|
65 | c |
---|
66 | c Implicit Arguments: |
---|
67 | c =================== |
---|
68 | c |
---|
69 | c iim--common-I: Number of longitude intervals |
---|
70 | c jjm--common-I: Number of latitude intervals |
---|
71 | c klon-common-I: Number of points seen by the physics |
---|
72 | c iim*(jjm-1)+2 for instance |
---|
73 | c klev-common-I: Number of vertical layers |
---|
74 | c RPI,RKBOL--common-R: Pi, KBoltzman |
---|
75 | c RDAY,RA,RG-common-R: day length in s, planet radius, gravity |
---|
76 | c====================================================================== |
---|
77 | c Local Variables: |
---|
78 | c ================ |
---|
79 | c |
---|
80 | c nb ---I: number of balloons (parameter) |
---|
81 | c phib ---R: Latitude of balloon in radians |
---|
82 | c lamb ---R: Longitude of balloon in radians |
---|
83 | c lognb ---R: log(density) of balloon |
---|
84 | c ub ---R: zonal speed of balloon |
---|
85 | c vb ---R: meridional speed of balloon |
---|
86 | c altb ---R: altitude of balloon |
---|
87 | c zlat ---R: Latitude in radians |
---|
88 | c zlon ---R: Longitude in radians |
---|
89 | c logn ---R: log(density) |
---|
90 | c alt ---R: altitude !! above surface OR average radius |
---|
91 | c ull ---R: zonal wind for one balloon on the lognb surface |
---|
92 | c vll ---R: meridional wind for one balloon on the lognb surface |
---|
93 | c aal ---R: altitude for one balloon on the lognb surface |
---|
94 | c====================================================================== |
---|
95 | |
---|
96 | #include "dimensions.h" |
---|
97 | #include "YOMCST.h" |
---|
98 | c |
---|
99 | c ARGUMENTS |
---|
100 | c |
---|
101 | INTEGER iam |
---|
102 | REAL dtphys,rjour,rsec,plat(klon),plon(klon) |
---|
103 | REAL temp(klon,klev),p(klon,klev) |
---|
104 | REAL u(klon,klev),v(klon,klev),geop(klon,klev) |
---|
105 | c |
---|
106 | c Variables locales: |
---|
107 | c |
---|
108 | INTEGER i,j,k,l,nb,n |
---|
109 | parameter (nb=20) !! Adjust the format on line 100 !! |
---|
110 | INTEGER jj,ii,ll |
---|
111 | |
---|
112 | REAL zlon(iim+1),zlat(jjm+1) |
---|
113 | save zlon,zlat |
---|
114 | |
---|
115 | REAL time |
---|
116 | REAL logn(klon,klev),ull(klon),vll(klon) |
---|
117 | REAL alt(klon,klev),aal(klon) |
---|
118 | real ub(nb),vb(nb),phib(nb),lamb(nb),lognb(nb),altb(nb) |
---|
119 | save phib,lamb,lognb |
---|
120 | |
---|
121 | REAL factalt |
---|
122 | |
---|
123 | c RungeKutta order - If not RK, Nrk=1 |
---|
124 | integer Nrk,irk |
---|
125 | parameter (Nrk=1) |
---|
126 | real dtrk |
---|
127 | |
---|
128 | logical first |
---|
129 | save first |
---|
130 | data first/.true./ |
---|
131 | |
---|
132 | time = rjour*RDAY+rsec |
---|
133 | logn(:,:) = log10(p(:,:)/(RKBOL*temp(:,:))) |
---|
134 | alt(:,:) = geop(:,:)/RG |
---|
135 | |
---|
136 | c--------------------------------------------- |
---|
137 | C INITIALIZATIONS |
---|
138 | c--------------------------------------------- |
---|
139 | if (first) then |
---|
140 | |
---|
141 | print*,"BALLOONS ACTIVATED" |
---|
142 | |
---|
143 | C Latitudes: |
---|
144 | zlat(1)=plat(1)*RPI/180. |
---|
145 | do j = 2,jjm |
---|
146 | k=(j-2)*iim+2 |
---|
147 | zlat(j)=plat(k)*RPI/180. |
---|
148 | enddo |
---|
149 | zlat(jjm+1)=plat(klon)*RPI/180. |
---|
150 | |
---|
151 | C Longitudes: |
---|
152 | do i = 1,iim |
---|
153 | k=i+1 |
---|
154 | zlon(i)=plon(k)*RPI/180. |
---|
155 | enddo |
---|
156 | zlon(iim+1)=zlon(1)+2.*RPI |
---|
157 | |
---|
158 | c verif init lat de 90 à -90, lon de -180 à 180 |
---|
159 | c print*,"Latitudes:",zlat*180./RPI |
---|
160 | c print*,"Longitudes:",zlon*180./RPI |
---|
161 | c stop |
---|
162 | |
---|
163 | c initial positions of balloons (in degrees for lat/lon) |
---|
164 | do j=1,5 |
---|
165 | do i=1,4 |
---|
166 | k=(j-1)*4+i |
---|
167 | phib(k)= (j-1)*20.*RPI/180. |
---|
168 | lamb(k)= (i-3)*90.*RPI/180. ! de -180 à 90 |
---|
169 | c A REVOIR POUR TITAN |
---|
170 | lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model |
---|
171 | enddo |
---|
172 | enddo |
---|
173 | print*,"Balloon density (m^-3)=",10.**(lognb(1)) |
---|
174 | |
---|
175 | c print*,"log(density) profile:" |
---|
176 | c do l=1,klev |
---|
177 | c print*,logn(klon/2,l) |
---|
178 | c enddo |
---|
179 | c stop !verif init |
---|
180 | |
---|
181 | first=.false. |
---|
182 | endif ! first |
---|
183 | c--------------------------------------------- |
---|
184 | |
---|
185 | c------------------------------------------------- |
---|
186 | c loop over the balloons |
---|
187 | c------------------------------------------------- |
---|
188 | do n=1,nb |
---|
189 | |
---|
190 | c Interpolation in altitudes |
---|
191 | c------------------------------------------------- |
---|
192 | do k=1,klon |
---|
193 | ll=1 ! en bas |
---|
194 | do l=2,klev |
---|
195 | if (lognb(n).lt.logn(k,l)) ll=l |
---|
196 | enddo |
---|
197 | factalt= (lognb(n)-logn(k,ll))/(logn(k,ll+1)-logn(k,ll)) |
---|
198 | ull(k) = u(k,ll+1)*factalt + u(k,ll)*(1-factalt) |
---|
199 | vll(k) = v(k,ll+1)*factalt + v(k,ll)*(1-factalt) |
---|
200 | aal(k) = alt(k,ll+1)*factalt + alt(k,ll)*(1-factalt) |
---|
201 | enddo |
---|
202 | |
---|
203 | c Interpolation in latitudes and longitudes |
---|
204 | c------------------------------------------- |
---|
205 | call wind_interp(ull,vll,aal,zlat,zlon, |
---|
206 | . phib(n),lamb(n),ub(n),vb(n),altb(n)) |
---|
207 | |
---|
208 | enddo ! over balloons |
---|
209 | c------------------------------------------------- |
---|
210 | |
---|
211 | c------------------------------------------------- |
---|
212 | c Output of positions and speed at time |
---|
213 | c------------------------------------------------- |
---|
214 | |
---|
215 | write(iam, 100) time, phib*180./RPI |
---|
216 | write(iam+1,100) time, lamb*180./RPI |
---|
217 | write(iam+2,100) time, ub |
---|
218 | write(iam+3,100) time, vb |
---|
219 | write(iam+4,100) time, altb |
---|
220 | c stop !verif init |
---|
221 | |
---|
222 | c !!!!!!!!!!!!!!!! nb !!!!!!!!!!!!!!!!! |
---|
223 | 100 format(E14.7,20(1x,E12.5)) |
---|
224 | |
---|
225 | c------------------------------------------------- |
---|
226 | c Implementation: positions at time+dt |
---|
227 | c RK order Nrk |
---|
228 | c------------------------------------------------- |
---|
229 | |
---|
230 | dtrk = dtphys/Nrk |
---|
231 | time=time+dtrk |
---|
232 | |
---|
233 | do n=1,nb |
---|
234 | call pos_implem(phib(n),lamb(n),ub(n),vb(n),dtrk) |
---|
235 | enddo |
---|
236 | |
---|
237 | if (Nrk.gt.1) then |
---|
238 | do irk=2,Nrk |
---|
239 | do n=1,nb |
---|
240 | time=time+dtrk |
---|
241 | call wind_interp(ull,vll,aal,zlat,zlon, |
---|
242 | . phib(n),lamb(n),ub(n),vb(n),altb(n)) |
---|
243 | call pos_implem(phib(n),lamb(n),ub(n),vb(n),dtrk) |
---|
244 | enddo |
---|
245 | enddo |
---|
246 | endif |
---|
247 | |
---|
248 | end |
---|
249 | |
---|
250 | c====================================================================== |
---|
251 | c====================================================================== |
---|
252 | c====================================================================== |
---|
253 | |
---|
254 | subroutine wind_interp(map_u,map_v,map_a,latit,longit, |
---|
255 | . phi,lam,ubal,vbal,abal) |
---|
256 | |
---|
257 | use dimphy |
---|
258 | implicit none |
---|
259 | |
---|
260 | c====================================================================== |
---|
261 | c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201 |
---|
262 | c Object: interpolate balloon speed from its position. |
---|
263 | C====================================================================== |
---|
264 | c Explicit Arguments: |
---|
265 | c ================== |
---|
266 | c map_u ---R: zonal wind on the lognb surface |
---|
267 | c map_v ---R: meridional wind on the lognb surface |
---|
268 | c map_a ---R: altitude on the lognb surface |
---|
269 | c latit ---R: Latitude in radians |
---|
270 | c longit---R: Longitude in radians |
---|
271 | c phi ---R: Latitude of balloon in radians |
---|
272 | c lam ---R: Longitude of balloon in radians |
---|
273 | c ubal ---R: zonal speed of balloon |
---|
274 | c vbal ---R: meridional speed of balloon |
---|
275 | c abal ---R: altitude of balloon |
---|
276 | c====================================================================== |
---|
277 | c Local Variables: |
---|
278 | c ================ |
---|
279 | c |
---|
280 | c ujj ---R: zonal wind interpolated in latitude |
---|
281 | c vjj ---R: meridional wind interpolated in latitude |
---|
282 | c ajj ---R: altitude interpolated in latitude |
---|
283 | c====================================================================== |
---|
284 | |
---|
285 | #include "dimensions.h" |
---|
286 | #include "YOMCST.h" |
---|
287 | c |
---|
288 | c ARGUMENTS |
---|
289 | c |
---|
290 | real map_u(klon),map_v(klon),map_a(klon) |
---|
291 | real latit(jjm+1),longit(iim) |
---|
292 | real phi,lam,ubal,vbal,abal |
---|
293 | c |
---|
294 | c Variables locales: |
---|
295 | c |
---|
296 | INTEGER i,j,k |
---|
297 | INTEGER jj,ii |
---|
298 | REAL ujj(iim+1),vjj(iim+1),ajj(iim+1) |
---|
299 | REAL factlat,factlon |
---|
300 | |
---|
301 | c Interpolation in latitudes |
---|
302 | c------------------------------------------------- |
---|
303 | jj=1 ! POLE NORD |
---|
304 | do j=2,jjm |
---|
305 | if (phi.lt.latit(j)) jj=j |
---|
306 | enddo |
---|
307 | factlat = (phi-latit(jj))/(latit(jj+1)-latit(jj)) |
---|
308 | |
---|
309 | c pole nord |
---|
310 | if (jj.eq.1) then |
---|
311 | do i=1,iim |
---|
312 | ujj(i) = map_u(i+1)*factlat + map_u(1)*(1-factlat) |
---|
313 | vjj(i) = map_v(i+1)*factlat + map_v(1)*(1-factlat) |
---|
314 | ajj(i) = map_a(i+1)*factlat + map_a(1)*(1-factlat) |
---|
315 | enddo |
---|
316 | c pole sud |
---|
317 | elseif (jj.eq.jjm) then |
---|
318 | do i=1,iim |
---|
319 | k = (jj-2)*iim+1+i |
---|
320 | ujj(i) = map_u(klon)*factlat + map_u(k)*(1-factlat) |
---|
321 | vjj(i) = map_v(klon)*factlat + map_v(k)*(1-factlat) |
---|
322 | ajj(i) = map_a(klon)*factlat + map_a(k)*(1-factlat) |
---|
323 | enddo |
---|
324 | c autres latitudes |
---|
325 | else |
---|
326 | do i=1,iim |
---|
327 | k = (jj-2)*iim+1+i |
---|
328 | ujj(i) = map_u(k+iim)*factlat + map_u(k)*(1-factlat) |
---|
329 | vjj(i) = map_v(k+iim)*factlat + map_v(k)*(1-factlat) |
---|
330 | ajj(i) = map_a(k+iim)*factlat + map_a(k)*(1-factlat) |
---|
331 | enddo |
---|
332 | endif |
---|
333 | ujj(iim+1)=ujj(1) |
---|
334 | vjj(iim+1)=vjj(1) |
---|
335 | ajj(iim+1)=ajj(1) |
---|
336 | |
---|
337 | c Interpolation in longitudes |
---|
338 | c------------------------------------------------- |
---|
339 | ii=1 ! lon=-180 |
---|
340 | do i=2,iim |
---|
341 | if (lam.gt.longit(i)) ii=i |
---|
342 | enddo |
---|
343 | factlon = (lam-longit(ii))/(longit(ii+1)-longit(ii)) |
---|
344 | ubal = ujj(ii+1)*factlon + ujj(ii)*(1-factlon) |
---|
345 | vbal = vjj(ii+1)*factlon + vjj(ii)*(1-factlon) |
---|
346 | abal = ajj(ii+1)*factlon + ajj(ii)*(1-factlon) |
---|
347 | |
---|
348 | end |
---|
349 | |
---|
350 | c====================================================================== |
---|
351 | c====================================================================== |
---|
352 | c====================================================================== |
---|
353 | |
---|
354 | subroutine pos_implem(phi,lam,ubal,vbal,dt) |
---|
355 | |
---|
356 | use dimphy |
---|
357 | implicit none |
---|
358 | |
---|
359 | c====================================================================== |
---|
360 | c Auteur: S. Lebonnois (LMD/CNRS) date: 20091201 |
---|
361 | c Object: implementation of balloon position. |
---|
362 | C====================================================================== |
---|
363 | c Explicit Arguments: |
---|
364 | c ================== |
---|
365 | c phi ---R: Latitude of balloon in radians |
---|
366 | c lam ---R: Longitude of balloon in radians |
---|
367 | c ubal ---R: zonal speed of balloon |
---|
368 | c vbal ---R: meridional speed of balloon |
---|
369 | c dt ---R: time step |
---|
370 | c====================================================================== |
---|
371 | |
---|
372 | #include "dimensions.h" |
---|
373 | #include "YOMCST.h" |
---|
374 | c |
---|
375 | c ARGUMENTS |
---|
376 | c |
---|
377 | real phi,lam,ubal,vbal,abal,dt |
---|
378 | |
---|
379 | c incrementation longitude |
---|
380 | lam = lam + ubal*dt/(RA*cos(phi)) |
---|
381 | c maintenue entre -PI et PI: |
---|
382 | do while (lam.ge.RPI) |
---|
383 | lam=lam-2*RPI |
---|
384 | enddo |
---|
385 | do while (lam.lt.(-1.*RPI)) |
---|
386 | lam=lam+2*RPI |
---|
387 | enddo |
---|
388 | c incrementation latitude |
---|
389 | phi = phi + vbal*dt/RA |
---|
390 | c maintenue entre -PI/2 et PI/2: |
---|
391 | if (phi.ge.( 0.5*RPI)) phi= RPI-phi |
---|
392 | if (phi.le.(-0.5*RPI)) phi=-1.*RPI-phi |
---|
393 | |
---|
394 | end |
---|