1 | |
---|
2 | |
---|
3 | program torques |
---|
4 | |
---|
5 | ! SL 12/2009: |
---|
6 | ! This program reads 4D (lon-lat-alt-time) fields directly from CAM outputs |
---|
7 | ! without regrid |
---|
8 | ! |
---|
9 | ! it computes: |
---|
10 | ! dmass -- 4D -- mass of each cell |
---|
11 | ! osam -- 4D -- specific angular momentum (omega term) |
---|
12 | ! rsam -- 4D -- specific angular momentum (zonal wind term) |
---|
13 | ! oaam -- 1D -- integrated angular momentum (omega term) |
---|
14 | ! raam -- 1D -- integrated angular momentum (zonal wind term) |
---|
15 | ! tmou -- 2D -- Mountain torque fonction of lat |
---|
16 | ! tbls -- 2D -- Surface friction torque IF duvdf is present |
---|
17 | ! or if simple friction |
---|
18 | ! tdyn -- 2D -- Dynamics torque IF dudyn is present |
---|
19 | ! |
---|
20 | ! Minimal requirements and dependencies: |
---|
21 | ! The dataset must include the following data: |
---|
22 | ! - surface pressure and surface geopotential |
---|
23 | ! - zonal wind |
---|
24 | ! Optional: dudyn, duvdf |
---|
25 | |
---|
26 | implicit none |
---|
27 | |
---|
28 | include "netcdf.inc" ! NetCDF definitions |
---|
29 | |
---|
30 | character (len=128) :: infile ! input file name (name_P.nc) |
---|
31 | character (len=128) :: outfile ! output file name |
---|
32 | |
---|
33 | character (len=64) :: text ! to store some text |
---|
34 | integer infid ! NetCDF input file ID |
---|
35 | integer outfid ! NetCDF output file ID |
---|
36 | integer lon_dimid,lat_dimid,alt_dimid,time_dimid ! NetCDF dimension IDs |
---|
37 | integer lon_varid,lat_varid,alt_varid,time_varid, tmpvarid |
---|
38 | integer :: datashape1d ! shape of 1D datasets |
---|
39 | integer,dimension(2) :: datashape2d ! shape of 2D datasets |
---|
40 | integer,dimension(3) :: datashape3d ! shape of 3D datasets |
---|
41 | integer,dimension(4) :: datashape4d ! shape of 4D datasets |
---|
42 | |
---|
43 | real :: miss_val=9.99e+33 ! special "missing value" to specify missing data |
---|
44 | real,parameter :: miss_val_def=9.99e+33 ! default value for "missing value" |
---|
45 | real :: pi |
---|
46 | real,dimension(:),allocatable :: lon ! longitude |
---|
47 | integer lonlength ! # of grid points along longitude |
---|
48 | real,dimension(:),allocatable :: lat ! latitude |
---|
49 | real,dimension(:),allocatable :: latrad ! latitude in radian |
---|
50 | integer latlength ! # of grid points along latitude |
---|
51 | real,dimension(:),allocatable :: plev ! Pressure levels (Pa) |
---|
52 | integer altlength ! # of grid point along presnivs (of input datasets) |
---|
53 | real,dimension(:),allocatable :: time ! time |
---|
54 | integer timelength ! # of points along time |
---|
55 | real :: p0 ! GCM reference pressure |
---|
56 | real,dimension(:,:,:),allocatable :: ps ! surface pressure |
---|
57 | real,dimension(:,:,:),allocatable :: phis3d ! surface geopotential |
---|
58 | real,dimension(:,:),allocatable :: phis ! surface geopotential |
---|
59 | real,dimension(:),allocatable :: aps,bps ! hybrid vertical coordinates |
---|
60 | real,dimension(:,:,:,:),allocatable :: press ! GCM atmospheric pressure |
---|
61 | real,dimension(:),allocatable :: pp ! Pressure levels (Pa) |
---|
62 | real,dimension(:,:,:,:),allocatable :: temp ! atmospheric temperature |
---|
63 | real,dimension(:,:,:,:),allocatable :: vitu ! zonal wind (in m/s) |
---|
64 | real,dimension(:,:,:,:),allocatable :: vitv ! meridional wind (in m/s) |
---|
65 | real,dimension(:,:,:,:),allocatable :: vitw ! vertical wind (in Pa/s, then converted in m/s) |
---|
66 | real,dimension(:,:,:,:),allocatable :: duvdf ! Friction in BL |
---|
67 | real,dimension(:,:,:,:),allocatable :: dudyn ! Dynamics |
---|
68 | |
---|
69 | real,dimension(:,:,:,:),allocatable :: grav ! gravity field (m s-2) |
---|
70 | real,dimension(:,:,:,:),allocatable :: dmass ! mass in cell (kg) |
---|
71 | real,dimension(:,:,:,:),allocatable :: osam ! planetary rotation specific ang (m2/s) |
---|
72 | real,dimension(:,:,:,:),allocatable :: rsam ! zonal wind specific ang (m2/s) |
---|
73 | real,dimension(:),allocatable :: oaam ! planetary rotation total ang (kg m2/s) |
---|
74 | real,dimension(:),allocatable :: raam ! zonal wind total ang (kg m2/s) |
---|
75 | real,dimension(:,:),allocatable :: tmou ! mountain torque (kg m2/s2) |
---|
76 | real,dimension(:,:),allocatable :: tdyn ! dynamics torque (kg m2/s2) |
---|
77 | real,dimension(:,:),allocatable :: tbls ! friction torque (kg m2/s2) |
---|
78 | |
---|
79 | ! for angular momentum budget normalisation |
---|
80 | real,parameter :: hadley=1.e18 |
---|
81 | real,parameter :: hadday=1.e25 |
---|
82 | |
---|
83 | integer ierr,ierr1,ierr2 ! NetCDF routines return codes |
---|
84 | integer i,j,ilon,ilat,ilev,itim ! for loops |
---|
85 | integer idlsurf ! for option ideal surface |
---|
86 | logical :: flag_duvdf,flag_dudyn,lmdflag |
---|
87 | |
---|
88 | real :: deltalat,deltalon ! lat and lon intervals in radians |
---|
89 | real,dimension(:,:,:,:),allocatable :: deltap ! pressure thickness of each layer (Pa) |
---|
90 | real :: tmpp ! temporary pressure |
---|
91 | real :: dz ! altitude diff |
---|
92 | real :: signe ! orientation of lon axis for mountain torque computation |
---|
93 | |
---|
94 | include "planet.h" |
---|
95 | |
---|
96 | !=============================================================================== |
---|
97 | ! 1. Input parameters |
---|
98 | !=============================================================================== |
---|
99 | |
---|
100 | pi = 2.*asin(1.) |
---|
101 | |
---|
102 | write(*,*) "" |
---|
103 | write(*,*) "You are working on the atmosphere of ",planet |
---|
104 | |
---|
105 | !=============================================================================== |
---|
106 | ! 1.1 Input file |
---|
107 | !=============================================================================== |
---|
108 | |
---|
109 | write(*,*) "" |
---|
110 | write(*,*) " Program valid for Venus CAM or LMD output files" |
---|
111 | write(*,*) "Enter input file name:" |
---|
112 | |
---|
113 | read(*,'(a128)') infile |
---|
114 | write(*,*) "" |
---|
115 | |
---|
116 | ! open input file |
---|
117 | |
---|
118 | ierr = NF_OPEN(infile,NF_NOWRITE,infid) |
---|
119 | if (ierr.ne.NF_NOERR) then |
---|
120 | write(*,*) 'ERROR: Pb opening file ',trim(infile) |
---|
121 | stop "" |
---|
122 | endif |
---|
123 | |
---|
124 | !=============================================================================== |
---|
125 | ! 1.2 Get grids in lon,lat,alt(pressure),time |
---|
126 | !=============================================================================== |
---|
127 | |
---|
128 | call get_iddim(infid,lat_varid,latlength,lon_varid,lonlength,& |
---|
129 | alt_varid,altlength,time_varid,timelength,lmdflag ) |
---|
130 | |
---|
131 | allocate(lon(lonlength)) |
---|
132 | ierr=NF_GET_VAR_REAL(infid,lon_varid,lon) |
---|
133 | if (ierr.ne.NF_NOERR) stop "Error: Failed reading longitude" |
---|
134 | if(lon(1).gt.lon(2)) then |
---|
135 | signe=-1. |
---|
136 | else |
---|
137 | signe=1. |
---|
138 | endif |
---|
139 | |
---|
140 | allocate(lat(latlength)) |
---|
141 | ierr=NF_GET_VAR_REAL(infid,lat_varid,lat) |
---|
142 | if (ierr.ne.NF_NOERR) stop "Error: Failed reading lat" |
---|
143 | |
---|
144 | allocate(latrad(latlength)) |
---|
145 | latrad = lat*pi/180. |
---|
146 | |
---|
147 | ! Lat, lon pressure intervals |
---|
148 | deltalat = abs(latrad(2)-latrad(1)) |
---|
149 | deltalon = abs(lon(2)-lon(1))*pi/180. |
---|
150 | |
---|
151 | allocate(plev(altlength)) |
---|
152 | ierr=NF_GET_VAR_REAL(infid,alt_varid,plev) |
---|
153 | if (ierr.ne.NF_NOERR) stop "Error: Failed reading pressure levels" |
---|
154 | if(.not.lmdflag) then |
---|
155 | ! in CAM files, pressure in mbar and reversed... |
---|
156 | call reverselev(altlength,plev) |
---|
157 | plev=plev*100. ! convertion to Pa |
---|
158 | endif |
---|
159 | |
---|
160 | allocate(time(timelength)) |
---|
161 | ierr=NF_GET_VAR_REAL(infid,time_varid,time) |
---|
162 | if (ierr.ne.NF_NOERR) stop "Error: Failed reading time" |
---|
163 | |
---|
164 | ! Time axis IN PLANET DAYS |
---|
165 | |
---|
166 | if(.not.lmdflag) then |
---|
167 | ! in CAM files, time in Earth days... |
---|
168 | ! => seconds |
---|
169 | time=time*86400. |
---|
170 | endif |
---|
171 | time=time/localday |
---|
172 | |
---|
173 | !=============================================================================== |
---|
174 | ! 1.3 Get output file name |
---|
175 | !=============================================================================== |
---|
176 | write(*,*) "" |
---|
177 | !write(*,*) "Enter output file name" |
---|
178 | !read(*,*) outfile |
---|
179 | outfile=infile(1:len_trim(infile)-3)//"_LTRQ.nc" |
---|
180 | write(*,*) "Output file name is: "//trim(outfile) |
---|
181 | |
---|
182 | |
---|
183 | |
---|
184 | !=============================================================================== |
---|
185 | ! 2.1 Store needed fields |
---|
186 | !=============================================================================== |
---|
187 | |
---|
188 | !=============================================================================== |
---|
189 | ! 2.1.1 Surface pressure and geopotential |
---|
190 | !=============================================================================== |
---|
191 | allocate(ps(lonlength,latlength,timelength)) |
---|
192 | allocate(phis3d(lonlength,latlength,timelength)) |
---|
193 | allocate(phis(lonlength,latlength)) |
---|
194 | |
---|
195 | text="PS" |
---|
196 | call get_var3d(infid,lonlength,latlength,timelength,text,ps,ierr1,ierr2) |
---|
197 | if (ierr1.ne.NF_NOERR) then |
---|
198 | write(*,*) " looking for psol instead... " |
---|
199 | text="psol" |
---|
200 | call get_var3d(infid,lonlength,latlength,timelength,text,ps,ierr1,ierr2) |
---|
201 | if (ierr1.ne.NF_NOERR) stop "Error: Failed to get psol ID" |
---|
202 | endif |
---|
203 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading surface pressure" |
---|
204 | if((.not.lmdflag).and.(planet.eq."Venus")) call reverse3d(lonlength,latlength,timelength,ps) |
---|
205 | |
---|
206 | text="PHIS" |
---|
207 | call get_var3d(infid,lonlength,latlength,timelength,text,phis3d,ierr1,ierr2) |
---|
208 | if (ierr1.ne.NF_NOERR) then |
---|
209 | write(*,*) " Failed to get PHIS ID (3d), looking for phis (2d) instead... " |
---|
210 | text="phis" |
---|
211 | call get_var2d(infid,lonlength,latlength,text,phis,ierr1,ierr2) |
---|
212 | if (ierr1.ne.NF_NOERR) stop "Error: Failed to get phis ID" |
---|
213 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading surface geopotential" |
---|
214 | else |
---|
215 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading surface geopotential" |
---|
216 | phis(:,:)=phis3d(:,:,1) |
---|
217 | if((.not.lmdflag).and.(planet.eq."Venus")) call reverse2d(lonlength,latlength,phis) |
---|
218 | endif |
---|
219 | |
---|
220 | if(lmdflag) then |
---|
221 | p0=1. |
---|
222 | else |
---|
223 | ierr=NF_INQ_VARID(infid,"P0",tmpvarid) |
---|
224 | if (ierr.ne.NF_NOERR) then |
---|
225 | write(*,*) "Failed to get P0 ID, used psref=",psref |
---|
226 | p0=psref |
---|
227 | else |
---|
228 | ierr=NF_GET_VAR_REAL(infid,tmpvarid,p0) |
---|
229 | if (ierr.ne.NF_NOERR) then |
---|
230 | write(*,*) "Failed reading reference pressure, used psref=",psref |
---|
231 | p0=psref |
---|
232 | endif |
---|
233 | endif |
---|
234 | endif |
---|
235 | |
---|
236 | !=============================================================================== |
---|
237 | ! 2.1.3 Winds |
---|
238 | !=============================================================================== |
---|
239 | allocate(vitu(lonlength,latlength,altlength,timelength)) |
---|
240 | |
---|
241 | ! zonal wind vitu / U (in m/s) |
---|
242 | if(lmdflag) then |
---|
243 | text="vitu" |
---|
244 | else |
---|
245 | text="U" |
---|
246 | endif |
---|
247 | |
---|
248 | call get_var4d(infid,lonlength,latlength,altlength,timelength,text,vitu,ierr1,ierr2) |
---|
249 | if (ierr1.ne.NF_NOERR) stop "Error: Failed to get U ID" |
---|
250 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading zonal wind" |
---|
251 | |
---|
252 | if(.not.lmdflag) call reverse4d(lonlength,latlength,altlength,timelength,vitu) |
---|
253 | |
---|
254 | !=============================================================================== |
---|
255 | ! 2.1.5 Friction in Boundary layer |
---|
256 | !=============================================================================== |
---|
257 | allocate(duvdf(lonlength,latlength,altlength,timelength)) |
---|
258 | |
---|
259 | if(lmdflag) then |
---|
260 | text="duvdf" |
---|
261 | else |
---|
262 | text="DUVDF" |
---|
263 | endif |
---|
264 | call get_var4d(infid,lonlength,latlength,altlength,timelength,text,duvdf,ierr1,ierr2) |
---|
265 | if (ierr1.ne.NF_NOERR) then |
---|
266 | write(*,*) "Failed to get duvdf ID" |
---|
267 | flag_duvdf = .false. |
---|
268 | |
---|
269 | ! IDEAL FRICTION ? |
---|
270 | write(*,*) "" |
---|
271 | write(*,*) " Is the friction at surface ideal ? 0 for no, 1 for yes" |
---|
272 | write(*,*) " duvdf = -u/(86400*30) in surface layer" |
---|
273 | write(*,*) " timescale hard-coded: 30 Edays" |
---|
274 | read(*,'(i1)') idlsurf |
---|
275 | !write(*,*) "" |
---|
276 | !write(*,*) " ASSUMED YES ! " |
---|
277 | !idlsurf=1 |
---|
278 | write(*,*) "" |
---|
279 | |
---|
280 | if (idlsurf.eq.1) then |
---|
281 | flag_duvdf = .true. |
---|
282 | duvdf = 0. |
---|
283 | ilev=1 |
---|
284 | do ilon=1,lonlength |
---|
285 | do ilat=1,latlength |
---|
286 | do itim=1,timelength |
---|
287 | duvdf(ilon,ilat,ilev,itim) = vitu(ilon,ilat,ilev,itim) * (-1.)/(86400.*30.) |
---|
288 | enddo |
---|
289 | enddo |
---|
290 | enddo |
---|
291 | endif |
---|
292 | |
---|
293 | else |
---|
294 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading duvdf" |
---|
295 | if(.not.lmdflag) call reverse4d(lonlength,latlength,altlength,timelength,duvdf) |
---|
296 | flag_duvdf = .true. |
---|
297 | endif |
---|
298 | |
---|
299 | !=============================================================================== |
---|
300 | ! 2.1.7 Dynamics (includes the mountain torque...) |
---|
301 | !=============================================================================== |
---|
302 | allocate(dudyn(lonlength,latlength,altlength,timelength)) |
---|
303 | |
---|
304 | if(lmdflag) then |
---|
305 | text="dudyn" |
---|
306 | else |
---|
307 | text="DUDYN" |
---|
308 | endif |
---|
309 | call get_var4d(infid,lonlength,latlength,altlength,timelength,text,dudyn,ierr1,ierr2) |
---|
310 | if (ierr1.ne.NF_NOERR) then |
---|
311 | write(*,*) "Failed to get dudyn ID" |
---|
312 | flag_dudyn = .false. |
---|
313 | else |
---|
314 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading dudyn" |
---|
315 | if(.not.lmdflag) call reverse4d(lonlength,latlength,altlength,timelength,dudyn) |
---|
316 | flag_dudyn = .true. |
---|
317 | endif |
---|
318 | |
---|
319 | !=============================================================================== |
---|
320 | ! 2.2 Computations |
---|
321 | !=============================================================================== |
---|
322 | |
---|
323 | !=============================================================================== |
---|
324 | ! 2.2.1 Pressure intervals |
---|
325 | !=============================================================================== |
---|
326 | allocate(deltap(lonlength,latlength,altlength,timelength)) |
---|
327 | allocate(press(lonlength,latlength,altlength,timelength)) |
---|
328 | allocate(pp(altlength)) |
---|
329 | |
---|
330 | if(lmdflag) then ! LMD vs CAM |
---|
331 | text="pres" |
---|
332 | call get_var4d(infid,lonlength,latlength,altlength,timelength,text,press,ierr1,ierr2) |
---|
333 | if (ierr1.ne.NF_NOERR) then |
---|
334 | stop "Error: Failed to get pres ID" |
---|
335 | else |
---|
336 | if (ierr2.ne.NF_NOERR) stop "Error: Failed reading pres" |
---|
337 | endif |
---|
338 | |
---|
339 | else ! LMD vs CAM |
---|
340 | ! hybrid coordinate aps/hyam |
---|
341 | text="hyam" |
---|
342 | ierr=NF_INQ_VARID(infid,text,tmpvarid) |
---|
343 | if (ierr.ne.NF_NOERR) then |
---|
344 | stop "Error: Could not find aps/hyam coordinates" |
---|
345 | else |
---|
346 | allocate(aps(altlength)) |
---|
347 | ierr=NF_GET_VAR_REAL(infid,tmpvarid,aps) |
---|
348 | if (ierr.ne.NF_NOERR) then |
---|
349 | stop "Error: Failed reading aps/hyam" |
---|
350 | endif |
---|
351 | call reverselev(altlength,aps) |
---|
352 | endif |
---|
353 | |
---|
354 | ! hybrid coordinate hybm |
---|
355 | text="hybm" |
---|
356 | ierr=NF_INQ_VARID(infid,text,tmpvarid) |
---|
357 | if (ierr.ne.NF_NOERR) then |
---|
358 | stop "Error: Failed to get bps/hybm ID" |
---|
359 | else |
---|
360 | allocate(bps(altlength)) |
---|
361 | ierr=NF_GET_VAR_REAL(infid,tmpvarid,bps) |
---|
362 | if (ierr.ne.NF_NOERR) then |
---|
363 | stop "Error: Failed reading bps/hybm" |
---|
364 | endif |
---|
365 | call reverselev(altlength,bps) |
---|
366 | endif |
---|
367 | |
---|
368 | aps=aps*p0 |
---|
369 | |
---|
370 | do itim=1,timelength |
---|
371 | do ilev=1,altlength |
---|
372 | do ilat=1,latlength |
---|
373 | do ilon=1,lonlength |
---|
374 | press(ilon,ilat,ilev,itim)=aps(ilev)+bps(ilev)*ps(ilon,ilat,itim) |
---|
375 | enddo |
---|
376 | enddo |
---|
377 | enddo |
---|
378 | enddo |
---|
379 | |
---|
380 | endif ! LMD vs CAM |
---|
381 | |
---|
382 | do itim=1,timelength |
---|
383 | |
---|
384 | do ilon=1,lonlength |
---|
385 | do ilat=1,latlength |
---|
386 | tmpp=ps(ilon,ilat,itim) |
---|
387 | pp=press(ilon,ilat,:,itim) |
---|
388 | deltap(ilon,ilat,1,itim)= tmpp - exp((log(pp(1))+log(pp(2)))/2.) ! initialization, rectified with ps below |
---|
389 | do ilev=2,altlength-1 |
---|
390 | deltap(ilon,ilat,ilev,itim)= exp((log(pp(ilev-1))+log(pp(ilev)))/2.)-& |
---|
391 | exp((log(pp(ilev))+log(pp(ilev+1)))/2.) |
---|
392 | enddo |
---|
393 | deltap(ilon,ilat,altlength,itim)=exp((log(pp(altlength-1))+log(pp(altlength)))/2.) |
---|
394 | enddo |
---|
395 | enddo |
---|
396 | |
---|
397 | enddo ! timelength |
---|
398 | |
---|
399 | !=============================================================================== |
---|
400 | ! 2.2.2 Mass in cells |
---|
401 | !=============================================================================== |
---|
402 | allocate(grav(lonlength,latlength,altlength,timelength)) |
---|
403 | allocate(dmass(lonlength,latlength,altlength,timelength)) |
---|
404 | |
---|
405 | do itim=1,timelength |
---|
406 | |
---|
407 | do ilon=1,lonlength |
---|
408 | do ilat=1,latlength |
---|
409 | do ilev=1,altlength |
---|
410 | if (deltap(ilon,ilat,ilev,itim).ne.miss_val) then |
---|
411 | ! Need to be consistent with GCM computations |
---|
412 | grav(ilon,ilat,ilev,itim) = g0 |
---|
413 | dmass(ilon,ilat,ilev,itim) = & |
---|
414 | a0*cos(latrad(ilat))*deltalon & |
---|
415 | * a0*deltalat & |
---|
416 | * deltap(ilon,ilat,ilev,itim)/grav(ilon,ilat,ilev,itim) |
---|
417 | else |
---|
418 | grav(ilon,ilat,ilev,itim) = miss_val |
---|
419 | dmass(ilon,ilat,ilev,itim) = miss_val |
---|
420 | endif |
---|
421 | enddo |
---|
422 | enddo |
---|
423 | enddo |
---|
424 | |
---|
425 | enddo ! timelength |
---|
426 | |
---|
427 | !=============================================================================== |
---|
428 | ! 2.2.3 Specific angular momentum |
---|
429 | !=============================================================================== |
---|
430 | allocate(osam(lonlength,latlength,altlength,timelength)) |
---|
431 | allocate(rsam(lonlength,latlength,altlength,timelength)) |
---|
432 | |
---|
433 | do itim=1,timelength |
---|
434 | |
---|
435 | do ilon=1,lonlength |
---|
436 | do ilat=1,latlength |
---|
437 | do ilev=1,altlength |
---|
438 | osam(ilon,ilat,ilev,itim) = & |
---|
439 | a0*a0* cos(latrad(ilat))*cos(latrad(ilat)) * omega |
---|
440 | rsam(ilon,ilat,ilev,itim) = vitu(ilon,ilat,ilev,itim) & |
---|
441 | * a0*cos(latrad(ilat)) |
---|
442 | enddo |
---|
443 | enddo |
---|
444 | enddo |
---|
445 | |
---|
446 | enddo ! timelength |
---|
447 | |
---|
448 | !=============================================================================== |
---|
449 | ! 2.2.4 Total angular momentum |
---|
450 | !=============================================================================== |
---|
451 | allocate(oaam(timelength)) |
---|
452 | allocate(raam(timelength)) |
---|
453 | |
---|
454 | do itim=1,timelength |
---|
455 | |
---|
456 | oaam(itim) = 0. |
---|
457 | raam(itim) = 0. |
---|
458 | do ilon=1,lonlength |
---|
459 | do ilat=1,latlength |
---|
460 | do ilev=1,altlength |
---|
461 | oaam(itim) = oaam(itim) & |
---|
462 | + osam(ilon,ilat,ilev,itim)/ hadday * dmass(ilon,ilat,ilev,itim) |
---|
463 | raam(itim) = raam(itim) & |
---|
464 | + rsam(ilon,ilat,ilev,itim)/ hadday * dmass(ilon,ilat,ilev,itim) |
---|
465 | enddo |
---|
466 | enddo |
---|
467 | enddo |
---|
468 | if (oaam(itim).eq.0.) then |
---|
469 | oaam(itim) = miss_val |
---|
470 | raam(itim) = miss_val |
---|
471 | endif |
---|
472 | |
---|
473 | enddo ! timelength |
---|
474 | |
---|
475 | !=============================================================================== |
---|
476 | ! 2.2.5 Mountain, friction, dynamics and GW torques |
---|
477 | !=============================================================================== |
---|
478 | allocate(tmou(latlength,timelength)) |
---|
479 | if (flag_dudyn) allocate(tdyn(latlength,timelength)) |
---|
480 | if (flag_duvdf) allocate(tbls(latlength,timelength)) |
---|
481 | |
---|
482 | do itim=1,timelength |
---|
483 | |
---|
484 | tmou(:,itim) = 0. |
---|
485 | do ilat=2,latlength-1 |
---|
486 | do ilon=1,lonlength |
---|
487 | if (ilon.eq.lonlength) then |
---|
488 | dz = (phis( 1,ilat) -phis(ilon,ilat))/g0 |
---|
489 | tmpp = (ps( 1,ilat,itim) +ps(ilon,ilat,itim))/2. |
---|
490 | else |
---|
491 | dz = (phis(ilon+1,ilat) -phis(ilon,ilat))/g0 |
---|
492 | tmpp = (ps(ilon+1,ilat,itim) +ps(ilon,ilat,itim))/2. |
---|
493 | endif |
---|
494 | tmou(ilat,itim) = tmou(ilat,itim) + a0*a0* deltalat*cos(latrad(ilat)) & |
---|
495 | * signe*dz*tmpp & |
---|
496 | / hadley |
---|
497 | enddo |
---|
498 | enddo |
---|
499 | |
---|
500 | if (flag_dudyn) then |
---|
501 | tdyn(:,itim) = 0. |
---|
502 | do ilat=1,latlength |
---|
503 | do ilon=1,lonlength |
---|
504 | do ilev=1,altlength |
---|
505 | tdyn(ilat,itim) = tdyn(ilat,itim) + dudyn(ilon,ilat,ilev,itim) & |
---|
506 | * a0*cos(latrad(ilat)) * dmass(ilon,ilat,ilev,itim) & |
---|
507 | / hadley |
---|
508 | enddo |
---|
509 | enddo |
---|
510 | if (tdyn(ilat,itim).eq.0.) tdyn(ilat,itim) = miss_val |
---|
511 | enddo |
---|
512 | endif |
---|
513 | |
---|
514 | if (flag_duvdf) then |
---|
515 | tbls(:,itim) = 0. |
---|
516 | do ilat=1,latlength |
---|
517 | do ilon=1,lonlength |
---|
518 | do ilev=1,altlength |
---|
519 | tbls(ilat,itim) = tbls(ilat,itim) + duvdf(ilon,ilat,ilev,itim) & |
---|
520 | * a0*cos(latrad(ilat)) * dmass(ilon,ilat,ilev,itim) & |
---|
521 | / hadley |
---|
522 | enddo |
---|
523 | enddo |
---|
524 | if (tbls(ilat,itim).eq.0.) tbls(ilat,itim) = miss_val |
---|
525 | enddo |
---|
526 | endif |
---|
527 | |
---|
528 | enddo ! timelength |
---|
529 | |
---|
530 | print*,"End of computations" |
---|
531 | |
---|
532 | !=============================================================================== |
---|
533 | ! 3. Create output file |
---|
534 | !=============================================================================== |
---|
535 | |
---|
536 | ! Create output file |
---|
537 | ierr=NF_CREATE(outfile,NF_CLOBBER,outfid) |
---|
538 | if (ierr.ne.NF_NOERR) then |
---|
539 | write(*,*)"Error: could not create file ",outfile |
---|
540 | stop |
---|
541 | endif |
---|
542 | |
---|
543 | !=============================================================================== |
---|
544 | ! 3.1. Define and write dimensions |
---|
545 | !=============================================================================== |
---|
546 | |
---|
547 | call write_dim(outfid,lonlength,latlength,altlength,timelength, & |
---|
548 | lon,lat,plev,time,lon_dimid,lat_dimid,alt_dimid,time_dimid) |
---|
549 | |
---|
550 | !=============================================================================== |
---|
551 | ! 3.2. Define and write variables |
---|
552 | !=============================================================================== |
---|
553 | |
---|
554 | ! 1D Variables |
---|
555 | |
---|
556 | datashape1d=time_dimid |
---|
557 | |
---|
558 | call write_var1d(outfid,datashape1d,timelength,& |
---|
559 | "oaam ", "Total rotation ang ","E25kgm2s-1",miss_val,& |
---|
560 | oaam ) |
---|
561 | |
---|
562 | call write_var1d(outfid,datashape1d,timelength,& |
---|
563 | "raam ", "Total wind ang ","E25kgm2s-1",miss_val,& |
---|
564 | raam ) |
---|
565 | |
---|
566 | ! 2D variables |
---|
567 | |
---|
568 | datashape2d(1)=lat_dimid |
---|
569 | datashape2d(2)=time_dimid |
---|
570 | |
---|
571 | call write_var2d(outfid,datashape2d,latlength,timelength,& |
---|
572 | "tmou ", "Mountain torque ","E18kgm2s-2",miss_val,& |
---|
573 | tmou ) |
---|
574 | |
---|
575 | if (flag_dudyn) then |
---|
576 | call write_var2d(outfid,datashape2d,latlength,timelength,& |
---|
577 | "tdyn ", "Dynamics torque ","E18kgm2s-2",miss_val,& |
---|
578 | tdyn ) |
---|
579 | endif |
---|
580 | |
---|
581 | if (flag_duvdf) then |
---|
582 | call write_var2d(outfid,datashape2d,latlength,timelength,& |
---|
583 | "tbls ", "Friction torque ","E18kgm2s-2",miss_val,& |
---|
584 | tbls ) |
---|
585 | endif |
---|
586 | |
---|
587 | datashape2d(1)=lon_dimid |
---|
588 | datashape2d(2)=lat_dimid |
---|
589 | |
---|
590 | call write_var2d(outfid,datashape2d,lonlength,latlength,& |
---|
591 | "phis ", "Surface geopot ","m2 s-2 ",miss_val,& |
---|
592 | phis ) |
---|
593 | |
---|
594 | ! 3D variables |
---|
595 | |
---|
596 | datashape3d(1)=lon_dimid |
---|
597 | datashape3d(2)=lat_dimid |
---|
598 | datashape3d(3)=time_dimid |
---|
599 | |
---|
600 | call write_var3d(outfid,datashape3d,lonlength,latlength,timelength,& |
---|
601 | "ps ", "Surface pressure ","Pa ",miss_val,& |
---|
602 | ps ) |
---|
603 | |
---|
604 | datashape3d(1)=lat_dimid |
---|
605 | datashape3d(2)=alt_dimid |
---|
606 | datashape3d(3)=time_dimid |
---|
607 | |
---|
608 | !!!! Close output file |
---|
609 | ierr=NF_CLOSE(outfid) |
---|
610 | if (ierr.ne.NF_NOERR) then |
---|
611 | write(*,*) 'Error, failed to close output file ',outfile |
---|
612 | endif |
---|
613 | |
---|
614 | |
---|
615 | end program |
---|
616 | |
---|
617 | subroutine reverse4d(nlon,nlat,np,nt,newf) |
---|
618 | !============================================================================== |
---|
619 | ! Purpose: |
---|
620 | ! reverse lat, lon and vertical axis on a 3D+time field |
---|
621 | !============================================================================== |
---|
622 | implicit none |
---|
623 | !============================================================================== |
---|
624 | ! Arguments: |
---|
625 | !============================================================================== |
---|
626 | integer,intent(in) :: nlon ! longitude size |
---|
627 | integer,intent(in) :: nlat ! latitude size |
---|
628 | integer,intent(in) :: np ! vertical size |
---|
629 | integer,intent(in) :: nt ! time size |
---|
630 | real,intent(inout),dimension(nlon,nlat,np,nt) :: newf ! field to be reversed |
---|
631 | |
---|
632 | !============================================================================== |
---|
633 | ! Local variables: |
---|
634 | !============================================================================== |
---|
635 | integer :: i,j,k,l |
---|
636 | real,dimension(nlon,nlat,np,nt) :: tmp,tmp2 ! reversed fields |
---|
637 | include "planet.h" |
---|
638 | |
---|
639 | ! Vertical axis: |
---|
640 | do k=1,np |
---|
641 | tmp(:,:,k,:)=newf(:,:,np+1-k,:) |
---|
642 | enddo |
---|
643 | ! horizontal dimensions |
---|
644 | if(planet.eq."Venus") then |
---|
645 | do l=1,nt |
---|
646 | do i=1,nlat |
---|
647 | do j=1,nlon |
---|
648 | tmp2(j,i,:,l)=tmp(nlon+1-j,nlat+1-i,:,l) |
---|
649 | enddo |
---|
650 | enddo |
---|
651 | enddo |
---|
652 | else |
---|
653 | tmp2=tmp |
---|
654 | endif |
---|
655 | |
---|
656 | newf=tmp2 |
---|
657 | |
---|
658 | end subroutine reverse4d |
---|
659 | |
---|
660 | !=============================================================================== |
---|
661 | |
---|
662 | subroutine reverse2d(nlon,nlat,newf) |
---|
663 | !============================================================================== |
---|
664 | ! Purpose: |
---|
665 | ! reverse lat and lon on a 2D field |
---|
666 | !============================================================================== |
---|
667 | implicit none |
---|
668 | !============================================================================== |
---|
669 | ! Arguments: |
---|
670 | !============================================================================== |
---|
671 | integer,intent(in) :: nlon ! longitude size |
---|
672 | integer,intent(in) :: nlat ! latitude size |
---|
673 | real,intent(inout),dimension(nlon,nlat) :: newf ! field to be reversed |
---|
674 | |
---|
675 | !============================================================================== |
---|
676 | ! Local variables: |
---|
677 | !============================================================================== |
---|
678 | integer :: i,j |
---|
679 | real,dimension(nlon,nlat) :: tmp ! reversed field |
---|
680 | |
---|
681 | do i=1,nlat |
---|
682 | do j=1,nlon |
---|
683 | tmp(j,i)=newf(nlon+1-j,nlat+1-i) |
---|
684 | enddo |
---|
685 | enddo |
---|
686 | newf=tmp |
---|
687 | |
---|
688 | end subroutine reverse2d |
---|
689 | |
---|
690 | !=============================================================================== |
---|
691 | |
---|
692 | subroutine reverse3d(nlon,nlat,nt,newf) |
---|
693 | !============================================================================== |
---|
694 | ! Purpose: |
---|
695 | ! reverse lat and lon on a 2D+time field |
---|
696 | !============================================================================== |
---|
697 | implicit none |
---|
698 | !============================================================================== |
---|
699 | ! Arguments: |
---|
700 | !============================================================================== |
---|
701 | integer,intent(in) :: nlon ! longitude size |
---|
702 | integer,intent(in) :: nlat ! latitude size |
---|
703 | integer,intent(in) :: nt ! time size |
---|
704 | real,intent(inout),dimension(nlon,nlat,nt) :: newf ! field to be reversed |
---|
705 | |
---|
706 | !============================================================================== |
---|
707 | ! Local variables: |
---|
708 | !============================================================================== |
---|
709 | integer :: i,j,l |
---|
710 | real,dimension(nlon,nlat,nt) :: tmp ! reversed field |
---|
711 | |
---|
712 | do l=1,nt |
---|
713 | do i=1,nlat |
---|
714 | do j=1,nlon |
---|
715 | tmp(j,i,l)=newf(nlon+1-j,nlat+1-i,l) |
---|
716 | enddo |
---|
717 | enddo |
---|
718 | enddo |
---|
719 | newf=tmp |
---|
720 | |
---|
721 | end subroutine reverse3d |
---|
722 | |
---|
723 | !=============================================================================== |
---|
724 | |
---|
725 | subroutine reverselev(np,newf) |
---|
726 | !============================================================================== |
---|
727 | ! Purpose: |
---|
728 | ! reverse vertical pressure axis |
---|
729 | !============================================================================== |
---|
730 | implicit none |
---|
731 | !============================================================================== |
---|
732 | ! Arguments: |
---|
733 | !============================================================================== |
---|
734 | integer,intent(in) :: np ! vertical size |
---|
735 | real,intent(inout),dimension(np) :: newf ! field to be reversed |
---|
736 | |
---|
737 | !============================================================================== |
---|
738 | ! Local variables: |
---|
739 | !============================================================================== |
---|
740 | integer :: k |
---|
741 | real,dimension(np) :: tmp ! reversed field |
---|
742 | |
---|
743 | do k=1,np |
---|
744 | tmp(k)=newf(np+1-k) |
---|
745 | enddo |
---|
746 | newf=tmp |
---|
747 | |
---|
748 | end subroutine reverselev |
---|