Home

Context Navigation

source: palm/trunk/SOURCE/average_3d_data.f90 @ 3458

Last change on this file since 3458 was 3448, checked in by kanani, 5 years ago
Implementation of human thermal indices (from branch biomet_p2 at r3444)
Property svn:keywords set to `Id`
File size: 19.1 KB

Line
1	!> @file average_3d_data.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: average_3d_data.f90 3448 2018-10-29 18:14:31Z kanani $
27	! Adjustment of biometeorology calls
28	!
29	! 3421 2018-10-24 18:39:32Z gronemeier
30	! Renamed output variables
31	!
32	! 3419 2018-10-24 17:27:31Z gronemeier
33	! (from resler branch)
34	! Add biometeorology output,
35	! fix for chemistry output,
36	! move of urban surface output
37	!
38	! 3294 2018-10-01 02:37:10Z raasch
39	! changes concerning modularization of ocean option
40	!
41	! 3274 2018-09-24 15:42:55Z knoop
42	! Modularization of all bulk cloud physics code components
43	!
44	! 3004 2018-04-27 12:33:25Z Giersch
45	! Further allocation checks implemented, case z0q* added
46	!
47	! 2885 2018-03-14 11:02:46Z Giersch
48	! Preliminary gust module interface implemented
49	!
50	! 2797 2018-02-08 13:24:35Z suehring
51	! Enable output of ground-heat flux also at urban surfaces.
52	!
53	! 2766 2018-01-22 17:17:47Z kanani
54	! Removed preprocessor directive __chem
55	!
56	! 2742 2018-01-12 14:59:47Z suehring
57	! Enable output of surface temperature
58	!
59	! 2735 2018-01-11 12:01:27Z suehring
60	! output of r_a moved from land-surface to consider also urban-type surfaces
61	!
62	! 2718 2018-01-02 08:49:38Z maronga
63	! Corrected "Former revisions" section
64	!
65	! 2696 2017-12-14 17:12:51Z kanani
66	! Change in file header (GPL part)
67	! Implement call for turbulence_closure_mod (TG)
68	! Implementation of chemistry module (FK)
69	!
70	! 2292 2017-06-20 09:51:42Z schwenkel
71	! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
72	! includes two more prognostic equations for cloud drop concentration (nc)
73	! and cloud water content (qc).
74	!
75	! 2233 2017-05-30 18:08:54Z suehring
76	!
77	! 2232 2017-05-30 17:47:52Z suehring
78	! Adjustments to new surface concept - additional ghost point exchange
79	! of surface variable required
80	!
81	! 2031 2016-10-21 15:11:58Z knoop
82	! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
83	!
84	! 2011 2016-09-19 17:29:57Z kanani
85	! Flag urban_surface is now defined in module control_parameters,
86	! changed prefix for urban surface model output to "usm_",
87	! introduced control parameter varnamelength for LEN of trimvar.
88	!
89	! 2007 2016-08-24 15:47:17Z kanani
90	! Added support for new urban surface model (temporary modifications of
91	! SELECT CASE ( ) necessary, see variable trimvar),
92	! added comments in variable declaration section
93	!
94	! 2000 2016-08-20 18:09:15Z knoop
95	! Forced header and separation lines into 80 columns
96	!
97	! 1972 2016-07-26 07:52:02Z maronga
98	! Output of land surface quantities is now done directly in the respective module
99	!
100	! 1960 2016-07-12 16:34:24Z suehring
101	! Treat humidity and passive scalar separately
102	!
103	! 1691 2015-10-26 16:17:44Z maronga
104	! Added output of Obukhov length and radiative heating rates for RRTMG.
105	!
106	! 1682 2015-10-07 23:56:08Z knoop
107	! Code annotations made doxygen readable
108	!
109	! 1585 2015-04-30 07:05:52Z maronga
110	! Adapted for RRTMG
111	!
112	! 1555 2015-03-04 17:44:27Z maronga
113	! Added output of r_a and r_s
114	!
115	! 1551 2015-03-03 14:18:16Z maronga
116	! Added support for land surface and radiation model parameters.
117	!
118	! 1322 2014-03-20 16:38:49Z raasch
119	! REAL functions provided with KIND-attribute
120	!
121	! 1320 2014-03-20 08:40:49Z raasch
122	! ONLY-attribute added to USE-statements,
123	! kind-parameters added to all INTEGER and REAL declaration statements,
124	! kinds are defined in new module kinds,
125	! revision history before 2012 removed,
126	! comment fields (!:) to be used for variable explanations added to
127	! all variable declaration statements
128	!
129	! 1318 2014-03-17 13:35:16Z raasch
130	! barrier argument removed from cpu_log,
131	! module interfaces removed
132	!
133	! 1115 2013-03-26 18:16:16Z hoffmann
134	! +qc
135	!
136	! 1053 2012-11-13 17:11:03Z hoffmann
137	! averaging of nr, qr added
138	!
139	! 1036 2012-10-22 13:43:42Z raasch
140	! code put under GPL (PALM 3.9)
141	!
142	! 978 2012-08-09 08:28:32Z fricke
143	! +z0h_av
144	!
145	! Revision 1.1 2006/02/23 09:48:58 raasch
146	! Initial revision
147	!
148	!
149	! Description:
150	! ------------
151	!> Time-averaging of 3d-data-arrays.
152	!------------------------------------------------------------------------------!
153	SUBROUTINE average_3d_data
154
155
156	USE averaging
157
158	USE biometeorology_mod, &
159	ONLY: biom_3d_data_averaging
160
161	USE bulk_cloud_model_mod, &
162	ONLY: bulk_cloud_model, bcm_3d_data_averaging
163
164	USE chemistry_model_mod, &
165	ONLY: chem_3d_data_averaging
166
167	USE control_parameters, &
168	ONLY: air_chemistry, average_count_3d, biometeorology, doav, doav_n, &
169	land_surface, ocean_mode, urban_surface, varnamelength
170
171	USE cpulog, &
172	ONLY: cpu_log, log_point
173
174	USE gust_mod, &
175	ONLY: gust_3d_data_averaging, gust_module_enabled
176
177	USE indices, &
178	ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
179
180	USE kinds
181
182	USE land_surface_model_mod, &
183	ONLY: lsm_3d_data_averaging
184
185	USE ocean_mod, &
186	ONLY: ocean_3d_data_averaging
187
188	USE radiation_model_mod, &
189	ONLY: radiation, radiation_3d_data_averaging
190
191	USE turbulence_closure_mod, &
192	ONLY: tcm_3d_data_averaging
193
194	USE urban_surface_mod, &
195	ONLY: usm_average_3d_data
196
197
198
199
200	IMPLICIT NONE
201
202	INTEGER(iwp) :: i !< loop index
203	INTEGER(iwp) :: ii !< loop index
204	INTEGER(iwp) :: j !< loop index
205	INTEGER(iwp) :: k !< loop index
206
207	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
208
209
210	CALL cpu_log (log_point(35),'average_3d_data','start')
211
212	!
213	!-- Check, if averaging is necessary
214	IF ( average_count_3d <= 1 ) RETURN
215
216	!
217	!-- Loop of all variables to be averaged.
218	DO ii = 1, doav_n
219
220	trimvar = TRIM( doav(ii) )
221
222	!
223	!-- Store the array chosen on the temporary array.
224	SELECT CASE ( trimvar )
225
226	CASE ( 'e' )
227	IF ( ALLOCATED( e_av ) ) THEN
228	DO i = nxlg, nxrg
229	DO j = nysg, nyng
230	DO k = nzb, nzt+1
231	e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d, KIND=wp )
232	ENDDO
233	ENDDO
234	ENDDO
235	ENDIF
236
237	CASE ( 'ghf*' )
238	IF ( ALLOCATED( ghf_av ) ) THEN
239	DO i = nxl, nxr
240	DO j = nys, nyn
241	ghf_av(j,i) = ghf_av(j,i) &
242	/ REAL( average_count_3d, KIND=wp )
243	ENDDO
244	ENDDO
245	CALL exchange_horiz_2d( ghf_av, nbgp )
246	ENDIF
247
248	CASE ( 'qsws*' )
249	IF ( ALLOCATED( qsws_av ) ) THEN
250	DO i = nxlg, nxrg
251	DO j = nysg, nyng
252	qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d, KIND=wp )
253	ENDDO
254	ENDDO
255	CALL exchange_horiz_2d( qsws_av, nbgp )
256	ENDIF
257
258	CASE ( 'thetal' )
259	IF ( ALLOCATED( lpt_av ) ) THEN
260	DO i = nxlg, nxrg
261	DO j = nysg, nyng
262	DO k = nzb, nzt+1
263	lpt_av(k,j,i) = lpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
264	ENDDO
265	ENDDO
266	ENDDO
267	ENDIF
268
269	CASE ( 'lwp*' )
270	IF ( ALLOCATED( lwp_av ) ) THEN
271	DO i = nxlg, nxrg
272	DO j = nysg, nyng
273	lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d, KIND=wp )
274	ENDDO
275	ENDDO
276	ENDIF
277
278	CASE ( 'ol*' )
279	IF ( ALLOCATED( ol_av ) ) THEN
280	DO i = nxlg, nxrg
281	DO j = nysg, nyng
282	ol_av(j,i) = ol_av(j,i) / REAL( average_count_3d, KIND=wp )
283	ENDDO
284	ENDDO
285	CALL exchange_horiz_2d( ol_av, nbgp )
286	ENDIF
287
288	CASE ( 'p' )
289	IF ( ALLOCATED( p_av ) ) THEN
290	DO i = nxlg, nxrg
291	DO j = nysg, nyng
292	DO k = nzb, nzt+1
293	p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d, KIND=wp )
294	ENDDO
295	ENDDO
296	ENDDO
297	ENDIF
298
299	CASE ( 'pc' )
300	IF ( ALLOCATED( pc_av ) ) THEN
301	DO i = nxl, nxr
302	DO j = nys, nyn
303	DO k = nzb, nzt+1
304	pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
305	ENDDO
306	ENDDO
307	ENDDO
308	ENDIF
309
310	CASE ( 'pr' )
311	IF ( ALLOCATED( pr_av ) ) THEN
312	DO i = nxl, nxr
313	DO j = nys, nyn
314	DO k = nzb, nzt+1
315	pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d, KIND=wp )
316	ENDDO
317	ENDDO
318	ENDDO
319	ENDIF
320
321	CASE ( 'theta' )
322	IF ( ALLOCATED( pt_av ) ) THEN
323	DO i = nxlg, nxrg
324	DO j = nysg, nyng
325	DO k = nzb, nzt+1
326	pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
327	ENDDO
328	ENDDO
329	ENDDO
330	ENDIF
331
332	CASE ( 'q' )
333	IF ( ALLOCATED( q_av ) ) THEN
334	DO i = nxlg, nxrg
335	DO j = nysg, nyng
336	DO k = nzb, nzt+1
337	q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND=wp )
338	ENDDO
339	ENDDO
340	ENDDO
341	ENDIF
342
343	CASE ( 'ql' )
344	IF ( ALLOCATED( ql_av ) ) THEN
345	DO i = nxlg, nxrg
346	DO j = nysg, nyng
347	DO k = nzb, nzt+1
348	ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d, KIND=wp )
349	ENDDO
350	ENDDO
351	ENDDO
352	ENDIF
353
354	CASE ( 'ql_c' )
355	IF ( ALLOCATED( ql_c_av ) ) THEN
356	DO i = nxlg, nxrg
357	DO j = nysg, nyng
358	DO k = nzb, nzt+1
359	ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d, KIND=wp )
360	ENDDO
361	ENDDO
362	ENDDO
363	ENDIF
364
365	CASE ( 'ql_v' )
366	IF ( ALLOCATED( ql_v_av ) ) THEN
367	DO i = nxlg, nxrg
368	DO j = nysg, nyng
369	DO k = nzb, nzt+1
370	ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
371	ENDDO
372	ENDDO
373	ENDDO
374	ENDIF
375
376	CASE ( 'ql_vp' )
377	IF ( ALLOCATED( ql_vp_av ) ) THEN
378	DO i = nxlg, nxrg
379	DO j = nysg, nyng
380	DO k = nzb, nzt+1
381	ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / &
382	REAL( average_count_3d, KIND=wp )
383	ENDDO
384	ENDDO
385	ENDDO
386	ENDIF
387
388	CASE ( 'qv' )
389	IF ( ALLOCATED( qv_av ) ) THEN
390	DO i = nxlg, nxrg
391	DO j = nysg, nyng
392	DO k = nzb, nzt+1
393	qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
394	ENDDO
395	ENDDO
396	ENDDO
397	ENDIF
398
399	CASE ( 'r_a*' )
400	IF ( ALLOCATED( r_a_av ) ) THEN
401	DO i = nxlg, nxrg
402	DO j = nysg, nyng
403	r_a_av(j,i) = r_a_av(j,i) / REAL( average_count_3d, KIND=wp )
404	ENDDO
405	ENDDO
406	CALL exchange_horiz_2d( r_a_av, nbgp )
407	ENDIF
408
409	CASE ( 's' )
410	IF ( ALLOCATED( s_av ) ) THEN
411	DO i = nxlg, nxrg
412	DO j = nysg, nyng
413	DO k = nzb, nzt+1
414	s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d, KIND=wp )
415	ENDDO
416	ENDDO
417	ENDDO
418	ENDIF
419
420	CASE ( 'shf*' )
421	IF ( ALLOCATED( shf_av ) ) THEN
422	DO i = nxlg, nxrg
423	DO j = nysg, nyng
424	shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d, KIND=wp )
425	ENDDO
426	ENDDO
427	CALL exchange_horiz_2d( shf_av, nbgp )
428	ENDIF
429
430	CASE ( 'ssws*' )
431	IF ( ALLOCATED( ssws_av ) ) THEN
432	DO i = nxlg, nxrg
433	DO j = nysg, nyng
434	ssws_av(j,i) = ssws_av(j,i) / REAL( average_count_3d, KIND=wp )
435	ENDDO
436	ENDDO
437	CALL exchange_horiz_2d( ssws_av, nbgp )
438	ENDIF
439
440	CASE ( 't*' )
441	IF ( ALLOCATED( ts_av ) ) THEN
442	DO i = nxlg, nxrg
443	DO j = nysg, nyng
444	ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d, KIND=wp )
445	ENDDO
446	ENDDO
447	CALL exchange_horiz_2d( ts_av, nbgp )
448	ENDIF
449
450	CASE ( 'tsurf*' )
451	IF ( ALLOCATED( tsurf_av ) ) THEN
452	DO i = nxlg, nxrg
453	DO j = nysg, nyng
454	tsurf_av(j,i) = tsurf_av(j,i) / REAL( average_count_3d, KIND=wp )
455	ENDDO
456	ENDDO
457	CALL exchange_horiz_2d( tsurf_av, nbgp )
458	ENDIF
459
460	CASE ( 'u' )
461	IF ( ALLOCATED( u_av ) ) THEN
462	DO i = nxlg, nxrg
463	DO j = nysg, nyng
464	DO k = nzb, nzt+1
465	u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND=wp )
466	ENDDO
467	ENDDO
468	ENDDO
469	ENDIF
470
471	CASE ( 'us*' )
472	IF ( ALLOCATED( us_av ) ) THEN
473	DO i = nxlg, nxrg
474	DO j = nysg, nyng
475	us_av(j,i) = us_av(j,i) / REAL( average_count_3d, KIND=wp )
476	ENDDO
477	ENDDO
478	CALL exchange_horiz_2d( us_av, nbgp )
479	ENDIF
480
481	CASE ( 'v' )
482	IF ( ALLOCATED( v_av ) ) THEN
483	DO i = nxlg, nxrg
484	DO j = nysg, nyng
485	DO k = nzb, nzt+1
486	v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND=wp )
487	ENDDO
488	ENDDO
489	ENDDO
490	ENDIF
491
492	CASE ( 'thetav' )
493	IF ( ALLOCATED( vpt_av ) ) THEN
494	DO i = nxlg, nxrg
495	DO j = nysg, nyng
496	DO k = nzb, nzt+1
497	vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d, KIND=wp )
498	ENDDO
499	ENDDO
500	ENDDO
501	ENDIF
502
503	CASE ( 'w' )
504	IF ( ALLOCATED( w_av ) ) THEN
505	DO i = nxlg, nxrg
506	DO j = nysg, nyng
507	DO k = nzb, nzt+1
508	w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND=wp )
509	ENDDO
510	ENDDO
511	ENDDO
512	ENDIF
513
514	CASE ( 'z0*' )
515	IF ( ALLOCATED( z0_av ) ) THEN
516	DO i = nxlg, nxrg
517	DO j = nysg, nyng
518	z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d, KIND=wp )
519	ENDDO
520	ENDDO
521	CALL exchange_horiz_2d( z0_av, nbgp )
522	ENDIF
523
524	CASE ( 'z0h*' )
525	IF ( ALLOCATED( z0h_av ) ) THEN
526	DO i = nxlg, nxrg
527	DO j = nysg, nyng
528	z0h_av(j,i) = z0h_av(j,i) / REAL( average_count_3d, KIND=wp )
529	ENDDO
530	ENDDO
531	CALL exchange_horiz_2d( z0h_av, nbgp )
532	ENDIF
533
534	CASE ( 'z0q*' )
535	IF ( ALLOCATED( z0q_av ) ) THEN
536	DO i = nxlg, nxrg
537	DO j = nysg, nyng
538	z0q_av(j,i) = z0q_av(j,i) / REAL( average_count_3d, KIND=wp )
539	ENDDO
540	ENDDO
541	CALL exchange_horiz_2d( z0q_av, nbgp )
542	ENDIF
543
544	CASE DEFAULT
545	!
546	!-- Averaging of data from other modules
547	IF ( air_chemistry .AND. &
548	(trimvar(1:3) == 'kc_' .OR. trimvar(1:3) == 'em_') ) THEN
549	CALL chem_3d_data_averaging( 'average', doav(ii) )
550	ENDIF
551
552	IF ( bulk_cloud_model ) THEN
553	CALL bcm_3d_data_averaging( 'average', doav(ii) )
554	ENDIF
555
556	IF ( gust_module_enabled ) THEN
557	CALL gust_3d_data_averaging( 'average', doav(ii) )
558	ENDIF
559
560	IF ( land_surface ) THEN
561	CALL lsm_3d_data_averaging( 'average', doav(ii) )
562	ENDIF
563
564	IF ( ocean_mode ) THEN
565	CALL ocean_3d_data_averaging( 'average', doav(ii) )
566	ENDIF
567
568	IF ( radiation ) THEN
569	CALL radiation_3d_data_averaging( 'average', doav(ii) )
570	ENDIF
571
572	IF ( biometeorology ) THEN
573	CALL biom_3d_data_averaging( 'average', doav(ii) )
574	ENDIF
575
576	CALL tcm_3d_data_averaging( 'average', doav(ii) )
577
578	IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN
579	CALL usm_average_3d_data( 'average', doav(ii) )
580	ENDIF
581
582	!
583	!-- User-defined quantities
584	CALL user_3d_data_averaging( 'average', doav(ii) )
585
586	END SELECT
587
588	ENDDO
589
590	!
591	!-- Reset the counter
592	average_count_3d = 0.0
593
594	CALL cpu_log( log_point(35), 'average_3d_data', 'stop' )
595
596
597	END SUBROUTINE average_3d_data

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |