Home

Context Navigation

source: palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90 @ 4504

Last change on this file since 4504 was 4457, checked in by raasch, 5 years ago
ghost point exchange modularized, bugfix for wrong 2d-exchange
Property svn:keywords set to `Id`
File size: 71.0 KB

Line
1	!> @file diagnostic_output_quantities_mod.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-2020 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! ------------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: diagnostic_output_quantities_mod.f90 4457 2020-03-11 14:20:43Z raasch $
27	! use statement for exchange horiz added,
28	! bugfix for call of exchange horiz 2d
29	!
30	! 4431 2020-02-27 23:23:01Z gronemeier
31	! added wspeed and wdir output; bugfix: set fill_value in case of masked output
32	!
33	! 4360 2020-01-07 11:25:50Z suehring
34	! added output of wu, wv, wtheta and wq to enable covariance calculation
35	! according to temporal EC method
36	!
37	! 4346 2019-12-18 11:55:56Z motisi
38	! Introduction of wall_flags_total_0, which currently sets bits based on static
39	! topography information used in wall_flags_static_0
40	!
41	! 4331 2019-12-10 18:25:02Z suehring
42	! - Modularize 2-m potential temperature output
43	! - New output for 10-m wind speed
44	!
45	! 4329 2019-12-10 15:46:36Z motisi
46	! Renamed wall_flags_0 to wall_flags_static_0
47	!
48	! 4182 2019-08-22 15:20:23Z scharf
49	! Corrected "Former revisions" section
50	!
51	! 4167 2019-08-16 11:01:48Z suehring
52	! Changed behaviour of masked output over surface to follow terrain and ignore
53	! buildings (J.Resler, T.Gronemeier)
54	!
55	! 4157 2019-08-14 09:19:12Z suehring
56	! Initialization restructured, in order to work also when data output during
57	! spin-up is enabled.
58	!
59	! 4132 2019-08-02 12:34:17Z suehring
60	! Bugfix in masked data output
61	!
62	! 4069 2019-07-01 14:05:51Z Giersch
63	! Masked output running index mid has been introduced as a local variable to
64	! avoid runtime error (Loop variable has been modified) in time_integration
65	!
66	! 4039 2019-06-18 10:32:41Z suehring
67	! - Add output of uu, vv, ww to enable variance calculation according temporal
68	! EC method
69	! - Allocate arrays only when they are required
70	! - Formatting adjustment
71	! - Rename subroutines
72	! - Further modularization
73	!
74	! 3998 2019-05-23 13:38:11Z suehring
75	! Bugfix in gathering all output strings
76	!
77	! 3995 2019-05-22 18:59:54Z suehring
78	! Avoid compiler warnings about unused variable and fix string operation which
79	! is not allowed with PGI compiler
80	!
81	! 3994 2019-05-22 18:08:09Z suehring
82	! Initial revision
83	!
84	! Authors:
85	! --------
86	! @author Farah Kanani-Suehring
87	!
88	!
89	! Description:
90	! ------------
91	!> ...
92	!------------------------------------------------------------------------------!
93	MODULE diagnostic_output_quantities_mod
94
95	USE arrays_3d, &
96	ONLY: ddzu, &
97	pt, &
98	q, &
99	u, &
100	v, &
101	w, &
102	zu, &
103	zw
104
105	USE basic_constants_and_equations_mod, &
106	ONLY: kappa, pi
107
108	USE control_parameters, &
109	ONLY: current_timestep_number, &
110	data_output, &
111	message_string, &
112	varnamelength
113	!
114	! USE cpulog, &
115	! ONLY: cpu_log, log_point
116
117	USE exchange_horiz_mod, &
118	ONLY: exchange_horiz_2d
119
120	USE grid_variables, &
121	ONLY: ddx, ddy
122
123	USE indices, &
124	ONLY: nbgp, &
125	nxl, &
126	nxlg, &
127	nxr, &
128	nxrg, &
129	nyn, &
130	nyng, &
131	nys, &
132	nysg, &
133	nzb, &
134	nzt, &
135	wall_flags_total_0
136
137	USE kinds
138
139	USE surface_mod, &
140	ONLY: surf_def_h, &
141	surf_lsm_h, &
142	surf_type, &
143	surf_usm_h
144
145
146	IMPLICIT NONE
147
148	CHARACTER(LEN=varnamelength), DIMENSION(500) :: do_all = ' '
149
150	INTEGER(iwp) :: timestep_number_at_prev_calc = 0 !< ...at previous diagnostic output calculation
151
152	LOGICAL :: initialized_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is initialized
153	LOGICAL :: prepared_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is p
154
155	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pt_2m !< 2-m air potential temperature
156	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pt_2m_av !< averaged 2-m air potential temperature
157	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uv_10m !< horizontal wind speed at 10m
158	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uv_10m_av !< averaged horizontal wind speed at 10m
159
160	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti !< rotation(u,v,w) aka turbulence intensity
161	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti_av !< avg. rotation(u,v,w) aka turbulence intensity
162	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: u_center !< u at center of grid box
163	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: u_center_av !< mean of u_center
164	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu !< uu
165	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu_av !< mean of uu
166	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wspeed !< horizontal wind speed
167	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wspeed_av !< mean of horizotal wind speed
168	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: v_center !< v at center of grid box
169	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: v_center_av !< mean of v_center
170	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv !< vv
171	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv_av !< mean of vv
172	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wdir !< wind direction
173	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wdir_av !< mean wind direction
174	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww !< ww
175	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww_av !< mean of ww
176	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu !< wu
177	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu_av !< mean of wu
178	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv !< wv
179	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv_av !< mean of wv
180	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta !< wtheta
181	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta_av !< mean of wtheta
182	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq !< wq
183	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq_av !< mean of wq
184
185
186	SAVE
187
188	PRIVATE
189
190	!
191	!-- Public variables
192	PUBLIC do_all, &
193	initialized_diagnostic_output_quantities, &
194	prepared_diagnostic_output_quantities, &
195	timestep_number_at_prev_calc, &
196	pt_2m_av, &
197	ti_av, &
198	u_center_av, &
199	uu_av, &
200	uv_10m_av, &
201	v_center_av, &
202	vv_av, &
203	wdir_av, &
204	wspeed_av, &
205	ww_av
206	!
207	!-- Public routines
208	PUBLIC doq_3d_data_averaging, &
209	doq_calculate, &
210	doq_check_data_output, &
211	doq_define_netcdf_grid, &
212	doq_output_2d, &
213	doq_output_3d, &
214	doq_output_mask, &
215	doq_init, &
216	doq_wrd_local
217	! doq_rrd_local, &
218
219
220	INTERFACE doq_3d_data_averaging
221	MODULE PROCEDURE doq_3d_data_averaging
222	END INTERFACE doq_3d_data_averaging
223
224	INTERFACE doq_calculate
225	MODULE PROCEDURE doq_calculate
226	END INTERFACE doq_calculate
227
228	INTERFACE doq_check_data_output
229	MODULE PROCEDURE doq_check_data_output
230	END INTERFACE doq_check_data_output
231
232	INTERFACE doq_define_netcdf_grid
233	MODULE PROCEDURE doq_define_netcdf_grid
234	END INTERFACE doq_define_netcdf_grid
235
236	INTERFACE doq_output_2d
237	MODULE PROCEDURE doq_output_2d
238	END INTERFACE doq_output_2d
239
240	INTERFACE doq_output_3d
241	MODULE PROCEDURE doq_output_3d
242	END INTERFACE doq_output_3d
243
244	INTERFACE doq_output_mask
245	MODULE PROCEDURE doq_output_mask
246	END INTERFACE doq_output_mask
247
248	INTERFACE doq_init
249	MODULE PROCEDURE doq_init
250	END INTERFACE doq_init
251
252	INTERFACE doq_prepare
253	MODULE PROCEDURE doq_prepare
254	END INTERFACE doq_prepare
255
256	! INTERFACE doq_rrd_local
257	! MODULE PROCEDURE doq_rrd_local
258	! END INTERFACE doq_rrd_local
259
260	INTERFACE doq_wrd_local
261	MODULE PROCEDURE doq_wrd_local
262	END INTERFACE doq_wrd_local
263
264
265	CONTAINS
266
267	!------------------------------------------------------------------------------!
268	! Description:
269	! ------------
270	!> Sum up and time-average diagnostic output quantities as well as allocate
271	!> the array necessary for storing the average.
272	!------------------------------------------------------------------------------!
273	SUBROUTINE doq_3d_data_averaging( mode, variable )
274
275	USE control_parameters, &
276	ONLY: average_count_3d
277
278	CHARACTER (LEN=*) :: mode !<
279	CHARACTER (LEN=*) :: variable !<
280
281	INTEGER(iwp) :: i !<
282	INTEGER(iwp) :: j !<
283	INTEGER(iwp) :: k !<
284
285	IF ( mode == 'allocate' ) THEN
286
287	SELECT CASE ( TRIM( variable ) )
288
289	CASE ( 'ti' )
290	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
291	ALLOCATE( ti_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
292	ENDIF
293	ti_av = 0.0_wp
294
295	CASE ( 'uu' )
296	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
297	ALLOCATE( uu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
298	ENDIF
299	uu_av = 0.0_wp
300
301	CASE ( 'vv' )
302	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
303	ALLOCATE( vv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
304	ENDIF
305	vv_av = 0.0_wp
306
307	CASE ( 'ww' )
308	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
309	ALLOCATE( ww_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
310	ENDIF
311	ww_av = 0.0_wp
312
313	CASE ( 'wu' )
314	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
315	ALLOCATE( wu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
316	ENDIF
317	wu_av = 0.0_wp
318
319	CASE ( 'wv' )
320	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
321	ALLOCATE( wv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
322	ENDIF
323	wv_av = 0.0_wp
324
325	CASE ( 'wtheta' )
326	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
327	ALLOCATE( wtheta_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
328	ENDIF
329	wtheta_av = 0.0_wp
330
331	CASE ( 'wq' )
332	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
333	ALLOCATE( wq_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
334	ENDIF
335	wq_av = 0.0_wp
336
337	CASE ( 'theta_2m*' )
338	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
339	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
340	ENDIF
341	pt_2m_av = 0.0_wp
342
343	CASE ( 'wspeed_10m*' )
344	IF ( .NOT. ALLOCATED( uv_10m_av ) ) THEN
345	ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
346	ENDIF
347	uv_10m_av = 0.0_wp
348
349	CASE ( 'wspeed' )
350	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
351	ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
352	ENDIF
353	wspeed_av = 0.0_wp
354
355	CASE ( 'wdir' )
356	IF ( .NOT. ALLOCATED( u_center_av ) ) THEN
357	ALLOCATE( u_center_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
358	ENDIF
359	IF ( .NOT. ALLOCATED( v_center_av ) ) THEN
360	ALLOCATE( v_center_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
361	ENDIF
362	u_center_av = 0.0_wp
363	v_center_av = 0.0_wp
364
365	CASE DEFAULT
366	CONTINUE
367
368	END SELECT
369
370	ELSEIF ( mode == 'sum' ) THEN
371
372	SELECT CASE ( TRIM( variable ) )
373
374	CASE ( 'ti' )
375	IF ( ALLOCATED( ti_av ) ) THEN
376	DO i = nxl, nxr
377	DO j = nys, nyn
378	DO k = nzb, nzt+1
379	ti_av(k,j,i) = ti_av(k,j,i) + ti(k,j,i)
380	ENDDO
381	ENDDO
382	ENDDO
383	ENDIF
384
385	CASE ( 'uu' )
386	IF ( ALLOCATED( uu_av ) ) THEN
387	DO i = nxl, nxr
388	DO j = nys, nyn
389	DO k = nzb, nzt+1
390	uu_av(k,j,i) = uu_av(k,j,i) + uu(k,j,i)
391	ENDDO
392	ENDDO
393	ENDDO
394	ENDIF
395
396	CASE ( 'vv' )
397	IF ( ALLOCATED( vv_av ) ) THEN
398	DO i = nxl, nxr
399	DO j = nys, nyn
400	DO k = nzb, nzt+1
401	vv_av(k,j,i) = vv_av(k,j,i) + vv(k,j,i)
402	ENDDO
403	ENDDO
404	ENDDO
405	ENDIF
406
407	CASE ( 'ww' )
408	IF ( ALLOCATED( ww_av ) ) THEN
409	DO i = nxl, nxr
410	DO j = nys, nyn
411	DO k = nzb, nzt+1
412	ww_av(k,j,i) = ww_av(k,j,i) + ww(k,j,i)
413	ENDDO
414	ENDDO
415	ENDDO
416	ENDIF
417
418	CASE ( 'wu' )
419	IF ( ALLOCATED( wu_av ) ) THEN
420	DO i = nxl, nxr
421	DO j = nys, nyn
422	DO k = nzb, nzt+1
423	wu_av(k,j,i) = wu_av(k,j,i) + wu(k,j,i)
424	ENDDO
425	ENDDO
426	ENDDO
427	ENDIF
428
429	CASE ( 'wv' )
430	IF ( ALLOCATED( wv_av ) ) THEN
431	DO i = nxl, nxr
432	DO j = nys, nyn
433	DO k = nzb, nzt+1
434	wv_av(k,j,i) = wv_av(k,j,i) + wv(k,j,i)
435	ENDDO
436	ENDDO
437	ENDDO
438	ENDIF
439
440	CASE ( 'wtheta' )
441	IF ( ALLOCATED( wtheta_av ) ) THEN
442	DO i = nxl, nxr
443	DO j = nys, nyn
444	DO k = nzb, nzt+1
445	wtheta_av(k,j,i) = wtheta_av(k,j,i) + wtheta(k,j,i)
446	ENDDO
447	ENDDO
448	ENDDO
449	ENDIF
450
451	CASE ( 'wq' )
452	IF ( ALLOCATED( wq_av ) ) THEN
453	DO i = nxl, nxr
454	DO j = nys, nyn
455	DO k = nzb, nzt+1
456	wq_av(k,j,i) = wq_av(k,j,i) + wq(k,j,i)
457	ENDDO
458	ENDDO
459	ENDDO
460	ENDIF
461
462	CASE ( 'theta_2m*' )
463	IF ( ALLOCATED( pt_2m_av ) ) THEN
464	DO i = nxl, nxr
465	DO j = nys, nyn
466	pt_2m_av(j,i) = pt_2m_av(j,i) + pt_2m(j,i)
467	ENDDO
468	ENDDO
469	ENDIF
470
471	CASE ( 'wspeed_10m*' )
472	IF ( ALLOCATED( uv_10m_av ) ) THEN
473	DO i = nxl, nxr
474	DO j = nys, nyn
475	uv_10m_av(j,i) = uv_10m_av(j,i) + uv_10m(j,i)
476	ENDDO
477	ENDDO
478	ENDIF
479
480	CASE ( 'wspeed' )
481	IF ( ALLOCATED( wspeed_av ) ) THEN
482	DO i = nxl, nxr
483	DO j = nys, nyn
484	DO k = nzb, nzt+1
485	wspeed_av(k,j,i) = wspeed_av(k,j,i) + wspeed(k,j,i)
486	ENDDO
487	ENDDO
488	ENDDO
489	ENDIF
490
491	CASE ( 'wdir' )
492	IF ( ALLOCATED( u_center_av ) .AND. ALLOCATED( v_center_av ) ) THEN
493	DO i = nxl, nxr
494	DO j = nys, nyn
495	DO k = nzb, nzt+1
496	u_center_av(k,j,i) = u_center_av(k,j,i) + u_center(k,j,i)
497	v_center_av(k,j,i) = v_center_av(k,j,i) + v_center(k,j,i)
498	ENDDO
499	ENDDO
500	ENDDO
501	ENDIF
502
503	CASE DEFAULT
504	CONTINUE
505
506	END SELECT
507
508	ELSEIF ( mode == 'average' ) THEN
509
510	SELECT CASE ( TRIM( variable ) )
511
512	CASE ( 'ti' )
513	IF ( ALLOCATED( ti_av ) ) THEN
514	DO i = nxl, nxr
515	DO j = nys, nyn
516	DO k = nzb, nzt+1
517	ti_av(k,j,i) = ti_av(k,j,i) / REAL( average_count_3d, KIND=wp )
518	ENDDO
519	ENDDO
520	ENDDO
521	ENDIF
522
523	CASE ( 'uu' )
524	IF ( ALLOCATED( uu_av ) ) THEN
525	DO i = nxl, nxr
526	DO j = nys, nyn
527	DO k = nzb, nzt+1
528	uu_av(k,j,i) = uu_av(k,j,i) / REAL( average_count_3d, KIND=wp )
529	ENDDO
530	ENDDO
531	ENDDO
532	ENDIF
533
534	CASE ( 'vv' )
535	IF ( ALLOCATED( vv_av ) ) THEN
536	DO i = nxl, nxr
537	DO j = nys, nyn
538	DO k = nzb, nzt+1
539	vv_av(k,j,i) = vv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
540	ENDDO
541	ENDDO
542	ENDDO
543	ENDIF
544
545	CASE ( 'ww' )
546	IF ( ALLOCATED( ww_av ) ) THEN
547	DO i = nxl, nxr
548	DO j = nys, nyn
549	DO k = nzb, nzt+1
550	ww_av(k,j,i) = ww_av(k,j,i) / REAL( average_count_3d, KIND=wp )
551	ENDDO
552	ENDDO
553	ENDDO
554	ENDIF
555
556	CASE ( 'wu' )
557	IF ( ALLOCATED( wu_av ) ) THEN
558	DO i = nxl, nxr
559	DO j = nys, nyn
560	DO k = nzb, nzt+1
561	wu_av(k,j,i) = wu_av(k,j,i) / REAL( average_count_3d, KIND=wp )
562	ENDDO
563	ENDDO
564	ENDDO
565	ENDIF
566
567	CASE ( 'wv' )
568	IF ( ALLOCATED( wv_av ) ) THEN
569	DO i = nxl, nxr
570	DO j = nys, nyn
571	DO k = nzb, nzt+1
572	wv_av(k,j,i) = wv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
573	ENDDO
574	ENDDO
575	ENDDO
576	ENDIF
577
578	CASE ( 'wtheta' )
579	IF ( ALLOCATED( wtheta_av ) ) THEN
580	DO i = nxl, nxr
581	DO j = nys, nyn
582	DO k = nzb, nzt+1
583	wtheta_av(k,j,i) = wtheta_av(k,j,i) / REAL( average_count_3d, KIND=wp )
584	ENDDO
585	ENDDO
586	ENDDO
587	ENDIF
588
589	CASE ( 'wq' )
590	IF ( ALLOCATED( wq_av ) ) THEN
591	DO i = nxl, nxr
592	DO j = nys, nyn
593	DO k = nzb, nzt+1
594	wq_av(k,j,i) = wq_av(k,j,i) / REAL( average_count_3d, KIND=wp )
595	ENDDO
596	ENDDO
597	ENDDO
598	ENDIF
599
600	CASE ( 'theta_2m*' )
601	IF ( ALLOCATED( pt_2m_av ) ) THEN
602	DO i = nxlg, nxrg
603	DO j = nysg, nyng
604	pt_2m_av(j,i) = pt_2m_av(j,i) / REAL( average_count_3d, KIND=wp )
605	ENDDO
606	ENDDO
607	CALL exchange_horiz_2d( pt_2m_av )
608	ENDIF
609
610	CASE ( 'wspeed_10m*' )
611	IF ( ALLOCATED( uv_10m_av ) ) THEN
612	DO i = nxlg, nxrg
613	DO j = nysg, nyng
614	uv_10m_av(j,i) = uv_10m_av(j,i) / REAL( average_count_3d, KIND=wp )
615	ENDDO
616	ENDDO
617	CALL exchange_horiz_2d( uv_10m_av )
618	ENDIF
619
620	CASE ( 'wspeed' )
621	IF ( ALLOCATED( wspeed_av ) ) THEN
622	DO i = nxl, nxr
623	DO j = nys, nyn
624	DO k = nzb, nzt+1
625	wspeed_av(k,j,i) = wspeed_av(k,j,i) / REAL( average_count_3d, KIND=wp )
626	ENDDO
627	ENDDO
628	ENDDO
629	ENDIF
630
631	CASE ( 'wdir' )
632	IF ( ALLOCATED( u_center_av ) .AND. ALLOCATED( v_center_av ) ) THEN
633
634	IF ( .NOT. ALLOCATED( wdir_av ) ) THEN
635	ALLOCATE( wdir_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
636	ENDIF
637	wdir_av = 0.0_wp
638
639	DO i = nxl, nxr
640	DO j = nys, nyn
641	DO k = nzb, nzt+1
642	u_center_av(k,j,i) = u_center_av(k,j,i) / REAL( average_count_3d, KIND=wp )
643	v_center_av(k,j,i) = v_center_av(k,j,i) / REAL( average_count_3d, KIND=wp )
644	wdir_av(k,j,i) = ATAN2( u_center_av(k,j,i), v_center_av(k,j,i) ) &
645	/ pi * 180.0_wp + 180.0_wp
646	ENDDO
647	ENDDO
648	ENDDO
649	ENDIF
650
651	END SELECT
652
653	ENDIF
654
655
656	END SUBROUTINE doq_3d_data_averaging
657
658	!------------------------------------------------------------------------------!
659	! Description:
660	! ------------
661	!> Check data output for diagnostic output
662	!------------------------------------------------------------------------------!
663	SUBROUTINE doq_check_data_output( var, unit, i, ilen, k )
664
665	IMPLICIT NONE
666
667	CHARACTER (LEN=*) :: unit !<
668	CHARACTER (LEN=*) :: var !<
669
670	INTEGER(iwp), OPTIONAL, INTENT(IN) :: i !< Current element of data_output
671	INTEGER(iwp), OPTIONAL, INTENT(IN) :: ilen !< Length of current entry in data_output
672	INTEGER(iwp), OPTIONAL, INTENT(IN) :: k !< Output is xy mode? 0 = no, 1 = yes
673
674	SELECT CASE ( TRIM( var ) )
675
676	CASE ( 'ti' )
677	unit = '1/s'
678
679	CASE ( 'uu' )
680	unit = 'm2/s2'
681
682	CASE ( 'vv' )
683	unit = 'm2/s2'
684
685	CASE ( 'ww' )
686	unit = 'm2/s2'
687
688	CASE ( 'wu' )
689	unit = 'm2/s2'
690
691	CASE ( 'wv' )
692	unit = 'm2/s2'
693
694	CASE ( 'wtheta' )
695	unit = 'Km/s'
696
697	CASE ( 'wq' )
698	unit = 'm/s'
699
700	CASE ( 'wspeed' )
701	unit = 'm/s'
702
703	CASE ( 'wdir' )
704	unit = 'degree'
705	!
706	!-- Treat horizotal cross-section output quanatities
707	CASE ( 'theta_2m', 'wspeed_10m' )
708	!
709	!-- Check if output quantity is _xy only.
710	IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN
711	message_string = 'illegal value for data_output: "' // &
712	TRIM( var ) // '" & only 2d-horizontal ' // &
713	'cross sections are allowed for this value'
714	CALL message( 'diagnostic_output', 'PA0111', 1, 2, 0, 6, 0 )
715	ENDIF
716
717	IF ( TRIM( var ) == 'theta_2m*' ) unit = 'K'
718	IF ( TRIM( var ) == 'wspeed_10m*' ) unit = 'm/s'
719
720	CASE DEFAULT
721	unit = 'illegal'
722
723	END SELECT
724
725
726	END SUBROUTINE doq_check_data_output
727
728	!------------------------------------------------------------------------------!
729	!
730	! Description:
731	! ------------
732	!> Subroutine defining appropriate grid for netcdf variables.
733	!------------------------------------------------------------------------------!
734	SUBROUTINE doq_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
735
736	IMPLICIT NONE
737
738	CHARACTER (LEN=*), INTENT(IN) :: variable !<
739	LOGICAL, INTENT(OUT) :: found !<
740	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
741	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
742	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
743
744	found = .TRUE.
745
746	SELECT CASE ( TRIM( variable ) )
747	!
748	!-- s grid
749	CASE ( 'ti', 'ti_xy', 'ti_xz', 'ti_yz', &
750	'wspeed', 'wspeed_xy', 'wspeed_xz', 'wspeed_yz', &
751	'wdir', 'wdir_xy', 'wdir_xz', 'wdir_yz', &
752	'wu', 'wu_xy', 'wu_xz', 'wu_yz', &
753	'wv', 'wv_xy', 'wv_xz', 'wv_yz', &
754	'wtheta', 'wtheta_xy', 'wtheta_xz', 'wtheta_yz', &
755	'wq', 'wq_xy', 'wq_xz', 'wq_yz')
756
757	grid_x = 'x'
758	grid_y = 'y'
759	grid_z = 'zu'
760	!
761	!-- s grid surface variables
762	CASE ( 'theta_2m_xy', 'wspeed_10m' )
763
764	grid_x = 'x'
765	grid_y = 'y'
766	grid_z = 'zu'
767	!
768	!-- u grid
769	CASE ( 'uu', 'uu_xy', 'uu_xz', 'uu_yz' )
770
771	grid_x = 'xu'
772	grid_y = 'y'
773	grid_z = 'zu'
774	!
775	!-- v grid
776	CASE ( 'vv', 'vv_xy', 'vv_xz', 'vv_yz' )
777
778	grid_x = 'x'
779	grid_y = 'yv'
780	grid_z = 'zu'
781	!
782	!-- w grid
783	CASE ( 'ww', 'ww_xy', 'ww_xz', 'ww_yz' )
784
785	grid_x = 'x'
786	grid_y = 'y'
787	grid_z = 'zw'
788
789	CASE DEFAULT
790	found = .FALSE.
791	grid_x = 'none'
792	grid_y = 'none'
793	grid_z = 'none'
794
795	END SELECT
796
797
798	END SUBROUTINE doq_define_netcdf_grid
799
800	!------------------------------------------------------------------------------!
801	!
802	! Description:
803	! ------------
804	!> Subroutine defining 2D output variables
805	!------------------------------------------------------------------------------!
806	SUBROUTINE doq_output_2d( av, variable, found, grid, &
807	mode, local_pf, two_d, nzb_do, nzt_do, fill_value )
808
809
810	IMPLICIT NONE
811
812	CHARACTER (LEN=*) :: grid !<
813	CHARACTER (LEN=*) :: mode !<
814	CHARACTER (LEN=*) :: variable !<
815
816	INTEGER(iwp) :: av !< value indicating averaged or non-averaged output
817	INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
818	INTEGER(iwp) :: i !< grid index x-direction
819	INTEGER(iwp) :: j !< grid index y-direction
820	INTEGER(iwp) :: k !< grid index z-direction
821	INTEGER(iwp) :: nzb_do !<
822	INTEGER(iwp) :: nzt_do !<
823
824	LOGICAL :: found !< true if variable is in list
825	LOGICAL :: resorted !< true if array is resorted
826	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
827
828	REAL(wp) :: fill_value !< value for the _FillValue attribute
829
830	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
831	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output
832
833	flag_nr = 0
834	found = .TRUE.
835	resorted = .FALSE.
836	two_d = .FALSE.
837
838	SELECT CASE ( TRIM( variable ) )
839
840	CASE ( 'ti_xy', 'ti_xz', 'ti_yz' )
841	IF ( av == 0 ) THEN
842	to_be_resorted => ti
843	ELSE
844	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
845	ALLOCATE( ti_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
846	ti_av = REAL( fill_value, KIND = wp )
847	ENDIF
848	to_be_resorted => ti_av
849	ENDIF
850	flag_nr = 0
851
852	IF ( mode == 'xy' ) grid = 'zu'
853
854	CASE ( 'uu_xy', 'uu_xz', 'uu_yz' )
855	IF ( av == 0 ) THEN
856	to_be_resorted => uu
857	ELSE
858	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
859	ALLOCATE( uu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
860	uu_av = REAL( fill_value, KIND = wp )
861	ENDIF
862	to_be_resorted => uu_av
863	ENDIF
864	flag_nr = 1
865
866	IF ( mode == 'xy' ) grid = 'zu'
867
868	CASE ( 'vv_xy', 'vv_xz', 'vv_yz' )
869	IF ( av == 0 ) THEN
870	to_be_resorted => vv
871	ELSE
872	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
873	ALLOCATE( vv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
874	vv_av = REAL( fill_value, KIND = wp )
875	ENDIF
876	to_be_resorted => vv_av
877	ENDIF
878	flag_nr = 2
879
880	IF ( mode == 'xy' ) grid = 'zu'
881
882	CASE ( 'ww_xy', 'ww_xz', 'ww_yz' )
883	IF ( av == 0 ) THEN
884	to_be_resorted => ww
885	ELSE
886	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
887	ALLOCATE( ww_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
888	ww_av = REAL( fill_value, KIND = wp )
889	ENDIF
890	to_be_resorted => ww_av
891	ENDIF
892	flag_nr = 3
893
894	IF ( mode == 'xy' ) grid = 'zw'
895
896	CASE ( 'wu_xy', 'wu_xz', 'wu_yz' )
897	IF ( av == 0 ) THEN
898	to_be_resorted => wu
899	ELSE
900	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
901	ALLOCATE( wu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
902	wu_av = REAL( fill_value, KIND = wp )
903	ENDIF
904	to_be_resorted => wu_av
905	ENDIF
906	flag_nr = 0
907
908	IF ( mode == 'xy' ) grid = 'zw'
909
910	CASE ( 'wv_xy', 'wv_xz', 'wv_yz' )
911	IF ( av == 0 ) THEN
912	to_be_resorted => wv
913	ELSE
914	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
915	ALLOCATE( wv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
916	wv_av = REAL( fill_value, KIND = wp )
917	ENDIF
918	to_be_resorted => wv_av
919	ENDIF
920	flag_nr = 0
921
922	IF ( mode == 'xy' ) grid = 'zw'
923
924	CASE ( 'wtheta_xy', 'wtheta_xz', 'wtheta_yz' )
925	IF ( av == 0 ) THEN
926	to_be_resorted => wtheta
927	ELSE
928	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
929	ALLOCATE( wtheta_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
930	wtheta_av = REAL( fill_value, KIND = wp )
931	ENDIF
932	to_be_resorted => wtheta_av
933	ENDIF
934	flag_nr = 0
935
936	IF ( mode == 'xy' ) grid = 'zw'
937
938	CASE ( 'wq_xy', 'wq_xz', 'wq_yz' )
939	IF ( av == 0 ) THEN
940	to_be_resorted => wq
941	ELSE
942	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
943	ALLOCATE( wq_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
944	wq_av = REAL( fill_value, KIND = wp )
945	ENDIF
946	to_be_resorted => wq_av
947	ENDIF
948	flag_nr = 0
949
950	IF ( mode == 'xy' ) grid = 'zw'
951
952	CASE ( 'theta_2m*_xy' ) ! 2d-array
953	IF ( av == 0 ) THEN
954	DO i = nxl, nxr
955	DO j = nys, nyn
956	local_pf(i,j,nzb+1) = pt_2m(j,i)
957	ENDDO
958	ENDDO
959	ELSE
960	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
961	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
962	pt_2m_av = REAL( fill_value, KIND = wp )
963	ENDIF
964	DO i = nxl, nxr
965	DO j = nys, nyn
966	local_pf(i,j,nzb+1) = pt_2m_av(j,i)
967	ENDDO
968	ENDDO
969	ENDIF
970	resorted = .TRUE.
971	two_d = .TRUE.
972	grid = 'zu1'
973
974	CASE ( 'wspeed_10m*_xy' ) ! 2d-array
975	IF ( av == 0 ) THEN
976	DO i = nxl, nxr
977	DO j = nys, nyn
978	local_pf(i,j,nzb+1) = uv_10m(j,i)
979	ENDDO
980	ENDDO
981	ELSE
982	IF ( .NOT. ALLOCATED( uv_10m_av ) ) THEN
983	ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
984	uv_10m_av = REAL( fill_value, KIND = wp )
985	ENDIF
986	DO i = nxl, nxr
987	DO j = nys, nyn
988	local_pf(i,j,nzb+1) = uv_10m_av(j,i)
989	ENDDO
990	ENDDO
991	ENDIF
992	resorted = .TRUE.
993	two_d = .TRUE.
994	grid = 'zu1'
995
996	CASE ( 'wspeed_xy', 'wspeed_xz', 'wspeed_yz' )
997	IF ( av == 0 ) THEN
998	to_be_resorted => wspeed
999	ELSE
1000	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
1001	ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1002	wspeed_av = REAL( fill_value, KIND = wp )
1003	ENDIF
1004	to_be_resorted => wspeed_av
1005	ENDIF
1006	flag_nr = 0
1007
1008	IF ( mode == 'xy' ) grid = 'zu'
1009
1010	CASE ( 'wdir_xy', 'wdir_xz', 'wdir_yz' )
1011	IF ( av == 0 ) THEN
1012	to_be_resorted => wdir
1013	ELSE
1014	IF ( .NOT. ALLOCATED( wdir_av ) ) THEN
1015	ALLOCATE( wdir_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1016	wdir_av = REAL( fill_value, KIND = wp )
1017	ENDIF
1018	to_be_resorted => wdir_av
1019	ENDIF
1020	flag_nr = 0
1021
1022	IF ( mode == 'xy' ) grid = 'zu'
1023
1024	CASE DEFAULT
1025	found = .FALSE.
1026	grid = 'none'
1027
1028	END SELECT
1029
1030	IF ( found .AND. .NOT. resorted ) THEN
1031	DO i = nxl, nxr
1032	DO j = nys, nyn
1033	DO k = nzb_do, nzt_do
1034	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1035	REAL( fill_value, KIND = wp ), &
1036	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
1037	ENDDO
1038	ENDDO
1039	ENDDO
1040	ENDIF
1041
1042	END SUBROUTINE doq_output_2d
1043
1044
1045	!------------------------------------------------------------------------------!
1046	!
1047	! Description:
1048	! ------------
1049	!> Subroutine defining 3D output variables
1050	!------------------------------------------------------------------------------!
1051	SUBROUTINE doq_output_3d( av, variable, found, local_pf, fill_value, nzb_do, &
1052	nzt_do )
1053
1054	IMPLICIT NONE
1055
1056	CHARACTER (LEN=*) :: variable !<
1057
1058	INTEGER(iwp) :: av !< index indicating averaged or instantaneous output
1059	INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
1060	INTEGER(iwp) :: i !< index variable along x-direction
1061	INTEGER(iwp) :: j !< index variable along y-direction
1062	INTEGER(iwp) :: k !< index variable along z-direction
1063	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
1064	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
1065
1066	LOGICAL :: found !< true if variable is in list
1067	LOGICAL :: resorted !< true if array is resorted
1068
1069	REAL(wp) :: fill_value !< value for the _FillValue attribute
1070
1071	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
1072	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output
1073
1074	flag_nr = 0
1075	found = .TRUE.
1076	resorted = .FALSE.
1077
1078	SELECT CASE ( TRIM( variable ) )
1079
1080	CASE ( 'ti' )
1081	IF ( av == 0 ) THEN
1082	to_be_resorted => ti
1083	ELSE
1084	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
1085	ALLOCATE( ti_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1086	ti_av = REAL( fill_value, KIND = wp )
1087	ENDIF
1088	to_be_resorted => ti_av
1089	ENDIF
1090	flag_nr = 0
1091
1092	CASE ( 'uu' )
1093	IF ( av == 0 ) THEN
1094	to_be_resorted => uu
1095	ELSE
1096	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
1097	ALLOCATE( uu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1098	uu_av = REAL( fill_value, KIND = wp )
1099	ENDIF
1100	to_be_resorted => uu_av
1101	ENDIF
1102	flag_nr = 1
1103
1104	CASE ( 'vv' )
1105	IF ( av == 0 ) THEN
1106	to_be_resorted => vv
1107	ELSE
1108	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
1109	ALLOCATE( vv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1110	vv_av = REAL( fill_value, KIND = wp )
1111	ENDIF
1112	to_be_resorted => vv_av
1113	ENDIF
1114	flag_nr = 2
1115
1116	CASE ( 'ww' )
1117	IF ( av == 0 ) THEN
1118	to_be_resorted => ww
1119	ELSE
1120	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
1121	ALLOCATE( ww_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1122	ww_av = REAL( fill_value, KIND = wp )
1123	ENDIF
1124	to_be_resorted => ww_av
1125	ENDIF
1126	flag_nr = 3
1127
1128	CASE ( 'wu' )
1129	IF ( av == 0 ) THEN
1130	to_be_resorted => wu
1131	ELSE
1132	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
1133	ALLOCATE( wu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1134	wu_av = REAL( fill_value, KIND = wp )
1135	ENDIF
1136	to_be_resorted => wu_av
1137	ENDIF
1138	flag_nr = 0
1139
1140	CASE ( 'wv' )
1141	IF ( av == 0 ) THEN
1142	to_be_resorted => wv
1143	ELSE
1144	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
1145	ALLOCATE( wv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1146	wv_av = REAL( fill_value, KIND = wp )
1147	ENDIF
1148	to_be_resorted => wv_av
1149	ENDIF
1150	flag_nr = 0
1151
1152	CASE ( 'wtheta' )
1153	IF ( av == 0 ) THEN
1154	to_be_resorted => wtheta
1155	ELSE
1156	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
1157	ALLOCATE( wtheta_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1158	wtheta_av = REAL( fill_value, KIND = wp )
1159	ENDIF
1160	to_be_resorted => wtheta_av
1161	ENDIF
1162	flag_nr = 0
1163
1164	CASE ( 'wq' )
1165	IF ( av == 0 ) THEN
1166	to_be_resorted => wq
1167	ELSE
1168	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
1169	ALLOCATE( wq_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1170	wq_av = REAL( fill_value, KIND = wp )
1171	ENDIF
1172	to_be_resorted => wq_av
1173	ENDIF
1174	flag_nr = 0
1175
1176	CASE ( 'wspeed' )
1177	IF ( av == 0 ) THEN
1178	to_be_resorted => wspeed
1179	ELSE
1180	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
1181	ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1182	wspeed_av = REAL( fill_value, KIND = wp )
1183	ENDIF
1184	to_be_resorted => wspeed_av
1185	ENDIF
1186	flag_nr = 0
1187
1188	CASE ( 'wdir' )
1189	IF ( av == 0 ) THEN
1190	to_be_resorted => wdir
1191	ELSE
1192	IF ( .NOT. ALLOCATED( wdir_av ) ) THEN
1193	ALLOCATE( wdir_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1194	wdir_av = REAL( fill_value, KIND = wp )
1195	ENDIF
1196	to_be_resorted => wdir_av
1197	ENDIF
1198	flag_nr = 0
1199
1200	CASE DEFAULT
1201	found = .FALSE.
1202
1203	END SELECT
1204
1205	IF ( found .AND. .NOT. resorted ) THEN
1206	DO i = nxl, nxr
1207	DO j = nys, nyn
1208	DO k = nzb_do, nzt_do
1209	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1210	REAL( fill_value, KIND = wp ), &
1211	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
1212	ENDDO
1213	ENDDO
1214	ENDDO
1215	ENDIF
1216
1217	END SUBROUTINE doq_output_3d
1218
1219	! Description:
1220	! ------------
1221	!> Resorts the user-defined output quantity with indices (k,j,i) to a
1222	!> temporary array with indices (i,j,k) for masked data output.
1223	!------------------------------------------------------------------------------!
1224	SUBROUTINE doq_output_mask( av, variable, found, local_pf, mid )
1225
1226	USE control_parameters
1227
1228	USE indices
1229
1230	IMPLICIT NONE
1231
1232	CHARACTER (LEN=*) :: variable !<
1233	CHARACTER (LEN=5) :: grid !< flag to distinquish between staggered grids
1234
1235	INTEGER(iwp) :: av !< index indicating averaged or instantaneous output
1236	INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
1237	INTEGER(iwp) :: i !< index variable along x-direction
1238	INTEGER(iwp) :: j !< index variable along y-direction
1239	INTEGER(iwp) :: k !< index variable along z-direction
1240	INTEGER(iwp) :: im !< loop index for masked variables
1241	INTEGER(iwp) :: jm !< loop index for masked variables
1242	INTEGER(iwp) :: kk !< masked output index variable along z-direction
1243	INTEGER(iwp) :: mid !< masked output running index
1244	INTEGER(iwp) :: ktt !< k index of highest horizontal surface
1245
1246	LOGICAL :: found !< true if variable is in list
1247	LOGICAL :: resorted !< true if array is resorted
1248
1249	REAL(wp), &
1250	DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: &
1251	local_pf !<
1252	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output
1253
1254	REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute
1255
1256	flag_nr = 0
1257	found = .TRUE.
1258	resorted = .FALSE.
1259	grid = 's'
1260
1261	SELECT CASE ( TRIM( variable ) )
1262
1263	CASE ( 'ti' )
1264	IF ( av == 0 ) THEN
1265	to_be_resorted => ti
1266	ELSE
1267	to_be_resorted => ti_av
1268	ENDIF
1269	grid = 's'
1270	flag_nr = 0
1271
1272	CASE ( 'uu' )
1273	IF ( av == 0 ) THEN
1274	to_be_resorted => uu
1275	ELSE
1276	to_be_resorted => uu_av
1277	ENDIF
1278	grid = 'u'
1279	flag_nr = 1
1280
1281	CASE ( 'vv' )
1282	IF ( av == 0 ) THEN
1283	to_be_resorted => vv
1284	ELSE
1285	to_be_resorted => vv_av
1286	ENDIF
1287	grid = 'v'
1288	flag_nr = 2
1289
1290	CASE ( 'ww' )
1291	IF ( av == 0 ) THEN
1292	to_be_resorted => ww
1293	ELSE
1294	to_be_resorted => ww_av
1295	ENDIF
1296	grid = 'w'
1297	flag_nr = 3
1298
1299	CASE ( 'wu' )
1300	IF ( av == 0 ) THEN
1301	to_be_resorted => wu
1302	ELSE
1303	to_be_resorted => wu_av
1304	ENDIF
1305	grid = 's'
1306	flag_nr = 0
1307
1308	CASE ( 'wv' )
1309	IF ( av == 0 ) THEN
1310	to_be_resorted => wv
1311	ELSE
1312	to_be_resorted => wv_av
1313	ENDIF
1314	grid = 's'
1315	flag_nr = 0
1316
1317	CASE ( 'wtheta' )
1318	IF ( av == 0 ) THEN
1319	to_be_resorted => wtheta
1320	ELSE
1321	to_be_resorted => wtheta_av
1322	ENDIF
1323	grid = 's'
1324	flag_nr = 0
1325
1326	CASE ( 'wq' )
1327	IF ( av == 0 ) THEN
1328	to_be_resorted => wq
1329	ELSE
1330	to_be_resorted => wq_av
1331	ENDIF
1332	grid = 's'
1333	flag_nr = 0
1334
1335	CASE ( 'wspeed' )
1336	IF ( av == 0 ) THEN
1337	to_be_resorted => wspeed
1338	ELSE
1339	to_be_resorted => wspeed_av
1340	ENDIF
1341	grid = 's'
1342	flag_nr = 0
1343
1344	CASE ( 'wdir' )
1345	IF ( av == 0 ) THEN
1346	to_be_resorted => wdir
1347	ELSE
1348	to_be_resorted => wdir_av
1349	ENDIF
1350	grid = 's'
1351	flag_nr = 0
1352
1353	CASE DEFAULT
1354	found = .FALSE.
1355
1356	END SELECT
1357
1358	IF ( found .AND. .NOT. resorted ) THEN
1359	IF ( .NOT. mask_surface(mid) ) THEN
1360	!
1361	!-- Default masked output
1362	DO i = 1, mask_size_l(mid,1)
1363	DO j = 1, mask_size_l(mid,2)
1364	DO k = 1, mask_size_l(mid,3)
1365	local_pf(i,j,k) = MERGE( to_be_resorted(mask_k(mid,k), &
1366	mask_j(mid,j), &
1367	mask_i(mid,i)), &
1368	REAL( fill_value, KIND = wp ), &
1369	BTEST( wall_flags_total_0( &
1370	mask_k(mid,k), &
1371	mask_j(mid,j), &
1372	mask_i(mid,i)), &
1373	flag_nr ) )
1374	ENDDO
1375	ENDDO
1376	ENDDO
1377
1378	ELSE
1379	!
1380	!-- Terrain-following masked output
1381	DO i = 1, mask_size_l(mid,1)
1382	DO j = 1, mask_size_l(mid,2)
1383	!
1384	!-- Get k index of the highest terraing surface
1385	im = mask_i(mid,i)
1386	jm = mask_j(mid,j)
1387	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
1388	DIM = 1 ) - 1
1389	DO k = 1, mask_size_l(mid,3)
1390	kk = MIN( ktt+mask_k(mid,k), nzt+1 )
1391	!
1392	!-- Set value if not in building
1393	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
1394	local_pf(i,j,k) = fill_value
1395	ELSE
1396	local_pf(i,j,k) = to_be_resorted(kk,jm,im)
1397	ENDIF
1398	ENDDO
1399	ENDDO
1400	ENDDO
1401
1402	ENDIF
1403	ENDIF
1404
1405	END SUBROUTINE doq_output_mask
1406
1407	!------------------------------------------------------------------------------!
1408	! Description:
1409	! ------------
1410	!> Allocate required arrays
1411	!------------------------------------------------------------------------------!
1412	SUBROUTINE doq_init
1413
1414	IMPLICIT NONE
1415
1416	INTEGER(iwp) :: ivar !< loop index over all 2d/3d/mask output quantities
1417
1418	!
1419	!-- Next line is to avoid compiler warnings about unused variables
1420	IF ( timestep_number_at_prev_calc == 0 ) CONTINUE
1421	!
1422	!-- Preparatory steps and initialization of output arrays
1423	IF ( .NOT. prepared_diagnostic_output_quantities ) CALL doq_prepare
1424
1425	initialized_diagnostic_output_quantities = .FALSE.
1426
1427	ivar = 1
1428
1429	DO WHILE ( ivar <= SIZE( do_all ) )
1430
1431	SELECT CASE ( TRIM( do_all(ivar) ) )
1432	!
1433	!-- Allocate array for 'turbulence intensity'
1434	CASE ( 'ti' )
1435	IF ( .NOT. ALLOCATED( ti ) ) THEN
1436	ALLOCATE( ti(nzb:nzt+1,nys:nyn,nxl:nxr) )
1437	ti = 0.0_wp
1438	ENDIF
1439	!
1440	!-- Allocate array for uu
1441	CASE ( 'uu' )
1442	IF ( .NOT. ALLOCATED( uu ) ) THEN
1443	ALLOCATE( uu(nzb:nzt+1,nys:nyn,nxl:nxr) )
1444	uu = 0.0_wp
1445	ENDIF
1446	!
1447	!-- Allocate array for vv
1448	CASE ( 'vv' )
1449	IF ( .NOT. ALLOCATED( vv ) ) THEN
1450	ALLOCATE( vv(nzb:nzt+1,nys:nyn,nxl:nxr) )
1451	vv = 0.0_wp
1452	ENDIF
1453	!
1454	!-- Allocate array for ww
1455	CASE ( 'ww' )
1456	IF ( .NOT. ALLOCATED( ww ) ) THEN
1457	ALLOCATE( ww(nzb:nzt+1,nys:nyn,nxl:nxr) )
1458	ww = 0.0_wp
1459	ENDIF
1460	!
1461	!-- Allocate array for wu
1462	CASE ( 'wu' )
1463	IF ( .NOT. ALLOCATED( wu ) ) THEN
1464	ALLOCATE( wu(nzb:nzt+1,nys:nyn,nxl:nxr) )
1465	wu = 0.0_wp
1466	ENDIF
1467	!
1468	!-- Allocate array for wv
1469	CASE ( 'wv' )
1470	IF ( .NOT. ALLOCATED( wv ) ) THEN
1471	ALLOCATE( wv(nzb:nzt+1,nys:nyn,nxl:nxr) )
1472	wv = 0.0_wp
1473	ENDIF
1474	!
1475	!-- Allocate array for wtheta
1476	CASE ( 'wtheta' )
1477	IF ( .NOT. ALLOCATED( wtheta ) ) THEN
1478	ALLOCATE( wtheta(nzb:nzt+1,nys:nyn,nxl:nxr) )
1479	wtheta = 0.0_wp
1480	ENDIF
1481	!
1482	!-- Allocate array for wq
1483	CASE ( 'wq' )
1484	IF ( .NOT. ALLOCATED( wq ) ) THEN
1485	ALLOCATE( wq(nzb:nzt+1,nys:nyn,nxl:nxr) )
1486	wq = 0.0_wp
1487	ENDIF
1488	!
1489	!-- Allocate array for 2-m potential temperature
1490	CASE ( 'theta_2m*' )
1491	IF ( .NOT. ALLOCATED( pt_2m ) ) THEN
1492	ALLOCATE( pt_2m(nys:nyn,nxl:nxr) )
1493	pt_2m = 0.0_wp
1494	ENDIF
1495	!
1496	!-- Allocate array for 10-m wind speed
1497	CASE ( 'wspeed_10m*' )
1498	IF ( .NOT. ALLOCATED( uv_10m ) ) THEN
1499	ALLOCATE( uv_10m(nys:nyn,nxl:nxr) )
1500	uv_10m = 0.0_wp
1501	ENDIF
1502	!
1503	!-- Allocate array for wspeed
1504	CASE ( 'wspeed' )
1505	IF ( .NOT. ALLOCATED( wspeed ) ) THEN
1506	ALLOCATE( wspeed(nzb:nzt+1,nys:nyn,nxl:nxr) )
1507	wspeed = 0.0_wp
1508	ENDIF
1509
1510	!
1511	!-- Allocate array for wdir
1512	CASE ( 'wdir' )
1513	IF ( .NOT. ALLOCATED( u_center ) ) THEN
1514	ALLOCATE( u_center(nzb:nzt+1,nys:nyn,nxl:nxr) )
1515	u_center = 0.0_wp
1516	ENDIF
1517	IF ( .NOT. ALLOCATED( v_center ) ) THEN
1518	ALLOCATE( v_center(nzb:nzt+1,nys:nyn,nxl:nxr) )
1519	v_center = 0.0_wp
1520	ENDIF
1521	IF ( .NOT. ALLOCATED( wdir ) ) THEN
1522	ALLOCATE( wdir(nzb:nzt+1,nys:nyn,nxl:nxr) )
1523	wdir = 0.0_wp
1524	ENDIF
1525
1526	END SELECT
1527
1528	ivar = ivar + 1
1529	ENDDO
1530
1531	initialized_diagnostic_output_quantities = .TRUE.
1532
1533	END SUBROUTINE doq_init
1534
1535
1536	!--------------------------------------------------------------------------------------------------!
1537	! Description:
1538	! ------------
1539	!> Calculate diagnostic quantities
1540	!--------------------------------------------------------------------------------------------------!
1541	SUBROUTINE doq_calculate
1542
1543	IMPLICIT NONE
1544
1545	INTEGER(iwp) :: i !< grid index x-dimension
1546	INTEGER(iwp) :: j !< grid index y-dimension
1547	INTEGER(iwp) :: k !< grid index z-dimension
1548	INTEGER(iwp) :: ivar !< loop index over all 2d/3d/mask output quantities
1549
1550	TYPE(surf_type), POINTER :: surf !< surf-type array, used to generalize subroutines
1551
1552
1553	! CALL cpu_log( log_point(41), 'calculate_quantities', 'start' )
1554
1555	!
1556	!-- Save timestep number to check in time_integration if doq_calculate
1557	!-- has been called already, since the CALL occurs at two locations, but the calculations need to be
1558	!-- done only once per timestep.
1559	timestep_number_at_prev_calc = current_timestep_number
1560
1561	ivar = 1
1562
1563	DO WHILE ( ivar <= SIZE( do_all ) )
1564
1565	SELECT CASE ( TRIM( do_all(ivar) ) )
1566	!
1567	!-- Calculate 'turbulence intensity' from rot[(u,v,w)] at scalar grid point
1568	CASE ( 'ti' )
1569	DO i = nxl, nxr
1570	DO j = nys, nyn
1571	DO k = nzb+1, nzt
1572	ti(k,j,i) = 0.25_wp * SQRT( &
1573	( ( w(k,j+1,i) + w(k-1,j+1,i) &
1574	- w(k,j-1,i) - w(k-1,j-1,i) ) * ddy &
1575	- ( v(k+1,j,i) + v(k+1,j+1,i) &
1576	- v(k-1,j,i) - v(k-1,j+1,i) ) * ddzu(k) )**2 &
1577	+ ( ( u(k+1,j,i) + u(k+1,j,i+1) &
1578	- u(k-1,j,i) - u(k-1,j,i+1) ) * ddzu(k) &
1579	- ( w(k,j,i+1) + w(k-1,j,i+1) &
1580	- w(k,j,i-1) - w(k-1,j,i-1) ) * ddx )**2 &
1581	+ ( ( v(k,j,i+1) + v(k,j+1,i+1) &
1582	- v(k,j,i-1) - v(k,j+1,i-1) ) * ddx &
1583	- ( u(k,j+1,i) + u(k,j+1,i+1) &
1584	- u(k,j-1,i) - u(k,j-1,i+1) ) * ddy )**2 ) &
1585	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0) )
1586	ENDDO
1587	ENDDO
1588	ENDDO
1589	!
1590	!-- uu
1591	CASE ( 'uu' )
1592	DO i = nxl, nxr
1593	DO j = nys, nyn
1594	DO k = nzb+1, nzt
1595	uu(k,j,i) = u(k,j,i) * u(k,j,i) &
1596	* MERGE( 1.0_wp, 0.0_wp, &
1597	BTEST( wall_flags_total_0(k,j,i), 1) )
1598	ENDDO
1599	ENDDO
1600	ENDDO
1601	!
1602	!-- vv
1603	CASE ( 'vv' )
1604	DO i = nxl, nxr
1605	DO j = nys, nyn
1606	DO k = nzb+1, nzt
1607	vv(k,j,i) = v(k,j,i) * v(k,j,i) &
1608	* MERGE( 1.0_wp, 0.0_wp, &
1609	BTEST( wall_flags_total_0(k,j,i), 2) )
1610	ENDDO
1611	ENDDO
1612	ENDDO
1613	!
1614	!-- ww
1615	CASE ( 'ww' )
1616	DO i = nxl, nxr
1617	DO j = nys, nyn
1618	DO k = nzb+1, nzt-1
1619	ww(k,j,i) = w(k,j,i) * w(k,j,i) &
1620	* MERGE( 1.0_wp, 0.0_wp, &
1621	BTEST( wall_flags_total_0(k,j,i), 3) )
1622	ENDDO
1623	ENDDO
1624	ENDDO
1625	!
1626	!-- wu
1627	CASE ( 'wu' )
1628	DO i = nxl, nxr
1629	DO j = nys, nyn
1630	DO k = nzb+1, nzt-1
1631	wu(k,j,i) = w(k,j,i) * u(k,j,i) &
1632	* MERGE( 1.0_wp, 0.0_wp, &
1633	BTEST( wall_flags_total_0(k,j,i), 0) )
1634	ENDDO
1635	ENDDO
1636	ENDDO
1637	!
1638	!-- wv
1639	CASE ( 'wv' )
1640	DO i = nxl, nxr
1641	DO j = nys, nyn
1642	DO k = nzb+1, nzt-1
1643	wv(k,j,i) = w(k,j,i) * v(k,j,i) &
1644	* MERGE( 1.0_wp, 0.0_wp, &
1645	BTEST( wall_flags_total_0(k,j,i), 0) )
1646	ENDDO
1647	ENDDO
1648	ENDDO
1649	!
1650	!-- wtheta
1651	CASE ( 'wtheta' )
1652	DO i = nxl, nxr
1653	DO j = nys, nyn
1654	DO k = nzb+1, nzt-1
1655	wtheta(k,j,i) = w(k,j,i) * pt(k,j,i) &
1656	* MERGE( 1.0_wp, 0.0_wp, &
1657	BTEST( wall_flags_total_0(k,j,i), 0) )
1658	ENDDO
1659	ENDDO
1660	ENDDO
1661	!
1662	!-- wq
1663	CASE ( 'wq' )
1664	DO i = nxl, nxr
1665	DO j = nys, nyn
1666	DO k = nzb+1, nzt-1
1667	wq(k,j,i) = w(k,j,i) * q(k,j,i) &
1668	* MERGE( 1.0_wp, 0.0_wp, &
1669	BTEST( wall_flags_total_0(k,j,i), 0) )
1670	ENDDO
1671	ENDDO
1672	ENDDO
1673	!
1674	!-- 2-m potential temperature
1675	CASE ( 'theta_2m*' )
1676	!
1677	!-- 2-m potential temperature is caluclated from surface arrays. In
1678	!-- case the 2m level is below the first grid point, MOST is applied,
1679	!-- else, linear interpolation between two vertical grid levels is
1680	!-- applied. To access all surfaces, iterate over all horizontally-
1681	!-- upward facing surface types.
1682	surf => surf_def_h(0)
1683	CALL calc_pt_2m
1684	surf => surf_lsm_h
1685	CALL calc_pt_2m
1686	surf => surf_usm_h
1687	CALL calc_pt_2m
1688	!
1689	!-- 10-m wind speed
1690	CASE ( 'wspeed_10m*' )
1691	!
1692	!-- 10-m wind speed is caluclated from surface arrays. In
1693	!-- case the 10m level is below the first grid point, MOST is applied,
1694	!-- else, linear interpolation between two vertical grid levels is
1695	!-- applied. To access all surfaces, iterate over all horizontally-
1696	!-- upward facing surface types.
1697	surf => surf_def_h(0)
1698	CALL calc_wind_10m
1699	surf => surf_lsm_h
1700	CALL calc_wind_10m
1701	surf => surf_usm_h
1702	CALL calc_wind_10m
1703	!
1704	!-- horizontal wind speed
1705	CASE ( 'wspeed' )
1706	DO i = nxl, nxr
1707	DO j = nys, nyn
1708	DO k = nzb, nzt+1
1709	wspeed(k,j,i) = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2 &
1710	+ ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2 ) &
1711	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0) )
1712	ENDDO
1713	ENDDO
1714	ENDDO
1715
1716	!
1717	!-- horizontal wind direction
1718	CASE ( 'wdir' )
1719	DO i = nxl, nxr
1720	DO j = nys, nyn
1721	DO k = nzb, nzt+1
1722	u_center(k,j,i) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
1723	v_center(k,j,i) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
1724
1725	wdir(k,j,i) = ATAN2( u_center(k,j,i), v_center(k,j,i) ) &
1726	/ pi * 180.0_wp + 180.0_wp
1727	ENDDO
1728	ENDDO
1729	ENDDO
1730
1731	END SELECT
1732
1733	ivar = ivar + 1
1734	ENDDO
1735
1736	! CALL cpu_log( log_point(41), 'calculate_quantities', 'stop' )
1737
1738	!
1739	!-- The following block contains subroutines to calculate diagnostic
1740	!-- surface quantities.
1741	CONTAINS
1742	!------------------------------------------------------------------------------!
1743	! Description:
1744	! ------------
1745	!> Calculation of 2-m potential temperature.
1746	!------------------------------------------------------------------------------!
1747	SUBROUTINE calc_pt_2m
1748
1749	USE surface_layer_fluxes_mod, &
1750	ONLY: psi_h
1751
1752	IMPLICIT NONE
1753
1754	INTEGER(iwp) :: kk !< running index along the z-dimension
1755	INTEGER(iwp) :: m !< running index for surface elements
1756
1757	DO m = 1, surf%ns
1758
1759	i = surf%i(m)
1760	j = surf%j(m)
1761	k = surf%k(m)
1762	!
1763	!-- If 2-m level is below the first grid level, MOST is
1764	!-- used for calculation of 2-m temperature.
1765	IF ( surf%z_mo(m) > 2.0_wp ) THEN
1766	pt_2m(j,i) = surf%pt_surface(m) + surf%ts(m) / kappa &
1767	* ( LOG( 2.0_wp / surf%z0h(m) ) &
1768	- psi_h( 2.0_wp / surf%ol(m) ) &
1769	+ psi_h( surf%z0h(m) / surf%ol(m) ) )
1770	!
1771	!-- If 2-m level is above the first grid level, 2-m temperature
1772	!-- is linearly interpolated between the two nearest vertical grid
1773	!-- levels. Note, since 2-m temperature is only computed for
1774	!-- horizontal upward-facing surfaces, only a vertical
1775	!-- interpolation is necessary.
1776	ELSE
1777	!
1778	!-- zw(k-1) defines the height of the surface.
1779	kk = k
1780	DO WHILE ( zu(kk) - zw(k-1) < 2.0_wp .AND. kk <= nzt )
1781	kk = kk + 1
1782	ENDDO
1783	!
1784	!-- kk defines the index of the first grid level >= 2m.
1785	pt_2m(j,i) = pt(kk-1,j,i) + &
1786	( zw(k-1) + 2.0_wp - zu(kk-1) ) * &
1787	( pt(kk,j,i) - pt(kk-1,j,i) ) / &
1788	( zu(kk) - zu(kk-1) )
1789	ENDIF
1790
1791	ENDDO
1792
1793	END SUBROUTINE calc_pt_2m
1794
1795	!------------------------------------------------------------------------------!
1796	! Description:
1797	! ------------
1798	!> Calculation of 10-m wind speed.
1799	!------------------------------------------------------------------------------!
1800	SUBROUTINE calc_wind_10m
1801
1802	USE surface_layer_fluxes_mod, &
1803	ONLY: psi_m
1804
1805	IMPLICIT NONE
1806
1807	INTEGER(iwp) :: kk !< running index along the z-dimension
1808	INTEGER(iwp) :: m !< running index for surface elements
1809
1810	REAL(wp) :: uv_l !< wind speed at lower grid point
1811	REAL(wp) :: uv_u !< wind speed at upper grid point
1812
1813	DO m = 1, surf%ns
1814
1815	i = surf%i(m)
1816	j = surf%j(m)
1817	k = surf%k(m)
1818	!
1819	!-- If 10-m level is below the first grid level, MOST is
1820	!-- used for calculation of 10-m temperature.
1821	IF ( surf%z_mo(m) > 10.0_wp ) THEN
1822	uv_10m(j,i) = surf%us(m) / kappa &
1823	* ( LOG( 10.0_wp / surf%z0(m) ) &
1824	- psi_m( 10.0_wp / surf%ol(m) ) &
1825	+ psi_m( surf%z0(m) / surf%ol(m) ) )
1826	!
1827	!-- If 10-m level is above the first grid level, 10-m wind speed
1828	!-- is linearly interpolated between the two nearest vertical grid
1829	!-- levels. Note, since 10-m temperature is only computed for
1830	!-- horizontal upward-facing surfaces, only a vertical
1831	!-- interpolation is necessary.
1832	ELSE
1833	!
1834	!-- zw(k-1) defines the height of the surface.
1835	kk = k
1836	DO WHILE ( zu(kk) - zw(k-1) < 10.0_wp .AND. kk <= nzt )
1837	kk = kk + 1
1838	ENDDO
1839	!
1840	!-- kk defines the index of the first grid level >= 10m.
1841	uv_l = SQRT( ( 0.5_wp * ( u(kk-1,j,i) + u(kk-1,j,i+1) ) )**2 &
1842	+ ( 0.5_wp * ( v(kk-1,j,i) + v(kk-1,j+1,i) ) )**2 )
1843
1844	uv_u = SQRT( ( 0.5_wp * ( u(kk,j,i) + u(kk,j,i+1) ) )**2 &
1845	+ ( 0.5_wp * ( v(kk,j,i) + v(kk,j+1,i) ) )**2 )
1846
1847	uv_10m(j,i) = uv_l + ( zw(k-1) + 10.0_wp - zu(kk-1) ) * &
1848	( uv_u - uv_l ) / &
1849	( zu(kk) - zu(kk-1) )
1850
1851	ENDIF
1852
1853	ENDDO
1854
1855	END SUBROUTINE calc_wind_10m
1856
1857	END SUBROUTINE doq_calculate
1858
1859
1860	!------------------------------------------------------------------------------!
1861	! Description:
1862	! ------------
1863	!> Preparation of the diagnostic output, counting of the module-specific
1864	!> output quantities and gathering of the output names.
1865	!------------------------------------------------------------------------------!
1866	SUBROUTINE doq_prepare
1867
1868
1869	USE control_parameters, &
1870	ONLY: do2d, do3d, domask, masks
1871
1872	IMPLICIT NONE
1873
1874	CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) :: do2d_var = ' ' !<
1875	!< label array for 2d output quantities
1876
1877	INTEGER(iwp) :: av !< index defining type of output, av=0 instantaneous, av=1 averaged
1878	INTEGER(iwp) :: ivar !< loop index
1879	INTEGER(iwp) :: ivar_all !< loop index
1880	INTEGER(iwp) :: l !< index for cutting string
1881	INTEGER(iwp) :: mid !< masked output running index
1882
1883	prepared_diagnostic_output_quantities = .FALSE.
1884
1885	ivar = 1
1886	ivar_all = 1
1887
1888	DO av = 0, 1
1889	!
1890	!-- Remove _xy, _xz, or _yz from string
1891	l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
1892	do2d_var(av,ivar)(1:l-3) = do2d(av,ivar)(1:l-3)
1893	!
1894	!-- Gather 2d output quantity names.
1895	!-- Check for double occurrence of output quantity, e.g. by _xy,
1896	!-- _yz, _xz.
1897	DO WHILE ( do2d_var(av,ivar)(1:1) /= ' ' )
1898	IF ( .NOT. ANY( do_all == do2d_var(av,ivar) ) ) THEN
1899	do_all(ivar_all) = do2d_var(av,ivar)
1900	ENDIF
1901	ivar = ivar + 1
1902	ivar_all = ivar_all + 1
1903	l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
1904	do2d_var(av,ivar)(1:l-3) = do2d(av,ivar)(1:l-3)
1905	ENDDO
1906
1907	ivar = 1
1908	!
1909	!-- Gather 3d output quantity names
1910	DO WHILE ( do3d(av,ivar)(1:1) /= ' ' )
1911	do_all(ivar_all) = do3d(av,ivar)
1912	ivar = ivar + 1
1913	ivar_all = ivar_all + 1
1914	ENDDO
1915
1916	ivar = 1
1917	!
1918	!-- Gather masked output quantity names. Also check for double output
1919	!-- e.g. by different masks.
1920	DO mid = 1, masks
1921	DO WHILE ( domask(mid,av,ivar)(1:1) /= ' ' )
1922	IF ( .NOT. ANY( do_all == domask(mid,av,ivar) ) ) THEN
1923	do_all(ivar_all) = domask(mid,av,ivar)
1924	ENDIF
1925
1926	ivar = ivar + 1
1927	ivar_all = ivar_all + 1
1928	ENDDO
1929	ivar = 1
1930	ENDDO
1931
1932	ENDDO
1933
1934	prepared_diagnostic_output_quantities = .TRUE.
1935
1936	END SUBROUTINE doq_prepare
1937
1938	!------------------------------------------------------------------------------!
1939	! Description:
1940	! ------------
1941	!> Subroutine reads local (subdomain) restart data
1942	!> Note: With the current structure reading of non-standard array is not
1943	!> possible
1944	!------------------------------------------------------------------------------!
1945	! SUBROUTINE doq_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
1946	! nxr_on_file, nynf, nync, nyn_on_file, nysf, &
1947	! nysc, nys_on_file, tmp_3d_non_standard, found )
1948	!
1949	!
1950	! USE control_parameters
1951	!
1952	! USE indices
1953	!
1954	! USE kinds
1955	!
1956	! USE pegrid
1957	!
1958	!
1959	! IMPLICIT NONE
1960	!
1961	! INTEGER(iwp) :: k !<
1962	! INTEGER(iwp) :: nxlc !<
1963	! INTEGER(iwp) :: nxlf !<
1964	! INTEGER(iwp) :: nxl_on_file !<
1965	! INTEGER(iwp) :: nxrc !<
1966	! INTEGER(iwp) :: nxrf !<
1967	! INTEGER(iwp) :: nxr_on_file !<
1968	! INTEGER(iwp) :: nync !<
1969	! INTEGER(iwp) :: nynf !<
1970	! INTEGER(iwp) :: nyn_on_file !<
1971	! INTEGER(iwp) :: nysc !<
1972	! INTEGER(iwp) :: nysf !<
1973	! INTEGER(iwp) :: nys_on_file !<
1974	!
1975	! LOGICAL, INTENT(OUT) :: found
1976	!
1977	! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_3d_non_standard !< temporary array for storing 3D data with non standard dimensions
1978	! !
1979	! !-- If temporary non-standard array for reading is already allocated,
1980	! !-- deallocate it.
1981	! IF ( ALLOCATED( tmp_3d_non_standard ) ) DEALLOCATE( tmp_3d_non_standard )
1982	!
1983	! found = .TRUE.
1984	!
1985	! SELECT CASE ( restart_string(1:length) )
1986	!
1987	! CASE ( 'ti_av' )
1988	! IF ( .NOT. ALLOCATED( ti_av ) ) THEN
1989	! ALLOCATE( ti_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1990	! ENDIF
1991	! IF ( k == 1 ) THEN
1992	! ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, &
1993	! nxl_on_file:nxr_on_file) )
1994	! READ ( 13 ) tmp_3d_non_standard
1995	! ENDIF
1996	! ti_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf)
1997	!
1998	! CASE ( 'uu_av' )
1999	! IF ( .NOT. ALLOCATED( uu_av ) ) THEN
2000	! ALLOCATE( uu_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
2001	! ENDIF
2002	! IF ( k == 1 ) THEN
2003	! ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, &
2004	! nxl_on_file:nxr_on_file) )
2005	! READ ( 13 ) tmp_3d_non_standard
2006	! ENDIF
2007	! uu_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf)
2008	!
2009	! CASE ( 'vv_av' )
2010	! IF ( .NOT. ALLOCATED( vv_av ) ) THEN
2011	! ALLOCATE( vv_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
2012	! ENDIF
2013	! IF ( k == 1 ) THEN
2014	! ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, &
2015	! nxl_on_file:nxr_on_file) )
2016	! READ ( 13 ) tmp_3d_non_standard
2017	! ENDIF
2018	! vv_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf)
2019	!
2020	! CASE ( 'ww_av' )
2021	! IF ( .NOT. ALLOCATED( ww_av ) ) THEN
2022	! ALLOCATE( ww_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
2023	! ENDIF
2024	! IF ( k == 1 ) THEN
2025	! ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, &
2026	! nxl_on_file:nxr_on_file) )
2027	! READ ( 13 ) tmp_3d_non_standard
2028	! ENDIF
2029	! ww_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf)
2030	!
2031	!
2032	! CASE DEFAULT
2033	!
2034	! found = .FALSE.
2035	!
2036	! END SELECT
2037	!
2038	! END SUBROUTINE doq_rrd_local
2039
2040	!------------------------------------------------------------------------------!
2041	! Description:
2042	! ------------
2043	!> Subroutine writes local (subdomain) restart data
2044	!------------------------------------------------------------------------------!
2045	SUBROUTINE doq_wrd_local
2046
2047
2048	IMPLICIT NONE
2049
2050	IF ( ALLOCATED( pt_2m_av ) ) THEN
2051	CALL wrd_write_string( 'pt_2m_av' )
2052	WRITE ( 14 ) pt_2m_av
2053	ENDIF
2054
2055	IF ( ALLOCATED( ti_av ) ) THEN
2056	CALL wrd_write_string( 'ti_av' )
2057	WRITE ( 14 ) ti_av
2058	ENDIF
2059
2060	IF ( ALLOCATED( uu_av ) ) THEN
2061	CALL wrd_write_string( 'uu_av' )
2062	WRITE ( 14 ) uu_av
2063	ENDIF
2064
2065	IF ( ALLOCATED( uv_10m_av ) ) THEN
2066	CALL wrd_write_string( 'uv_10m_av' )
2067	WRITE ( 14 ) uv_10m_av
2068	ENDIF
2069
2070	IF ( ALLOCATED( vv_av ) ) THEN
2071	CALL wrd_write_string( 'vv_av' )
2072	WRITE ( 14 ) vv_av
2073	ENDIF
2074
2075	IF ( ALLOCATED( ww_av ) ) THEN
2076	CALL wrd_write_string( 'ww_av' )
2077	WRITE ( 14 ) ww_av
2078	ENDIF
2079
2080	IF ( ALLOCATED( wu_av ) ) THEN
2081	CALL wrd_write_string( 'wu_av' )
2082	WRITE ( 14 ) wu_av
2083	ENDIF
2084
2085	IF ( ALLOCATED( wv_av ) ) THEN
2086	CALL wrd_write_string( 'wv_av' )
2087	WRITE ( 14 ) wv_av
2088	ENDIF
2089
2090	IF ( ALLOCATED( wtheta_av ) ) THEN
2091	CALL wrd_write_string( 'wtheta_av' )
2092	WRITE ( 14 ) wtheta_av
2093	ENDIF
2094
2095	IF ( ALLOCATED( wq_av ) ) THEN
2096	CALL wrd_write_string( 'wq_av' )
2097	WRITE ( 14 ) wq_av
2098	ENDIF
2099
2100	IF ( ALLOCATED( wspeed_av ) ) THEN
2101	CALL wrd_write_string( 'wspeed_av' )
2102	WRITE ( 14 ) wspeed_av
2103	ENDIF
2104
2105	IF ( ALLOCATED( u_center_av ) ) THEN
2106	CALL wrd_write_string( 'u_center_av' )
2107	WRITE ( 14 ) u_center_av
2108	ENDIF
2109
2110	IF ( ALLOCATED( v_center_av ) ) THEN
2111	CALL wrd_write_string( 'v_center_av' )
2112	WRITE ( 14 ) v_center_av
2113	ENDIF
2114
2115	END SUBROUTINE doq_wrd_local
2116
2117
2118
2119	END MODULE diagnostic_output_quantities_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |