Home

Context Navigation

diagnostic_output_quantities_mod.f90 @ 4896

Last change on this file since 4896 was 4895, checked in by suehring, 4 years ago
Remove offset in terrain-following masked output and allow only mask_k_over_surface >= 1
Property svn:keywords set to `Id`
File size: 97.3 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 terms of the GNU General
6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
7	! (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11	! Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
14	! <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 1997-2021 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! ------------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: diagnostic_output_quantities_mod.f90 4895 2021-03-03 15:39:08Z raasch $
26	! Remove offset in terrain-following masked output
27	!
28	! 4866 2021-02-05 17:50:14Z suehring
29	! Implemented vertical passive scalar flux
30	! Implemented air temperature as diagnostic output quantity (previous commit)
31	!
32	! 4861 2021-02-01 10:51:45Z raasch
33	! Enable 3D data output also with 64-bit precision
34	!
35	! 4757 2020-10-26 10:23:38Z schwenkel
36	! Implement relative humidity as diagnostic output quantity
37	!
38	! 4671 2020-09-09 20:27:58Z pavelkrc
39	! Implementation of downward facing USM and LSM surfaces
40	!
41	! 4583 2020-06-29 12:36:47Z raasch
42	! file re-formatted to follow the PALM coding standard
43	!
44	! 4560 2020-06-11 12:19:47Z suehring
45	! - Bugfix in calculation of vertical momentum and scalar fluxes
46	! - remove averaged output variables from PUBLIC list
47	!
48	! 4535 2020-05-15 12:07:23Z raasch
49	! bugfix for restart data format query
50	!
51	! 4518 2020-05-04 15:44:28Z suehring
52	! * Define arrays over ghost points in order to allow for standard mpi-io treatment. By this
53	! modularization of restart-data input is possible with the module interface.
54	! * Bugfix: add missing restart input of wtheta_av, wq_av, wu_av, and wv_av.
55	!
56	! 4517 2020-05-03 14:29:30Z raasch
57	! use statement for exchange horiz added,
58	! bugfix for call of exchange horiz 2d
59	!
60	! 4431 2020-02-27 23:23:01Z gronemeier
61	! added wspeed and wdir output; bugfix: set fill_value in case of masked output
62	!
63	! 4360 2020-01-07 11:25:50Z suehring
64	! added output of wu, wv, wtheta and wq to enable covariance calculation according to temporal EC
65	! method
66	!
67	! 4346 2019-12-18 11:55:56Z motisi
68	! Introduction of wall_flags_total_0, which currently sets bits based on static topography
69	! information used in wall_flags_static_0
70	!
71	! 4331 2019-12-10 18:25:02Z suehring
72	! - Modularize 2-m potential temperature output
73	! - New output for 10-m wind speed
74	!
75	! 4329 2019-12-10 15:46:36Z motisi
76	! Renamed wall_flags_0 to wall_flags_static_0
77	!
78	! 4182 2019-08-22 15:20:23Z scharf
79	! Corrected "Former revisions" section
80	!
81	! 4167 2019-08-16 11:01:48Z suehring
82	! Changed behaviour of masked output over surface to follow terrain and ignore buildings
83	! (J.Resler, T.Gronemeier)
84	!
85	! 4157 2019-08-14 09:19:12Z suehring
86	! Initialization restructured, in order to work also when data output during spin-up is enabled.
87	!
88	! 4132 2019-08-02 12:34:17Z suehring
89	! Bugfix in masked data output
90	!
91	! 4069 2019-07-01 14:05:51Z Giersch
92	! Masked output running index mid has been introduced as a local variable to avoid runtime error
93	! (Loop variable has been modified) in time_integration
94	!
95	! 4039 2019-06-18 10:32:41Z suehring
96	! - Add output of uu, vv, ww to enable variance calculation according temporal EC method
97	! - Allocate arrays only when they are required
98	! - Formatting adjustment
99	! - Rename subroutines
100	! - Further modularization
101	!
102	! 3998 2019-05-23 13:38:11Z suehring
103	! Bugfix in gathering all output strings
104	!
105	! 3995 2019-05-22 18:59:54Z suehring
106	! Avoid compiler warnings about unused variable and fix string operation which is not allowed with
107	! PGI compiler
108	!
109	! 3994 2019-05-22 18:08:09Z suehring
110	! Initial revision
111	!
112	! Authors:
113	! --------
114	! @author Farah Kanani-Suehring
115	!
116	!
117	! Description:
118	! ------------
119	!> ...
120	!--------------------------------------------------------------------------------------------------!
121	MODULE diagnostic_output_quantities_mod
122
123	USE arrays_3d, &
124	ONLY: ddzu, &
125	exner, &
126	hyp, &
127	pt, &
128	q, &
129	s, &
130	u, &
131	v, &
132	w, &
133	zu, &
134	zw
135
136	USE basic_constants_and_equations_mod, &
137	ONLY: degc_to_k, &
138	kappa, &
139	pi, &
140	magnus, &
141	rd_d_rv
142
143	USE control_parameters, &
144	ONLY: current_timestep_number, &
145	data_output, &
146	data_output_pr, &
147	humidity, &
148	message_string, &
149	passive_scalar, &
150	restart_data_format_output, &
151	varnamelength
152	!
153	! USE cpulog, &
154	! ONLY: cpu_log, log_point
155
156	USE exchange_horiz_mod, &
157	ONLY: exchange_horiz_2d
158
159	USE grid_variables, &
160	ONLY: ddx, ddy
161
162	USE indices, &
163	ONLY: nbgp, &
164	nxl, &
165	nxlg, &
166	nxr, &
167	nxrg, &
168	nyn, &
169	nyng, &
170	nys, &
171	nysg, &
172	nzb, &
173	nzt, &
174	wall_flags_total_0
175
176	USE kinds
177
178	USE profil_parameter, &
179	ONLY: dopr_index
180
181	USE restart_data_mpi_io_mod, &
182	ONLY: rd_mpi_io_check_array, &
183	rrd_mpi_io, &
184	wrd_mpi_io
185
186	USE statistics, &
187	ONLY: hom, &
188	pr_palm, &
189	rmask, &
190	statistic_regions, &
191	sums_l
192
193	USE surface_mod, &
194	ONLY: surf_def_h, &
195	surf_lsm_h, &
196	surf_type, &
197	surf_usm_h
198
199	IMPLICIT NONE
200
201	CHARACTER(LEN=varnamelength), DIMENSION(500) :: do_all = ' '
202
203	INTEGER(iwp) :: timestep_number_at_prev_calc = 0 !< ...at previous diagnostic output calculation
204
205	LOGICAL :: initialized_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is initialized
206	LOGICAL :: prepared_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is p
207
208	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pt_2m !< 2-m air potential temperature
209	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pt_2m_av !< averaged 2-m air potential temperature
210	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uv_10m !< horizontal wind speed at 10m
211	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uv_10m_av !< averaged horizontal wind speed at 10m
212
213	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: rh !< relative humidity
214	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: rh_av !< avg. relative humidity
215	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ta !< air temperature
216	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ta_av !< avg. air temperature
217	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti !< rotation(u,v,w) aka turbulence intensity
218	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti_av !< avg. rotation(u,v,w) aka turbulence intensity
219	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: u_center !< u at center of grid box
220	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: u_center_av !< mean of u_center
221	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu !< uu
222	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu_av !< mean of uu
223	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wspeed !< horizontal wind speed
224	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wspeed_av !< mean of horizotal wind speed
225	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: v_center !< v at center of grid box
226	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: v_center_av !< mean of v_center
227	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv !< vv
228	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv_av !< mean of vv
229	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wdir !< wind direction
230	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wdir_av !< mean wind direction
231	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww !< ww
232	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww_av !< mean of ww
233	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu !< wu
234	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu_av !< mean of wu
235	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv !< wv
236	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv_av !< mean of wv
237	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta !< wtheta
238	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta_av !< mean of wtheta
239	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq !< wq
240	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq_av !< mean of wq
241	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ws !< ws
242	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ws_av !< mean of ws
243
244
245	SAVE
246
247	PRIVATE
248
249	!
250	!-- Public variables
251	PUBLIC do_all, &
252	initialized_diagnostic_output_quantities, &
253	prepared_diagnostic_output_quantities, &
254	timestep_number_at_prev_calc
255	!
256	!-- Public routines
257	PUBLIC doq_3d_data_averaging, &
258	doq_calculate, &
259	doq_check_data_output, &
260	doq_check_data_output_pr, &
261	doq_define_netcdf_grid, &
262	doq_init, &
263	doq_output_2d, &
264	doq_output_3d, &
265	doq_output_mask, &
266	doq_statistics, &
267	doq_rrd_local, &
268	doq_wrd_local
269
270
271	INTERFACE doq_3d_data_averaging
272	MODULE PROCEDURE doq_3d_data_averaging
273	END INTERFACE doq_3d_data_averaging
274
275	INTERFACE doq_calculate
276	MODULE PROCEDURE doq_calculate
277	END INTERFACE doq_calculate
278
279	INTERFACE doq_check_data_output
280	MODULE PROCEDURE doq_check_data_output
281	END INTERFACE doq_check_data_output
282
283	INTERFACE doq_check_data_output_pr
284	MODULE PROCEDURE doq_check_data_output_pr
285	END INTERFACE doq_check_data_output_pr
286
287	INTERFACE doq_define_netcdf_grid
288	MODULE PROCEDURE doq_define_netcdf_grid
289	END INTERFACE doq_define_netcdf_grid
290
291	INTERFACE doq_output_2d
292	MODULE PROCEDURE doq_output_2d
293	END INTERFACE doq_output_2d
294
295	INTERFACE doq_output_3d
296	MODULE PROCEDURE doq_output_3d
297	END INTERFACE doq_output_3d
298
299	INTERFACE doq_output_mask
300	MODULE PROCEDURE doq_output_mask
301	END INTERFACE doq_output_mask
302
303	INTERFACE doq_init
304	MODULE PROCEDURE doq_init
305	END INTERFACE doq_init
306
307	INTERFACE doq_statistics
308	MODULE PROCEDURE doq_statistics
309	END INTERFACE doq_statistics
310
311	INTERFACE doq_prepare
312	MODULE PROCEDURE doq_prepare
313	END INTERFACE doq_prepare
314
315	INTERFACE doq_rrd_local
316	MODULE PROCEDURE doq_rrd_local_ftn
317	MODULE PROCEDURE doq_rrd_local_mpi
318	END INTERFACE doq_rrd_local
319
320	INTERFACE doq_wrd_local
321	MODULE PROCEDURE doq_wrd_local
322	END INTERFACE doq_wrd_local
323
324	CONTAINS
325
326	!--------------------------------------------------------------------------------------------------!
327	! Description:
328	! ------------
329	!> Sum up and time-average diagnostic output quantities as well as allocate the array necessary for
330	!> storing the average.
331	!--------------------------------------------------------------------------------------------------!
332	SUBROUTINE doq_3d_data_averaging( mode, variable )
333
334	USE control_parameters, &
335	ONLY: average_count_3d
336
337	CHARACTER (LEN=*) :: mode !<
338	CHARACTER (LEN=*) :: variable !<
339
340	INTEGER(iwp) :: i !<
341	INTEGER(iwp) :: j !<
342	INTEGER(iwp) :: k !<
343
344
345	IF ( mode == 'allocate' ) THEN
346
347	SELECT CASE ( TRIM( variable ) )
348
349	CASE ( 'rh' )
350	IF ( .NOT. ALLOCATED( rh_av ) ) THEN
351	ALLOCATE( rh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
352	ENDIF
353	rh_av = 0.0_wp
354
355	CASE ( 'ta' )
356	IF ( .NOT. ALLOCATED( ta_av ) ) THEN
357	ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
358	ENDIF
359	ta_av = 0.0_wp
360
361	CASE ( 'ti' )
362	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
363	ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
364	ENDIF
365	ti_av = 0.0_wp
366
367	CASE ( 'uu' )
368	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
369	ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
370	ENDIF
371	uu_av = 0.0_wp
372
373	CASE ( 'vv' )
374	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
375	ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
376	ENDIF
377	vv_av = 0.0_wp
378
379	CASE ( 'ww' )
380	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
381	ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
382	ENDIF
383	ww_av = 0.0_wp
384
385	CASE ( 'wu' )
386	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
387	ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
388	ENDIF
389	wu_av = 0.0_wp
390
391	CASE ( 'wv' )
392	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
393	ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
394	ENDIF
395	wv_av = 0.0_wp
396
397	CASE ( 'wtheta' )
398	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
399	ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
400	ENDIF
401	wtheta_av = 0.0_wp
402
403	CASE ( 'wq' )
404	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
405	ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
406	ENDIF
407	wq_av = 0.0_wp
408
409	CASE ( 'ws' )
410	IF ( .NOT. ALLOCATED( ws_av ) ) THEN
411	ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
412	ENDIF
413	ws_av = 0.0_wp
414
415	CASE ( 'theta_2m*' )
416	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
417	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
418	ENDIF
419	pt_2m_av = 0.0_wp
420
421	CASE ( 'wspeed_10m*' )
422	IF ( .NOT. ALLOCATED( uv_10m_av ) ) THEN
423	ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
424	ENDIF
425	uv_10m_av = 0.0_wp
426
427	CASE ( 'wspeed' )
428	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
429	ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
430	ENDIF
431	wspeed_av = 0.0_wp
432
433	CASE ( 'wdir' )
434	IF ( .NOT. ALLOCATED( u_center_av ) ) THEN
435	ALLOCATE( u_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
436	ENDIF
437	IF ( .NOT. ALLOCATED( v_center_av ) ) THEN
438	ALLOCATE( v_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
439	ENDIF
440	u_center_av = 0.0_wp
441	v_center_av = 0.0_wp
442
443	CASE DEFAULT
444	CONTINUE
445
446	END SELECT
447
448	ELSEIF ( mode == 'sum' ) THEN
449
450	SELECT CASE ( TRIM( variable ) )
451
452	CASE ( 'rh' )
453	IF ( ALLOCATED( rh_av ) ) THEN
454	DO i = nxl, nxr
455	DO j = nys, nyn
456	DO k = nzb, nzt+1
457	rh_av(k,j,i) = rh_av(k,j,i) + rh(k,j,i)
458	ENDDO
459	ENDDO
460	ENDDO
461	ENDIF
462
463	CASE ( 'ta' )
464	IF ( ALLOCATED( ta_av ) ) THEN
465	DO i = nxl, nxr
466	DO j = nys, nyn
467	DO k = nzb, nzt+1
468	ta_av(k,j,i) = ta_av(k,j,i) + ta(k,j,i)
469	ENDDO
470	ENDDO
471	ENDDO
472	ENDIF
473
474	CASE ( 'ti' )
475	IF ( ALLOCATED( ti_av ) ) THEN
476	DO i = nxl, nxr
477	DO j = nys, nyn
478	DO k = nzb, nzt+1
479	ti_av(k,j,i) = ti_av(k,j,i) + ti(k,j,i)
480	ENDDO
481	ENDDO
482	ENDDO
483	ENDIF
484
485	CASE ( 'uu' )
486	IF ( ALLOCATED( uu_av ) ) THEN
487	DO i = nxl, nxr
488	DO j = nys, nyn
489	DO k = nzb, nzt+1
490	uu_av(k,j,i) = uu_av(k,j,i) + uu(k,j,i)
491	ENDDO
492	ENDDO
493	ENDDO
494	ENDIF
495
496	CASE ( 'vv' )
497	IF ( ALLOCATED( vv_av ) ) THEN
498	DO i = nxl, nxr
499	DO j = nys, nyn
500	DO k = nzb, nzt+1
501	vv_av(k,j,i) = vv_av(k,j,i) + vv(k,j,i)
502	ENDDO
503	ENDDO
504	ENDDO
505	ENDIF
506
507	CASE ( 'ww' )
508	IF ( ALLOCATED( ww_av ) ) THEN
509	DO i = nxl, nxr
510	DO j = nys, nyn
511	DO k = nzb, nzt+1
512	ww_av(k,j,i) = ww_av(k,j,i) + ww(k,j,i)
513	ENDDO
514	ENDDO
515	ENDDO
516	ENDIF
517
518	CASE ( 'wu' )
519	IF ( ALLOCATED( wu_av ) ) THEN
520	DO i = nxl, nxr
521	DO j = nys, nyn
522	DO k = nzb, nzt+1
523	wu_av(k,j,i) = wu_av(k,j,i) + wu(k,j,i)
524	ENDDO
525	ENDDO
526	ENDDO
527	ENDIF
528
529	CASE ( 'wv' )
530	IF ( ALLOCATED( wv_av ) ) THEN
531	DO i = nxl, nxr
532	DO j = nys, nyn
533	DO k = nzb, nzt+1
534	wv_av(k,j,i) = wv_av(k,j,i) + wv(k,j,i)
535	ENDDO
536	ENDDO
537	ENDDO
538	ENDIF
539
540	CASE ( 'wtheta' )
541	IF ( ALLOCATED( wtheta_av ) ) THEN
542	DO i = nxl, nxr
543	DO j = nys, nyn
544	DO k = nzb, nzt+1
545	wtheta_av(k,j,i) = wtheta_av(k,j,i) + wtheta(k,j,i)
546	ENDDO
547	ENDDO
548	ENDDO
549	ENDIF
550
551	CASE ( 'wq' )
552	IF ( ALLOCATED( wq_av ) ) THEN
553	DO i = nxl, nxr
554	DO j = nys, nyn
555	DO k = nzb, nzt+1
556	wq_av(k,j,i) = wq_av(k,j,i) + wq(k,j,i)
557	ENDDO
558	ENDDO
559	ENDDO
560	ENDIF
561
562	CASE ( 'ws' )
563	IF ( ALLOCATED( ws_av ) ) THEN
564	DO i = nxl, nxr
565	DO j = nys, nyn
566	DO k = nzb, nzt+1
567	ws_av(k,j,i) = ws_av(k,j,i) + ws(k,j,i)
568	ENDDO
569	ENDDO
570	ENDDO
571	ENDIF
572
573	CASE ( 'theta_2m*' )
574	IF ( ALLOCATED( pt_2m_av ) ) THEN
575	DO i = nxl, nxr
576	DO j = nys, nyn
577	pt_2m_av(j,i) = pt_2m_av(j,i) + pt_2m(j,i)
578	ENDDO
579	ENDDO
580	ENDIF
581
582	CASE ( 'wspeed_10m*' )
583	IF ( ALLOCATED( uv_10m_av ) ) THEN
584	DO i = nxl, nxr
585	DO j = nys, nyn
586	uv_10m_av(j,i) = uv_10m_av(j,i) + uv_10m(j,i)
587	ENDDO
588	ENDDO
589	ENDIF
590
591	CASE ( 'wspeed' )
592	IF ( ALLOCATED( wspeed_av ) ) THEN
593	DO i = nxl, nxr
594	DO j = nys, nyn
595	DO k = nzb, nzt+1
596	wspeed_av(k,j,i) = wspeed_av(k,j,i) + wspeed(k,j,i)
597	ENDDO
598	ENDDO
599	ENDDO
600	ENDIF
601
602	CASE ( 'wdir' )
603	IF ( ALLOCATED( u_center_av ) .AND. ALLOCATED( v_center_av ) ) THEN
604	DO i = nxl, nxr
605	DO j = nys, nyn
606	DO k = nzb, nzt+1
607	u_center_av(k,j,i) = u_center_av(k,j,i) + u_center(k,j,i)
608	v_center_av(k,j,i) = v_center_av(k,j,i) + v_center(k,j,i)
609	ENDDO
610	ENDDO
611	ENDDO
612	ENDIF
613
614	CASE DEFAULT
615	CONTINUE
616
617	END SELECT
618
619	ELSEIF ( mode == 'average' ) THEN
620
621	SELECT CASE ( TRIM( variable ) )
622
623	CASE ( 'rh' )
624	IF ( ALLOCATED( rh_av ) ) THEN
625	DO i = nxl, nxr
626	DO j = nys, nyn
627	DO k = nzb, nzt+1
628	rh_av(k,j,i) = rh_av(k,j,i) / REAL( average_count_3d, KIND=wp )
629	ENDDO
630	ENDDO
631	ENDDO
632	ENDIF
633
634	CASE ( 'ta' )
635	IF ( ALLOCATED( ta_av ) ) THEN
636	DO i = nxl, nxr
637	DO j = nys, nyn
638	DO k = nzb, nzt+1
639	ta_av(k,j,i) = ta_av(k,j,i) / REAL( average_count_3d, KIND=wp )
640	ENDDO
641	ENDDO
642	ENDDO
643	ENDIF
644
645	CASE ( 'ti' )
646	IF ( ALLOCATED( ti_av ) ) THEN
647	DO i = nxl, nxr
648	DO j = nys, nyn
649	DO k = nzb, nzt+1
650	ti_av(k,j,i) = ti_av(k,j,i) / REAL( average_count_3d, KIND=wp )
651	ENDDO
652	ENDDO
653	ENDDO
654	ENDIF
655
656	CASE ( 'uu' )
657	IF ( ALLOCATED( uu_av ) ) THEN
658	DO i = nxl, nxr
659	DO j = nys, nyn
660	DO k = nzb, nzt+1
661	uu_av(k,j,i) = uu_av(k,j,i) / REAL( average_count_3d, KIND=wp )
662	ENDDO
663	ENDDO
664	ENDDO
665	ENDIF
666
667	CASE ( 'vv' )
668	IF ( ALLOCATED( vv_av ) ) THEN
669	DO i = nxl, nxr
670	DO j = nys, nyn
671	DO k = nzb, nzt+1
672	vv_av(k,j,i) = vv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
673	ENDDO
674	ENDDO
675	ENDDO
676	ENDIF
677
678	CASE ( 'ww' )
679	IF ( ALLOCATED( ww_av ) ) THEN
680	DO i = nxl, nxr
681	DO j = nys, nyn
682	DO k = nzb, nzt+1
683	ww_av(k,j,i) = ww_av(k,j,i) / REAL( average_count_3d, KIND=wp )
684	ENDDO
685	ENDDO
686	ENDDO
687	ENDIF
688
689	CASE ( 'wu' )
690	IF ( ALLOCATED( wu_av ) ) THEN
691	DO i = nxl, nxr
692	DO j = nys, nyn
693	DO k = nzb, nzt+1
694	wu_av(k,j,i) = wu_av(k,j,i) / REAL( average_count_3d, KIND=wp )
695	ENDDO
696	ENDDO
697	ENDDO
698	ENDIF
699
700	CASE ( 'wv' )
701	IF ( ALLOCATED( wv_av ) ) THEN
702	DO i = nxl, nxr
703	DO j = nys, nyn
704	DO k = nzb, nzt+1
705	wv_av(k,j,i) = wv_av(k,j,i) / REAL( average_count_3d, KIND=wp )
706	ENDDO
707	ENDDO
708	ENDDO
709	ENDIF
710
711	CASE ( 'wtheta' )
712	IF ( ALLOCATED( wtheta_av ) ) THEN
713	DO i = nxl, nxr
714	DO j = nys, nyn
715	DO k = nzb, nzt+1
716	wtheta_av(k,j,i) = wtheta_av(k,j,i) / REAL( average_count_3d, KIND=wp )
717	ENDDO
718	ENDDO
719	ENDDO
720	ENDIF
721
722	CASE ( 'wq' )
723	IF ( ALLOCATED( wq_av ) ) THEN
724	DO i = nxl, nxr
725	DO j = nys, nyn
726	DO k = nzb, nzt+1
727	wq_av(k,j,i) = wq_av(k,j,i) / REAL( average_count_3d, KIND=wp )
728	ENDDO
729	ENDDO
730	ENDDO
731	ENDIF
732
733	CASE ( 'ws' )
734	IF ( ALLOCATED( ws_av ) ) THEN
735	DO i = nxl, nxr
736	DO j = nys, nyn
737	DO k = nzb, nzt+1
738	ws_av(k,j,i) = ws_av(k,j,i) / REAL( average_count_3d, KIND=wp )
739	ENDDO
740	ENDDO
741	ENDDO
742	ENDIF
743
744	CASE ( 'theta_2m*' )
745	IF ( ALLOCATED( pt_2m_av ) ) THEN
746	DO i = nxlg, nxrg
747	DO j = nysg, nyng
748	pt_2m_av(j,i) = pt_2m_av(j,i) / REAL( average_count_3d, KIND=wp )
749	ENDDO
750	ENDDO
751	CALL exchange_horiz_2d( pt_2m_av )
752	ENDIF
753
754	CASE ( 'wspeed_10m*' )
755	IF ( ALLOCATED( uv_10m_av ) ) THEN
756	DO i = nxlg, nxrg
757	DO j = nysg, nyng
758	uv_10m_av(j,i) = uv_10m_av(j,i) / REAL( average_count_3d, KIND=wp )
759	ENDDO
760	ENDDO
761	CALL exchange_horiz_2d( uv_10m_av )
762	ENDIF
763
764	CASE ( 'wspeed' )
765	IF ( ALLOCATED( wspeed_av ) ) THEN
766	DO i = nxl, nxr
767	DO j = nys, nyn
768	DO k = nzb, nzt+1
769	wspeed_av(k,j,i) = wspeed_av(k,j,i) / REAL( average_count_3d, KIND=wp )
770	ENDDO
771	ENDDO
772	ENDDO
773	ENDIF
774
775	CASE ( 'wdir' )
776	IF ( ALLOCATED( u_center_av ) .AND. ALLOCATED( v_center_av ) ) THEN
777
778	IF ( .NOT. ALLOCATED( wdir_av ) ) THEN
779	ALLOCATE( wdir_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
780	ENDIF
781	wdir_av = 0.0_wp
782
783	DO i = nxl, nxr
784	DO j = nys, nyn
785	DO k = nzb, nzt+1
786	u_center_av(k,j,i) = u_center_av(k,j,i) / REAL( average_count_3d, KIND=wp )
787	v_center_av(k,j,i) = v_center_av(k,j,i) / REAL( average_count_3d, KIND=wp )
788	wdir_av(k,j,i) = ATAN2( u_center_av(k,j,i), v_center_av(k,j,i) ) &
789	/ pi * 180.0_wp + 180.0_wp
790	ENDDO
791	ENDDO
792	ENDDO
793	ENDIF
794
795	END SELECT
796
797	ENDIF
798
799
800	END SUBROUTINE doq_3d_data_averaging
801
802	!--------------------------------------------------------------------------------------------------!
803	! Description:
804	! ------------
805	!> Check data output for diagnostic output
806	!--------------------------------------------------------------------------------------------------!
807	SUBROUTINE doq_check_data_output( var, unit, i, ilen, k )
808
809	IMPLICIT NONE
810
811	CHARACTER (LEN=*) :: unit !<
812	CHARACTER (LEN=*) :: var !<
813
814	INTEGER(iwp), OPTIONAL, INTENT(IN) :: i !< Current element of data_output
815	INTEGER(iwp), OPTIONAL, INTENT(IN) :: ilen !< Length of current entry in data_output
816	INTEGER(iwp), OPTIONAL, INTENT(IN) :: k !< Output is xy mode? 0 = no, 1 = yes
817
818
819	SELECT CASE ( TRIM( var ) )
820
821	CASE ( 'rh' )
822	unit = '%'
823
824	CASE ( 'ta' )
825	unit = 'degree_C'
826
827	CASE ( 'ti' )
828	unit = '1/s'
829
830	CASE ( 'uu' )
831	unit = 'm2/s2'
832
833	CASE ( 'vv' )
834	unit = 'm2/s2'
835
836	CASE ( 'ww' )
837	unit = 'm2/s2'
838
839	CASE ( 'wu' )
840	unit = 'm2/s2'
841
842	CASE ( 'wv' )
843	unit = 'm2/s2'
844
845	CASE ( 'wtheta' )
846	unit = 'Km/s'
847
848	CASE ( 'wq' )
849	unit = 'm/s'
850
851	CASE ( 'ws' )
852	IF ( .NOT. passive_scalar ) THEN
853	message_string = 'data_output = ' // TRIM( var ) // &
854	' is not implemented for passive_scalar = .FALSE.'
855	CALL message( 'diagnostic_output', 'PA0093', 1, 2, 0, 6, 0 )
856	ENDIF
857	unit = 'm/s'
858
859	CASE ( 'wspeed' )
860	unit = 'm/s'
861
862	CASE ( 'wdir' )
863	unit = 'degree'
864	!
865	!-- Treat horizotal cross-section output quanatities
866	CASE ( 'theta_2m', 'wspeed_10m' )
867	!
868	!-- Check if output quantity is _xy only.
869	IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN
870	message_string = 'illegal value for data_output: "' // &
871	TRIM( var ) // '" & only 2d-horizontal ' // &
872	'cross sections are allowed for this value'
873	CALL message( 'diagnostic_output', 'PA0111', 1, 2, 0, 6, 0 )
874	ENDIF
875
876	IF ( TRIM( var ) == 'theta_2m*' ) unit = 'K'
877	IF ( TRIM( var ) == 'wspeed_10m*' ) unit = 'm/s'
878
879	CASE DEFAULT
880	unit = 'illegal'
881
882	END SELECT
883
884
885	END SUBROUTINE doq_check_data_output
886
887
888	!--------------------------------------------------------------------------------------------------!
889	! Description:
890	! ------------
891	!> Set the unit of user defined profile output quantities. For those variables not recognized by the
892	!> user, the parameter unit is set to "illegal", which tells the calling routine that the
893	!> output variable is not defined and leads to a program abort.
894	!--------------------------------------------------------------------------------------------------!
895	SUBROUTINE doq_check_data_output_pr( variable, var_count, unit, dopr_unit )
896
897	CHARACTER (LEN=*) :: unit !<
898	CHARACTER (LEN=*) :: variable !<
899	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
900
901	INTEGER(iwp) :: pr_index !<
902	INTEGER(iwp) :: var_count !<
903
904	SELECT CASE ( TRIM( variable ) )
905
906	CASE ( 'rh' )
907	IF ( .NOT. humidity ) THEN
908	message_string = 'data_output_pr = ' // TRIM( data_output_pr(var_count) ) // &
909	' requires humidity'
910	CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 )
911	ENDIF
912	pr_index = 130
913	dopr_index(var_count) = pr_index
914	dopr_unit = '%'
915	unit = dopr_unit
916	hom(:,2,pr_index,:) = SPREAD( zu, 2, statistic_regions+1 )
917
918	CASE DEFAULT
919	unit = 'illegal'
920
921	END SELECT
922
923
924	END SUBROUTINE doq_check_data_output_pr
925
926
927	!--------------------------------------------------------------------------------------------------!
928	!
929	! Description:
930	! ------------
931	!> Subroutine defining appropriate grid for netcdf variables.
932	!--------------------------------------------------------------------------------------------------!
933	SUBROUTINE doq_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
934
935	IMPLICIT NONE
936
937	CHARACTER (LEN=*), INTENT(IN) :: variable !<
938	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
939	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
940	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
941
942	LOGICAL, INTENT(OUT) :: found !<
943
944
945	found = .TRUE.
946
947	SELECT CASE ( TRIM( variable ) )
948	!
949	!-- s grid
950	CASE ( 'rh', 'rh_xy', 'rh_xz', 'rh_yz', &
951	'ta', 'ta_xy', 'ta_xz', 'ta_yz', &
952	'ti', 'ti_xy', 'ti_xz', 'ti_yz', &
953	'wspeed', 'wspeed_xy', 'wspeed_xz', 'wspeed_yz', &
954	'wdir', 'wdir_xy', 'wdir_xz', 'wdir_yz' )
955
956	grid_x = 'x'
957	grid_y = 'y'
958	grid_z = 'zu'
959	!
960	!-- s grid surface variables
961	CASE ( 'theta_2m_xy', 'wspeed_10m' )
962
963	grid_x = 'x'
964	grid_y = 'y'
965	grid_z = 'zu'
966	!
967	!-- u grid
968	CASE ( 'uu', 'uu_xy', 'uu_xz', 'uu_yz' )
969
970	grid_x = 'xu'
971	grid_y = 'y'
972	grid_z = 'zu'
973	!
974	!-- v grid
975	CASE ( 'vv', 'vv_xy', 'vv_xz', 'vv_yz' )
976
977	grid_x = 'x'
978	grid_y = 'yv'
979	grid_z = 'zu'
980	!
981	!-- w grid
982	CASE ( 'ww', 'ww_xy', 'ww_xz', 'ww_yz', &
983	'wu', 'wu_xy', 'wu_xz', 'wu_yz', &
984	'wv', 'wv_xy', 'wv_xz', 'wv_yz', &
985	'wtheta', 'wtheta_xy', 'wtheta_xz', 'wtheta_yz', &
986	'wq', 'wq_xy', 'wq_xz', 'wq_yz', &
987	'ws', 'ws_xy', 'ws_xz', 'ws_yz' )
988
989	grid_x = 'x'
990	grid_y = 'y'
991	grid_z = 'zw'
992
993	CASE DEFAULT
994	found = .FALSE.
995	grid_x = 'none'
996	grid_y = 'none'
997	grid_z = 'none'
998
999	END SELECT
1000
1001
1002	END SUBROUTINE doq_define_netcdf_grid
1003
1004	!--------------------------------------------------------------------------------------------------!
1005	!
1006	! Description:
1007	! ------------
1008	!> Subroutine defining 2D output variables
1009	!--------------------------------------------------------------------------------------------------!
1010	SUBROUTINE doq_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, &
1011	fill_value )
1012
1013
1014	IMPLICIT NONE
1015
1016	CHARACTER (LEN=*) :: grid !<
1017	CHARACTER (LEN=*) :: mode !<
1018	CHARACTER (LEN=*) :: variable !<
1019
1020	INTEGER(iwp) :: av !< value indicating averaged or non-averaged output
1021	INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
1022	INTEGER(iwp) :: i !< grid index x-direction
1023	INTEGER(iwp) :: j !< grid index y-direction
1024	INTEGER(iwp) :: k !< grid index z-direction
1025	INTEGER(iwp) :: nzb_do !<
1026	INTEGER(iwp) :: nzt_do !<
1027
1028	LOGICAL :: found !< true if variable is in list
1029	LOGICAL :: resorted !< true if array is resorted
1030	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
1031
1032	REAL(wp) :: fill_value !< value for the _FillValue attribute
1033
1034	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
1035	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output
1036
1037
1038	flag_nr = 0
1039	found = .TRUE.
1040	resorted = .FALSE.
1041	two_d = .FALSE.
1042
1043	SELECT CASE ( TRIM( variable ) )
1044
1045	CASE ( 'rh_xy', 'rh_xz', 'rh_yz' )
1046	IF ( av == 0 ) THEN
1047	to_be_resorted => rh
1048	ELSE
1049	IF ( .NOT. ALLOCATED( rh_av ) ) THEN
1050	ALLOCATE( rh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1051	rh_av = REAL( fill_value, KIND = wp )
1052	ENDIF
1053	to_be_resorted => rh_av
1054	ENDIF
1055	flag_nr = 0
1056
1057	IF ( mode == 'xy' ) grid = 'zu'
1058
1059	CASE ( 'ta_xy', 'ta_xz', 'ta_yz' )
1060	IF ( av == 0 ) THEN
1061	to_be_resorted => ta
1062	ELSE
1063	IF ( .NOT. ALLOCATED( ta_av ) ) THEN
1064	ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1065	ta_av = REAL( fill_value, KIND = wp )
1066	ENDIF
1067	to_be_resorted => ta_av
1068	ENDIF
1069	flag_nr = 0
1070
1071	IF ( mode == 'xy' ) grid = 'zu'
1072
1073	CASE ( 'ti_xy', 'ti_xz', 'ti_yz' )
1074	IF ( av == 0 ) THEN
1075	to_be_resorted => ti
1076	ELSE
1077	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
1078	ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1079	ti_av = REAL( fill_value, KIND = wp )
1080	ENDIF
1081	to_be_resorted => ti_av
1082	ENDIF
1083	flag_nr = 0
1084
1085	IF ( mode == 'xy' ) grid = 'zu'
1086
1087	CASE ( 'uu_xy', 'uu_xz', 'uu_yz' )
1088	IF ( av == 0 ) THEN
1089	to_be_resorted => uu
1090	ELSE
1091	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
1092	ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1093	uu_av = REAL( fill_value, KIND = wp )
1094	ENDIF
1095	to_be_resorted => uu_av
1096	ENDIF
1097	flag_nr = 1
1098
1099	IF ( mode == 'xy' ) grid = 'zu'
1100
1101	CASE ( 'vv_xy', 'vv_xz', 'vv_yz' )
1102	IF ( av == 0 ) THEN
1103	to_be_resorted => vv
1104	ELSE
1105	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
1106	ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1107	vv_av = REAL( fill_value, KIND = wp )
1108	ENDIF
1109	to_be_resorted => vv_av
1110	ENDIF
1111	flag_nr = 2
1112
1113	IF ( mode == 'xy' ) grid = 'zu'
1114
1115	CASE ( 'ww_xy', 'ww_xz', 'ww_yz' )
1116	IF ( av == 0 ) THEN
1117	to_be_resorted => ww
1118	ELSE
1119	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
1120	ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1121	ww_av = REAL( fill_value, KIND = wp )
1122	ENDIF
1123	to_be_resorted => ww_av
1124	ENDIF
1125	flag_nr = 3
1126
1127	IF ( mode == 'xy' ) grid = 'zw'
1128
1129	CASE ( 'wu_xy', 'wu_xz', 'wu_yz' )
1130	IF ( av == 0 ) THEN
1131	to_be_resorted => wu
1132	ELSE
1133	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
1134	ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1135	wu_av = REAL( fill_value, KIND = wp )
1136	ENDIF
1137	to_be_resorted => wu_av
1138	ENDIF
1139	flag_nr = 0
1140
1141	IF ( mode == 'xy' ) grid = 'zw'
1142
1143	CASE ( 'wv_xy', 'wv_xz', 'wv_yz' )
1144	IF ( av == 0 ) THEN
1145	to_be_resorted => wv
1146	ELSE
1147	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
1148	ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1149	wv_av = REAL( fill_value, KIND = wp )
1150	ENDIF
1151	to_be_resorted => wv_av
1152	ENDIF
1153	flag_nr = 0
1154
1155	IF ( mode == 'xy' ) grid = 'zw'
1156
1157	CASE ( 'wtheta_xy', 'wtheta_xz', 'wtheta_yz' )
1158	IF ( av == 0 ) THEN
1159	to_be_resorted => wtheta
1160	ELSE
1161	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
1162	ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1163	wtheta_av = REAL( fill_value, KIND = wp )
1164	ENDIF
1165	to_be_resorted => wtheta_av
1166	ENDIF
1167	flag_nr = 0
1168
1169	IF ( mode == 'xy' ) grid = 'zw'
1170
1171	CASE ( 'wq_xy', 'wq_xz', 'wq_yz' )
1172	IF ( av == 0 ) THEN
1173	to_be_resorted => wq
1174	ELSE
1175	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
1176	ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1177	wq_av = REAL( fill_value, KIND = wp )
1178	ENDIF
1179	to_be_resorted => wq_av
1180	ENDIF
1181	flag_nr = 0
1182
1183	IF ( mode == 'xy' ) grid = 'zw'
1184
1185	CASE ( 'ws_xy', 'ws_xz', 'ws_yz' )
1186	IF ( av == 0 ) THEN
1187	to_be_resorted => ws
1188	ELSE
1189	IF ( .NOT. ALLOCATED( ws_av ) ) THEN
1190	ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1191	ws_av = REAL( fill_value, KIND = wp )
1192	ENDIF
1193	to_be_resorted => ws_av
1194	ENDIF
1195	flag_nr = 0
1196
1197	IF ( mode == 'xy' ) grid = 'zw'
1198
1199	CASE ( 'theta_2m*_xy' ) ! 2d-array
1200	IF ( av == 0 ) THEN
1201	DO i = nxl, nxr
1202	DO j = nys, nyn
1203	local_pf(i,j,nzb+1) = pt_2m(j,i)
1204	ENDDO
1205	ENDDO
1206	ELSE
1207	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
1208	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
1209	pt_2m_av = REAL( fill_value, KIND = wp )
1210	ENDIF
1211	DO i = nxl, nxr
1212	DO j = nys, nyn
1213	local_pf(i,j,nzb+1) = pt_2m_av(j,i)
1214	ENDDO
1215	ENDDO
1216	ENDIF
1217	resorted = .TRUE.
1218	two_d = .TRUE.
1219	grid = 'zu1'
1220
1221	CASE ( 'wspeed_10m*_xy' ) ! 2d-array
1222	IF ( av == 0 ) THEN
1223	DO i = nxl, nxr
1224	DO j = nys, nyn
1225	local_pf(i,j,nzb+1) = uv_10m(j,i)
1226	ENDDO
1227	ENDDO
1228	ELSE
1229	IF ( .NOT. ALLOCATED( uv_10m_av ) ) THEN
1230	ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
1231	uv_10m_av = REAL( fill_value, KIND = wp )
1232	ENDIF
1233	DO i = nxl, nxr
1234	DO j = nys, nyn
1235	local_pf(i,j,nzb+1) = uv_10m_av(j,i)
1236	ENDDO
1237	ENDDO
1238	ENDIF
1239	resorted = .TRUE.
1240	two_d = .TRUE.
1241	grid = 'zu1'
1242
1243	CASE ( 'wspeed_xy', 'wspeed_xz', 'wspeed_yz' )
1244	IF ( av == 0 ) THEN
1245	to_be_resorted => wspeed
1246	ELSE
1247	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
1248	ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1249	wspeed_av = REAL( fill_value, KIND = wp )
1250	ENDIF
1251	to_be_resorted => wspeed_av
1252	ENDIF
1253	flag_nr = 0
1254
1255	IF ( mode == 'xy' ) grid = 'zu'
1256
1257	CASE ( 'wdir_xy', 'wdir_xz', 'wdir_yz' )
1258	IF ( av == 0 ) THEN
1259	to_be_resorted => wdir
1260	ELSE
1261	IF ( .NOT. ALLOCATED( wdir_av ) ) THEN
1262	ALLOCATE( wdir_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1263	wdir_av = REAL( fill_value, KIND = wp )
1264	ENDIF
1265	to_be_resorted => wdir_av
1266	ENDIF
1267	flag_nr = 0
1268
1269	IF ( mode == 'xy' ) grid = 'zu'
1270
1271	CASE DEFAULT
1272	found = .FALSE.
1273	grid = 'none'
1274
1275	END SELECT
1276
1277	IF ( found .AND. .NOT. resorted ) THEN
1278	DO i = nxl, nxr
1279	DO j = nys, nyn
1280	DO k = nzb_do, nzt_do
1281	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1282	REAL( fill_value, KIND = wp ), &
1283	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
1284	ENDDO
1285	ENDDO
1286	ENDDO
1287	ENDIF
1288
1289	END SUBROUTINE doq_output_2d
1290
1291
1292	!--------------------------------------------------------------------------------------------------!
1293	!
1294	! Description:
1295	! ------------
1296	!> Subroutine defining 3D output variables
1297	!--------------------------------------------------------------------------------------------------!
1298	SUBROUTINE doq_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1299
1300	IMPLICIT NONE
1301
1302	CHARACTER (LEN=*) :: variable !<
1303
1304	INTEGER(iwp) :: av !< index indicating averaged or instantaneous output
1305	INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
1306	INTEGER(iwp) :: i !< index variable along x-direction
1307	INTEGER(iwp) :: j !< index variable along y-direction
1308	INTEGER(iwp) :: k !< index variable along z-direction
1309	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
1310	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
1311
1312	LOGICAL :: found !< true if variable is in list
1313	LOGICAL :: resorted !< true if array is resorted
1314
1315	REAL(wp) :: fill_value !< value for the _FillValue attribute
1316
1317	REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<
1318	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output
1319
1320
1321	flag_nr = 0
1322	found = .TRUE.
1323	resorted = .FALSE.
1324
1325	SELECT CASE ( TRIM( variable ) )
1326
1327	CASE ( 'rh' )
1328	IF ( av == 0 ) THEN
1329	to_be_resorted => rh
1330	ELSE
1331	IF ( .NOT. ALLOCATED( rh ) ) THEN
1332	ALLOCATE( rh(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1333	rh = REAL( fill_value, KIND = wp )
1334	ENDIF
1335	to_be_resorted => rh
1336	ENDIF
1337	flag_nr = 0
1338
1339	CASE ( 'ta' )
1340	IF ( av == 0 ) THEN
1341	to_be_resorted => ta
1342	ELSE
1343	IF ( .NOT. ALLOCATED( ta ) ) THEN
1344	ALLOCATE( ta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1345	ta = REAL( fill_value, KIND = wp )
1346	ENDIF
1347	to_be_resorted => ta
1348	ENDIF
1349	flag_nr = 0
1350
1351	CASE ( 'ti' )
1352	IF ( av == 0 ) THEN
1353	to_be_resorted => ti
1354	ELSE
1355	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
1356	ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1357	ti_av = REAL( fill_value, KIND = wp )
1358	ENDIF
1359	to_be_resorted => ti_av
1360	ENDIF
1361	flag_nr = 0
1362
1363	CASE ( 'uu' )
1364	IF ( av == 0 ) THEN
1365	to_be_resorted => uu
1366	ELSE
1367	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
1368	ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1369	uu_av = REAL( fill_value, KIND = wp )
1370	ENDIF
1371	to_be_resorted => uu_av
1372	ENDIF
1373	flag_nr = 1
1374
1375	CASE ( 'vv' )
1376	IF ( av == 0 ) THEN
1377	to_be_resorted => vv
1378	ELSE
1379	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
1380	ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1381	vv_av = REAL( fill_value, KIND = wp )
1382	ENDIF
1383	to_be_resorted => vv_av
1384	ENDIF
1385	flag_nr = 2
1386
1387	CASE ( 'ww' )
1388	IF ( av == 0 ) THEN
1389	to_be_resorted => ww
1390	ELSE
1391	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
1392	ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1393	ww_av = REAL( fill_value, KIND = wp )
1394	ENDIF
1395	to_be_resorted => ww_av
1396	ENDIF
1397	flag_nr = 3
1398
1399	CASE ( 'wu' )
1400	IF ( av == 0 ) THEN
1401	to_be_resorted => wu
1402	ELSE
1403	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
1404	ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1405	wu_av = REAL( fill_value, KIND = wp )
1406	ENDIF
1407	to_be_resorted => wu_av
1408	ENDIF
1409	flag_nr = 0
1410
1411	CASE ( 'wv' )
1412	IF ( av == 0 ) THEN
1413	to_be_resorted => wv
1414	ELSE
1415	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
1416	ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1417	wv_av = REAL( fill_value, KIND = wp )
1418	ENDIF
1419	to_be_resorted => wv_av
1420	ENDIF
1421	flag_nr = 0
1422
1423	CASE ( 'wtheta' )
1424	IF ( av == 0 ) THEN
1425	to_be_resorted => wtheta
1426	ELSE
1427	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
1428	ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1429	wtheta_av = REAL( fill_value, KIND = wp )
1430	ENDIF
1431	to_be_resorted => wtheta_av
1432	ENDIF
1433	flag_nr = 0
1434
1435	CASE ( 'wq' )
1436	IF ( av == 0 ) THEN
1437	to_be_resorted => wq
1438	ELSE
1439	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
1440	ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1441	wq_av = REAL( fill_value, KIND = wp )
1442	ENDIF
1443	to_be_resorted => wq_av
1444	ENDIF
1445	flag_nr = 0
1446
1447	CASE ( 'ws' )
1448	IF ( av == 0 ) THEN
1449	to_be_resorted => ws
1450	ELSE
1451	IF ( .NOT. ALLOCATED( ws_av ) ) THEN
1452	ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1453	ws_av = REAL( fill_value, KIND = wp )
1454	ENDIF
1455	to_be_resorted => ws_av
1456	ENDIF
1457	flag_nr = 0
1458
1459	CASE ( 'wspeed' )
1460	IF ( av == 0 ) THEN
1461	to_be_resorted => wspeed
1462	ELSE
1463	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
1464	ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1465	wspeed_av = REAL( fill_value, KIND = wp )
1466	ENDIF
1467	to_be_resorted => wspeed_av
1468	ENDIF
1469	flag_nr = 0
1470
1471	CASE ( 'wdir' )
1472	IF ( av == 0 ) THEN
1473	to_be_resorted => wdir
1474	ELSE
1475	IF ( .NOT. ALLOCATED( wdir_av ) ) THEN
1476	ALLOCATE( wdir_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1477	wdir_av = REAL( fill_value, KIND = wp )
1478	ENDIF
1479	to_be_resorted => wdir_av
1480	ENDIF
1481	flag_nr = 0
1482
1483	CASE DEFAULT
1484	found = .FALSE.
1485
1486	END SELECT
1487
1488	IF ( found .AND. .NOT. resorted ) THEN
1489	DO i = nxl, nxr
1490	DO j = nys, nyn
1491	DO k = nzb_do, nzt_do
1492	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1493	REAL( fill_value, KIND = wp ), &
1494	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
1495	ENDDO
1496	ENDDO
1497	ENDDO
1498	ENDIF
1499
1500	END SUBROUTINE doq_output_3d
1501
1502
1503	!--------------------------------------------------------------------------------------------------!
1504	!
1505	! Description:
1506	! ------------
1507	!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
1508	!> (i,j,k) for masked data output.
1509	!--------------------------------------------------------------------------------------------------!
1510	SUBROUTINE doq_output_mask( av, variable, found, local_pf, mid )
1511
1512	USE control_parameters
1513
1514	USE indices
1515
1516	IMPLICIT NONE
1517
1518	REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute
1519
1520	CHARACTER (LEN=*) :: variable !<
1521	CHARACTER (LEN=5) :: grid !< flag to distinquish between staggered grids
1522
1523	INTEGER(iwp) :: av !< index indicating averaged or instantaneous output
1524	INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
1525	INTEGER(iwp) :: i !< index variable along x-direction
1526	INTEGER(iwp) :: j !< index variable along y-direction
1527	INTEGER(iwp) :: k !< index variable along z-direction
1528	INTEGER(iwp) :: im !< loop index for masked variables
1529	INTEGER(iwp) :: jm !< loop index for masked variables
1530	INTEGER(iwp) :: kk !< masked output index variable along z-direction
1531	INTEGER(iwp) :: mid !< masked output running index
1532	INTEGER(iwp) :: ktt !< k index of highest horizontal surface
1533
1534	LOGICAL :: found !< true if variable is in list
1535	LOGICAL :: resorted !< true if array is resorted
1536
1537	REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !<
1538
1539	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output
1540
1541
1542	flag_nr = 0
1543	found = .TRUE.
1544	resorted = .FALSE.
1545	grid = 's'
1546
1547	SELECT CASE ( TRIM( variable ) )
1548
1549	CASE ( 'rh' )
1550	IF ( av == 0 ) THEN
1551	to_be_resorted => rh
1552	ELSE
1553	to_be_resorted => rh_av
1554	ENDIF
1555	grid = 's'
1556	flag_nr = 0
1557
1558	CASE ( 'ta' )
1559	IF ( av == 0 ) THEN
1560	to_be_resorted => ta
1561	ELSE
1562	to_be_resorted => ta_av
1563	ENDIF
1564	grid = 's'
1565	flag_nr = 0
1566
1567	CASE ( 'ti' )
1568	IF ( av == 0 ) THEN
1569	to_be_resorted => ti
1570	ELSE
1571	to_be_resorted => ti_av
1572	ENDIF
1573	grid = 's'
1574	flag_nr = 0
1575
1576	CASE ( 'uu' )
1577	IF ( av == 0 ) THEN
1578	to_be_resorted => uu
1579	ELSE
1580	to_be_resorted => uu_av
1581	ENDIF
1582	grid = 'u'
1583	flag_nr = 1
1584
1585	CASE ( 'vv' )
1586	IF ( av == 0 ) THEN
1587	to_be_resorted => vv
1588	ELSE
1589	to_be_resorted => vv_av
1590	ENDIF
1591	grid = 'v'
1592	flag_nr = 2
1593
1594	CASE ( 'ww' )
1595	IF ( av == 0 ) THEN
1596	to_be_resorted => ww
1597	ELSE
1598	to_be_resorted => ww_av
1599	ENDIF
1600	grid = 'w'
1601	flag_nr = 3
1602
1603	CASE ( 'wu' )
1604	IF ( av == 0 ) THEN
1605	to_be_resorted => wu
1606	ELSE
1607	to_be_resorted => wu_av
1608	ENDIF
1609	grid = 's'
1610	flag_nr = 0
1611
1612	CASE ( 'wv' )
1613	IF ( av == 0 ) THEN
1614	to_be_resorted => wv
1615	ELSE
1616	to_be_resorted => wv_av
1617	ENDIF
1618	grid = 's'
1619	flag_nr = 0
1620
1621	CASE ( 'wtheta' )
1622	IF ( av == 0 ) THEN
1623	to_be_resorted => wtheta
1624	ELSE
1625	to_be_resorted => wtheta_av
1626	ENDIF
1627	grid = 's'
1628	flag_nr = 0
1629
1630	CASE ( 'wq' )
1631	IF ( av == 0 ) THEN
1632	to_be_resorted => wq
1633	ELSE
1634	to_be_resorted => wq_av
1635	ENDIF
1636	grid = 's'
1637	flag_nr = 0
1638
1639	CASE ( 'ws' )
1640	IF ( av == 0 ) THEN
1641	to_be_resorted => ws
1642	ELSE
1643	to_be_resorted => ws_av
1644	ENDIF
1645	grid = 's'
1646	flag_nr = 0
1647
1648	CASE ( 'wspeed' )
1649	IF ( av == 0 ) THEN
1650	to_be_resorted => wspeed
1651	ELSE
1652	to_be_resorted => wspeed_av
1653	ENDIF
1654	grid = 's'
1655	flag_nr = 0
1656
1657	CASE ( 'wdir' )
1658	IF ( av == 0 ) THEN
1659	to_be_resorted => wdir
1660	ELSE
1661	to_be_resorted => wdir_av
1662	ENDIF
1663	grid = 's'
1664	flag_nr = 0
1665
1666	CASE DEFAULT
1667	found = .FALSE.
1668
1669	END SELECT
1670
1671	IF ( found .AND. .NOT. resorted ) THEN
1672	IF ( .NOT. mask_surface(mid) ) THEN
1673	!
1674	!-- Default masked output
1675	DO i = 1, mask_size_l(mid,1)
1676	DO j = 1, mask_size_l(mid,2)
1677	DO k = 1, mask_size_l(mid,3)
1678	local_pf(i,j,k) = MERGE( to_be_resorted(mask_k(mid,k), &
1679	mask_j(mid,j), &
1680	mask_i(mid,i)), &
1681	REAL( fill_value, KIND = wp ), &
1682	BTEST( wall_flags_total_0(mask_k(mid,k), &
1683	mask_j(mid,j), &
1684	mask_i(mid,i)), &
1685	flag_nr ) )
1686	ENDDO
1687	ENDDO
1688	ENDDO
1689
1690	ELSE
1691	!
1692	!-- Terrain-following masked output
1693	DO i = 1, mask_size_l(mid,1)
1694	DO j = 1, mask_size_l(mid,2)
1695	!
1696	!-- Get k index of the lowest non-terrain grid point, else set fill value
1697	im = mask_i(mid,i)
1698	jm = mask_j(mid,j)
1699	ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ), DIM=1 ) - 1
1700	DO k = 1, mask_size_l(mid,3)
1701	kk = MIN( ktt + mask_k(mid,k) - 1, nzt+1 )
1702	!
1703	!-- Set value if not in building
1704	IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN
1705	local_pf(i,j,k) = fill_value
1706	ELSE
1707	local_pf(i,j,k) = to_be_resorted(kk,jm,im)
1708	ENDIF
1709	ENDDO
1710	ENDDO
1711	ENDDO
1712
1713	ENDIF
1714	ENDIF
1715
1716	END SUBROUTINE doq_output_mask
1717
1718	!--------------------------------------------------------------------------------------------------!
1719	! Description:
1720	! ------------
1721	!> Allocate required arrays
1722	!--------------------------------------------------------------------------------------------------!
1723	SUBROUTINE doq_init
1724
1725	IMPLICIT NONE
1726
1727	INTEGER(iwp) :: ivar !< loop index over all 2d/3d/mask output quantities
1728
1729
1730	!
1731	!-- Next line is to avoid compiler warnings about unused variables
1732	IF ( timestep_number_at_prev_calc == 0 ) CONTINUE
1733	!
1734	!-- Preparatory steps and initialization of output arrays
1735	IF ( .NOT. prepared_diagnostic_output_quantities ) CALL doq_prepare
1736
1737	initialized_diagnostic_output_quantities = .FALSE.
1738
1739	ivar = 1
1740
1741	DO WHILE ( ivar <= SIZE( do_all ) )
1742
1743	SELECT CASE ( TRIM( do_all(ivar) ) )
1744	!
1745	!-- Allocate array for 'relative humidity'
1746	CASE ( 'rh' )
1747	IF ( .NOT. ALLOCATED( rh ) ) THEN
1748	ALLOCATE( rh(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1749	rh = 0.0_wp
1750	ENDIF
1751	!
1752	!-- Allocate array for 'air temperature'
1753	CASE ( 'ta' )
1754	IF ( .NOT. ALLOCATED( ta ) ) THEN
1755	ALLOCATE( ta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1756	ta = 0.0_wp
1757	ENDIF
1758	!
1759	!-- Allocate array for 'turbulence intensity'
1760	CASE ( 'ti' )
1761	IF ( .NOT. ALLOCATED( ti ) ) THEN
1762	ALLOCATE( ti(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1763	ti = 0.0_wp
1764	ENDIF
1765	!
1766	!-- Allocate array for uu
1767	CASE ( 'uu' )
1768	IF ( .NOT. ALLOCATED( uu ) ) THEN
1769	ALLOCATE( uu(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1770	uu = 0.0_wp
1771	ENDIF
1772	!
1773	!-- Allocate array for vv
1774	CASE ( 'vv' )
1775	IF ( .NOT. ALLOCATED( vv ) ) THEN
1776	ALLOCATE( vv(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1777	vv = 0.0_wp
1778	ENDIF
1779	!
1780	!-- Allocate array for ww
1781	CASE ( 'ww' )
1782	IF ( .NOT. ALLOCATED( ww ) ) THEN
1783	ALLOCATE( ww(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1784	ww = 0.0_wp
1785	ENDIF
1786	!
1787	!-- Allocate array for wu
1788	CASE ( 'wu' )
1789	IF ( .NOT. ALLOCATED( wu ) ) THEN
1790	ALLOCATE( wu(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1791	wu = 0.0_wp
1792	ENDIF
1793	!
1794	!-- Allocate array for wv
1795	CASE ( 'wv' )
1796	IF ( .NOT. ALLOCATED( wv ) ) THEN
1797	ALLOCATE( wv(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1798	wv = 0.0_wp
1799	ENDIF
1800	!
1801	!-- Allocate array for wtheta
1802	CASE ( 'wtheta' )
1803	IF ( .NOT. ALLOCATED( wtheta ) ) THEN
1804	ALLOCATE( wtheta(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1805	wtheta = 0.0_wp
1806	ENDIF
1807	!
1808	!-- Allocate array for wq
1809	CASE ( 'wq' )
1810	IF ( .NOT. ALLOCATED( wq ) ) THEN
1811	ALLOCATE( wq(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1812	wq = 0.0_wp
1813	ENDIF
1814	!
1815	!-- Allocate array for ws
1816	CASE ( 'ws' )
1817	IF ( .NOT. ALLOCATED( ws ) ) THEN
1818	ALLOCATE( ws(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1819	ws = 0.0_wp
1820	ENDIF
1821	!
1822	!-- Allocate array for 2-m potential temperature
1823	CASE ( 'theta_2m*' )
1824	IF ( .NOT. ALLOCATED( pt_2m ) ) THEN
1825	ALLOCATE( pt_2m(nysg:nyng,nxlg:nxrg) )
1826	pt_2m = 0.0_wp
1827	ENDIF
1828	!
1829	!-- Allocate array for 10-m wind speed
1830	CASE ( 'wspeed_10m*' )
1831	IF ( .NOT. ALLOCATED( uv_10m ) ) THEN
1832	ALLOCATE( uv_10m(nysg:nyng,nxlg:nxrg) )
1833	uv_10m = 0.0_wp
1834	ENDIF
1835	!
1836	!-- Allocate array for wspeed
1837	CASE ( 'wspeed' )
1838	IF ( .NOT. ALLOCATED( wspeed ) ) THEN
1839	ALLOCATE( wspeed(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1840	wspeed = 0.0_wp
1841	ENDIF
1842
1843	!
1844	!-- Allocate array for wdir
1845	CASE ( 'wdir' )
1846	IF ( .NOT. ALLOCATED( u_center ) ) THEN
1847	ALLOCATE( u_center(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1848	u_center = 0.0_wp
1849	ENDIF
1850	IF ( .NOT. ALLOCATED( v_center ) ) THEN
1851	ALLOCATE( v_center(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1852	v_center = 0.0_wp
1853	ENDIF
1854	IF ( .NOT. ALLOCATED( wdir ) ) THEN
1855	ALLOCATE( wdir(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1856	wdir = 0.0_wp
1857	ENDIF
1858
1859	END SELECT
1860
1861	ivar = ivar + 1
1862	ENDDO
1863
1864	initialized_diagnostic_output_quantities = .TRUE.
1865
1866	END SUBROUTINE doq_init
1867
1868
1869	!--------------------------------------------------------------------------------------------------!
1870	! Description:
1871	! ------------
1872	!> Calculation of module-specific statistics, i.e. horizontally averaged profiles and time series.
1873	!> This is called for every statistic region sr, but at least for the region "total domain" (sr=0).
1874	!--------------------------------------------------------------------------------------------------!
1875	SUBROUTINE doq_statistics( mode, sr, tn )
1876
1877
1878	CHARACTER (LEN=*) :: mode !<
1879
1880	! INTEGER(iwp) :: i !<
1881	! INTEGER(iwp) :: j !<
1882	! INTEGER(iwp) :: k !<
1883	INTEGER(iwp) :: sr !<
1884	INTEGER(iwp) :: tn !<
1885	!
1886	!-- Next line is to avoid compiler warning about unused variables. Please remove.
1887	IF ( sr == 0 .OR. tn == 0 ) CONTINUE
1888
1889	IF ( mode == 'profiles' ) THEN
1890
1891	ELSEIF ( mode == 'time_series' ) THEN
1892
1893	ENDIF
1894
1895	END SUBROUTINE doq_statistics
1896
1897
1898	!--------------------------------------------------------------------------------------------------!
1899	! Description:
1900	! ------------
1901	!> Calculate diagnostic quantities
1902	!--------------------------------------------------------------------------------------------------!
1903	SUBROUTINE doq_calculate
1904
1905	IMPLICIT NONE
1906
1907	INTEGER(iwp) :: i !< grid index x-dimension
1908	INTEGER(iwp) :: j !< grid index y-dimension
1909	INTEGER(iwp) :: k !< grid index z-dimension
1910	INTEGER(iwp) :: ivar !< loop index over all 2d/3d/mask output quantities
1911
1912	REAL(wp) :: temp !< temperature
1913	REAL(wp) :: e_s !< saturation vapor pressure
1914	REAL(wp) :: q_s !< saturation mixing ratio
1915
1916	TYPE(surf_type), POINTER :: surf !< surf-type array, used to generalize subroutines
1917
1918
1919	! CALL cpu_log( log_point(41), 'calculate_quantities', 'start' )
1920
1921	!
1922	!-- Save timestep number to check in time_integration if doq_calculate has been called already,
1923	!-- since the CALL occurs at two locations, but the calculations need to be done only once per
1924	!-- timestep.
1925	timestep_number_at_prev_calc = current_timestep_number
1926
1927	ivar = 1
1928
1929	DO WHILE ( ivar <= SIZE( do_all ) )
1930
1931	SELECT CASE ( TRIM( do_all(ivar) ) )
1932	!
1933	!-- rh (relative humidity)
1934	CASE ( 'rh' )
1935	DO i = nxl, nxr
1936	DO j = nys, nyn
1937	DO k = nzb+1, nzt
1938	IF ( humidity ) THEN
1939	temp = exner(k) * pt(k,j,i)
1940	e_s = magnus( temp )
1941	q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
1942	rh(k,j,i) = q(k,j,i) / q_s * 100.0_wp &
1943	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
1944	ENDIF
1945	ENDDO
1946	ENDDO
1947	ENDDO
1948	!
1949	!-- ta (air temperature)
1950	CASE ( 'ta' )
1951	DO i = nxl, nxr
1952	DO j = nys, nyn
1953	DO k = nzb+1, nzt
1954	ta(k,j,i) = exner(k) * pt(k,j,i) - degc_to_k
1955	ENDDO
1956	ENDDO
1957	ENDDO
1958	!
1959	!-- Calculate 'turbulence intensity' from rot[(u,v,w)] at scalar grid point
1960	CASE ( 'ti' )
1961	DO i = nxl, nxr
1962	DO j = nys, nyn
1963	DO k = nzb+1, nzt
1964	ti(k,j,i) = 0.25_wp * SQRT( &
1965	( ( w(k,j+1,i) + w(k-1,j+1,i) &
1966	- w(k,j-1,i) - w(k-1,j-1,i) ) * ddy &
1967	- ( v(k+1,j,i) + v(k+1,j+1,i) &
1968	- v(k-1,j,i) - v(k-1,j+1,i) ) * ddzu(k) )**2 &
1969	+ ( ( u(k+1,j,i) + u(k+1,j,i+1) &
1970	- u(k-1,j,i) - u(k-1,j,i+1) ) * ddzu(k) &
1971	- ( w(k,j,i+1) + w(k-1,j,i+1) &
1972	- w(k,j,i-1) - w(k-1,j,i-1) ) * ddx )**2 &
1973	+ ( ( v(k,j,i+1) + v(k,j+1,i+1) &
1974	- v(k,j,i-1) - v(k,j+1,i-1) ) * ddx &
1975	- ( u(k,j+1,i) + u(k,j+1,i+1) &
1976	- u(k,j-1,i) - u(k,j-1,i+1) ) * ddy )**2 ) &
1977	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
1978	ENDDO
1979	ENDDO
1980	ENDDO
1981	!
1982	!-- uu
1983	CASE ( 'uu' )
1984	DO i = nxl, nxr
1985	DO j = nys, nyn
1986	DO k = nzb+1, nzt
1987	uu(k,j,i) = u(k,j,i) * u(k,j,i) &
1988	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
1989	ENDDO
1990	ENDDO
1991	ENDDO
1992	!
1993	!-- vv
1994	CASE ( 'vv' )
1995	DO i = nxl, nxr
1996	DO j = nys, nyn
1997	DO k = nzb+1, nzt
1998	vv(k,j,i) = v(k,j,i) * v(k,j,i) &
1999	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
2000	ENDDO
2001	ENDDO
2002	ENDDO
2003	!
2004	!-- ww
2005	CASE ( 'ww' )
2006	DO i = nxl, nxr
2007	DO j = nys, nyn
2008	DO k = nzb+1, nzt-1
2009	ww(k,j,i) = w(k,j,i) * w(k,j,i) &
2010	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
2011	ENDDO
2012	ENDDO
2013	ENDDO
2014	!
2015	!-- wu
2016	CASE ( 'wu' )
2017	DO i = nxl, nxr
2018	DO j = nys, nyn
2019	DO k = nzb+1, nzt-1
2020	wu(k,j,i) = w(k,j,i) &
2021	* 0.25_wp * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) )&
2022	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2023	ENDDO
2024	ENDDO
2025	ENDDO
2026	!
2027	!-- wv
2028	CASE ( 'wv' )
2029	DO i = nxl, nxr
2030	DO j = nys, nyn
2031	DO k = nzb+1, nzt-1
2032	wv(k,j,i) = w(k,j,i) &
2033	* 0.25_wp * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) )&
2034	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
2035	ENDDO
2036	ENDDO
2037	ENDDO
2038	!
2039	!-- wtheta
2040	CASE ( 'wtheta' )
2041	DO i = nxl, nxr
2042	DO j = nys, nyn
2043	DO k = nzb+1, nzt-1
2044	wtheta(k,j,i) = w(k,j,i) &
2045	* 0.5_wp * ( pt(k,j,i) + pt(k+1,j,i) ) &
2046	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ))
2047	ENDDO
2048	ENDDO
2049	ENDDO
2050	!
2051	!-- wq
2052	CASE ( 'wq' )
2053	DO i = nxl, nxr
2054	DO j = nys, nyn
2055	DO k = nzb+1, nzt-1
2056	wq(k,j,i) = w(k,j,i) * 0.5_wp * ( q(k,j,i) + q(k+1,j,i) ) &
2057	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
2058	ENDDO
2059	ENDDO
2060	ENDDO
2061	!
2062	!-- ws
2063	CASE ( 'ws' )
2064	DO i = nxl, nxr
2065	DO j = nys, nyn
2066	DO k = nzb+1, nzt-1
2067	ws(k,j,i) = w(k,j,i) * 0.5_wp * ( s(k,j,i) + s(k+1,j,i) ) &
2068	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
2069	ENDDO
2070	ENDDO
2071	ENDDO
2072	!
2073	!-- 2-m potential temperature
2074	CASE ( 'theta_2m*' )
2075	!
2076	!-- 2-m potential temperature is caluclated from surface arrays. In case the 2m level is
2077	!-- below the first grid point, MOST is applied, else, linear interpolation between two
2078	!-- vertical grid levels is applied. To access all surfaces, iterate over all horizontally-
2079	!-- upward facing surface types.
2080	surf => surf_def_h(0)
2081	CALL calc_pt_2m
2082	surf => surf_lsm_h(0)
2083	CALL calc_pt_2m
2084	surf => surf_usm_h(0)
2085	CALL calc_pt_2m
2086	!
2087	!-- 10-m wind speed
2088	CASE ( 'wspeed_10m*' )
2089	!
2090	!-- 10-m wind speed is caluclated from surface arrays. In case the 10m level is below the
2091	!-- first grid point, MOST is applied, else, linear interpolation between two vertical grid
2092	!-- levels is applied. To access all surfaces, iterate over all horizontally-upward facing
2093	!-- surface types.
2094	surf => surf_def_h(0)
2095	CALL calc_wind_10m
2096	surf => surf_lsm_h(0)
2097	CALL calc_wind_10m
2098	surf => surf_usm_h(0)
2099	CALL calc_wind_10m
2100	!
2101	!-- Horizontal wind speed
2102	CASE ( 'wspeed' )
2103	DO i = nxl, nxr
2104	DO j = nys, nyn
2105	DO k = nzb, nzt+1
2106	wspeed(k,j,i) = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2 &
2107	+ ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2 ) &
2108	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ))
2109	ENDDO
2110	ENDDO
2111	ENDDO
2112
2113	!
2114	!-- Horizontal wind direction
2115	CASE ( 'wdir' )
2116	DO i = nxl, nxr
2117	DO j = nys, nyn
2118	DO k = nzb, nzt+1
2119	u_center(k,j,i) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) )
2120	v_center(k,j,i) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) )
2121
2122	wdir(k,j,i) = ATAN2( u_center(k,j,i), v_center(k,j,i) ) &
2123	/ pi * 180.0_wp + 180.0_wp
2124	ENDDO
2125	ENDDO
2126	ENDDO
2127
2128	END SELECT
2129
2130	ivar = ivar + 1
2131	ENDDO
2132
2133	! CALL cpu_log( log_point(41), 'calculate_quantities', 'stop' )
2134
2135	!
2136	!-- The following block contains subroutines to calculate diagnostic surface quantities.
2137	CONTAINS
2138	!--------------------------------------------------------------------------------------------------!
2139	! Description:
2140	! ------------
2141	!> Calculation of 2-m potential temperature.
2142	!--------------------------------------------------------------------------------------------------!
2143	SUBROUTINE calc_pt_2m
2144
2145	USE surface_layer_fluxes_mod, &
2146	ONLY: psi_h
2147
2148	IMPLICIT NONE
2149
2150	INTEGER(iwp) :: kk !< running index along the z-dimension
2151	INTEGER(iwp) :: m !< running index for surface elements
2152
2153	DO m = 1, surf%ns
2154
2155	i = surf%i(m)
2156	j = surf%j(m)
2157	k = surf%k(m)
2158	!
2159	!-- If 2-m level is below the first grid level, MOST is used for calculation of
2160	!-- 2-m temperature.
2161	IF ( surf%z_mo(m) > 2.0_wp ) THEN
2162	pt_2m(j,i) = surf%pt_surface(m) + surf%ts(m) / kappa &
2163	* ( LOG( 2.0_wp / surf%z0h(m) ) &
2164	- psi_h( 2.0_wp / surf%ol(m) ) &
2165	+ psi_h( surf%z0h(m) / surf%ol(m) ) )
2166	!
2167	!-- If 2-m level is above the first grid level, 2-m temperature is linearly interpolated
2168	!-- between the two nearest vertical grid levels. Note, since 2-m temperature is only
2169	!-- computed for horizontal upward-facing surfaces, only a vertical interpolation is
2170	!-- necessary.
2171	ELSE
2172	!
2173	!-- zw(k-1) defines the height of the surface.
2174	kk = k
2175	DO WHILE ( zu(kk) - zw(k-1) < 2.0_wp .AND. kk <= nzt )
2176	kk = kk + 1
2177	ENDDO
2178	!
2179	!-- kk defines the index of the first grid level >= 2m.
2180	pt_2m(j,i) = pt(kk-1,j,i) + &
2181	( zw(k-1) + 2.0_wp - zu(kk-1) ) * &
2182	( pt(kk,j,i) - pt(kk-1,j,i) ) / &
2183	( zu(kk) - zu(kk-1) )
2184	ENDIF
2185
2186	ENDDO
2187
2188	END SUBROUTINE calc_pt_2m
2189
2190	!--------------------------------------------------------------------------------------------------!
2191	! Description:
2192	! ------------
2193	!> Calculation of 10-m wind speed.
2194	!--------------------------------------------------------------------------------------------------!
2195	SUBROUTINE calc_wind_10m
2196
2197	USE surface_layer_fluxes_mod, &
2198	ONLY: psi_m
2199
2200	IMPLICIT NONE
2201
2202	INTEGER(iwp) :: kk !< running index along the z-dimension
2203	INTEGER(iwp) :: m !< running index for surface elements
2204
2205	REAL(wp) :: uv_l !< wind speed at lower grid point
2206	REAL(wp) :: uv_u !< wind speed at upper grid point
2207
2208
2209	DO m = 1, surf%ns
2210
2211	i = surf%i(m)
2212	j = surf%j(m)
2213	k = surf%k(m)
2214	!
2215	!-- If 10-m level is below the first grid level, MOST is used for calculation of 10-m
2216	!-- temperature.
2217	IF ( surf%z_mo(m) > 10.0_wp ) THEN
2218	uv_10m(j,i) = surf%us(m) / kappa &
2219	* ( LOG( 10.0_wp / surf%z0(m) ) &
2220	- psi_m( 10.0_wp / surf%ol(m) ) &
2221	+ psi_m( surf%z0(m) / surf%ol(m) ) )
2222	!
2223	!-- If 10-m level is above the first grid level, 10-m wind speed is linearly interpolated
2224	!-- between the two nearest vertical grid levels. Note, since 10-m temperature is only
2225	!-- computed for horizontal upward-facing surfaces, only a vertical interpolation is
2226	!-- necessary.
2227	ELSE
2228	!
2229	!-- zw(k-1) defines the height of the surface.
2230	kk = k
2231	DO WHILE ( zu(kk) - zw(k-1) < 10.0_wp .AND. kk <= nzt )
2232	kk = kk + 1
2233	ENDDO
2234	!
2235	!-- kk defines the index of the first grid level >= 10m.
2236	uv_l = SQRT( ( 0.5_wp * ( u(kk-1,j,i) + u(kk-1,j,i+1) ) )**2 &
2237	+ ( 0.5_wp * ( v(kk-1,j,i) + v(kk-1,j+1,i) ) )**2 )
2238
2239	uv_u = SQRT( ( 0.5_wp * ( u(kk,j,i) + u(kk,j,i+1) ) )**2 &
2240	+ ( 0.5_wp * ( v(kk,j,i) + v(kk,j+1,i) ) )**2 )
2241
2242	uv_10m(j,i) = uv_l + ( zw(k-1) + 10.0_wp - zu(kk-1) ) * &
2243	( uv_u - uv_l ) / &
2244	( zu(kk) - zu(kk-1) )
2245
2246	ENDIF
2247
2248	ENDDO
2249
2250	END SUBROUTINE calc_wind_10m
2251
2252	END SUBROUTINE doq_calculate
2253
2254
2255	!--------------------------------------------------------------------------------------------------!
2256	! Description:
2257	! ------------
2258	!> Preparation of the diagnostic output, counting of the module-specific output quantities and
2259	!> gathering of the output names.
2260	!--------------------------------------------------------------------------------------------------!
2261	SUBROUTINE doq_prepare
2262
2263	USE control_parameters, &
2264	ONLY: do2d, do3d, domask, masks
2265
2266	IMPLICIT NONE
2267
2268	CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) :: do2d_var = ' ' !< label array for 2d output quantities
2269
2270	INTEGER(iwp) :: av !< index defining type of output, av=0 instantaneous, av=1 averaged
2271	INTEGER(iwp) :: ivar !< loop index
2272	INTEGER(iwp) :: ivar_all !< loop index
2273	INTEGER(iwp) :: l !< index for cutting string
2274	INTEGER(iwp) :: mid !< masked output running index
2275
2276
2277	prepared_diagnostic_output_quantities = .FALSE.
2278
2279	ivar = 1
2280	ivar_all = 1
2281
2282	DO av = 0, 1
2283	!
2284	!-- Remove _xy, _xz, or _yz from string
2285	l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
2286	do2d_var(av,ivar)(1:l-3) = do2d(av,ivar)(1:l-3)
2287	!
2288	!-- Gather 2d output quantity names.
2289	!-- Check for double occurrence of output quantity, e.g. by _xy, _yz, _xz.
2290	DO WHILE ( do2d_var(av,ivar)(1:1) /= ' ' )
2291	IF ( .NOT. ANY( do_all == do2d_var(av,ivar) ) ) THEN
2292	do_all(ivar_all) = do2d_var(av,ivar)
2293	ENDIF
2294	ivar = ivar + 1
2295	ivar_all = ivar_all + 1
2296	l = MAX( 3, LEN_TRIM( do2d(av,ivar) ) )
2297	do2d_var(av,ivar)(1:l-3) = do2d(av,ivar)(1:l-3)
2298	ENDDO
2299
2300	ivar = 1
2301	!
2302	!-- Gather 3d output quantity names
2303	DO WHILE ( do3d(av,ivar)(1:1) /= ' ' )
2304	do_all(ivar_all) = do3d(av,ivar)
2305	ivar = ivar + 1
2306	ivar_all = ivar_all + 1
2307	ENDDO
2308
2309	ivar = 1
2310	!
2311	!-- Gather masked output quantity names. Also check for double output e.g. by different masks.
2312	DO mid = 1, masks
2313	DO WHILE ( domask(mid,av,ivar)(1:1) /= ' ' )
2314	IF ( .NOT. ANY( do_all == domask(mid,av,ivar) ) ) THEN
2315	do_all(ivar_all) = domask(mid,av,ivar)
2316	ENDIF
2317
2318	ivar = ivar + 1
2319	ivar_all = ivar_all + 1
2320	ENDDO
2321	ivar = 1
2322	ENDDO
2323
2324	ENDDO
2325
2326	prepared_diagnostic_output_quantities = .TRUE.
2327
2328	END SUBROUTINE doq_prepare
2329
2330	!--------------------------------------------------------------------------------------------------!
2331	! Description:
2332	! ------------
2333	!> Subroutine reads local (subdomain) restart data
2334	!--------------------------------------------------------------------------------------------------!
2335	SUBROUTINE doq_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, &
2336	nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found )
2337
2338	USE control_parameters
2339
2340	USE indices
2341
2342	USE kinds
2343
2344	USE pegrid
2345
2346
2347	IMPLICIT NONE
2348
2349	INTEGER(iwp) :: k !<
2350	INTEGER(iwp) :: nxlc !<
2351	INTEGER(iwp) :: nxlf !<
2352	INTEGER(iwp) :: nxl_on_file !<
2353	INTEGER(iwp) :: nxrc !<
2354	INTEGER(iwp) :: nxrf !<
2355	INTEGER(iwp) :: nxr_on_file !<
2356	INTEGER(iwp) :: nync !<
2357	INTEGER(iwp) :: nynf !<
2358	INTEGER(iwp) :: nyn_on_file !<
2359	INTEGER(iwp) :: nysc !<
2360	INTEGER(iwp) :: nysf !<
2361	INTEGER(iwp) :: nys_on_file !<
2362
2363	LOGICAL, INTENT(OUT) :: found
2364
2365	REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !<
2366
2367	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !<
2368
2369
2370	found = .TRUE.
2371
2372	SELECT CASE ( restart_string(1:length) )
2373
2374	CASE ( 'pt_2m_av' )
2375	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
2376	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
2377	ENDIF
2378	IF ( k == 1 ) READ ( 13 ) tmp_2d
2379	pt_2m_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2380	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2381
2382	CASE ( 'rh_av' )
2383	IF ( .NOT. ALLOCATED( rh_av ) ) THEN
2384	ALLOCATE( rh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2385	ENDIF
2386	IF ( k == 1 ) READ ( 13 ) tmp_3d
2387	rh_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2388	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2389
2390	CASE ( 'ta_av' )
2391	IF ( .NOT. ALLOCATED( ta_av ) ) THEN
2392	ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2393	ENDIF
2394	IF ( k == 1 ) READ ( 13 ) tmp_3d
2395	ta_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2396	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2397
2398	CASE ( 'ti_av' )
2399	IF ( .NOT. ALLOCATED( ti_av ) ) THEN
2400	ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2401	ENDIF
2402	IF ( k == 1 ) READ ( 13 ) tmp_3d
2403	ti_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2404	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2405
2406	CASE ( 'u_center_av' )
2407	IF ( .NOT. ALLOCATED( u_center_av ) ) THEN
2408	ALLOCATE( u_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2409	ENDIF
2410	IF ( k == 1 ) READ ( 13 ) tmp_3d
2411	u_center_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2412	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2413
2414	CASE ( 'uu_av' )
2415	IF ( .NOT. ALLOCATED( uu_av ) ) THEN
2416	ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2417	ENDIF
2418	IF ( k == 1 ) READ ( 13 ) tmp_3d
2419	uu_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2420	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2421
2422	CASE ( 'uv_10m_av' )
2423	IF ( .NOT. ALLOCATED( uv_10m_av ) ) THEN
2424	ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
2425	ENDIF
2426	IF ( k == 1 ) READ ( 13 ) tmp_2d
2427	uv_10m_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2428	tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2429
2430	CASE ( 'v_center_av' )
2431	IF ( .NOT. ALLOCATED( v_center_av ) ) THEN
2432	ALLOCATE( v_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2433	ENDIF
2434	IF ( k == 1 ) READ ( 13 ) tmp_3d
2435	v_center_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2436	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2437
2438	CASE ( 'vv_av' )
2439	IF ( .NOT. ALLOCATED( vv_av ) ) THEN
2440	ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2441	ENDIF
2442	IF ( k == 1 ) READ ( 13 ) tmp_3d
2443	vv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2444	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2445
2446	CASE ( 'wtheta_av' )
2447	IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN
2448	ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2449	ENDIF
2450	IF ( k == 1 ) READ ( 13 ) tmp_3d
2451	wtheta_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2452	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2453
2454	CASE ( 'wq_av' )
2455	IF ( .NOT. ALLOCATED( wq_av ) ) THEN
2456	ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2457	ENDIF
2458	IF ( k == 1 ) READ ( 13 ) tmp_3d
2459	wq_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2460	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2461
2462	CASE ( 'ws_av' )
2463	IF ( .NOT. ALLOCATED( ws_av ) ) THEN
2464	ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2465	ENDIF
2466	IF ( k == 1 ) READ ( 13 ) tmp_3d
2467	ws_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2468	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2469
2470	CASE ( 'wspeed_av' )
2471	IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN
2472	ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2473	ENDIF
2474	IF ( k == 1 ) READ ( 13 ) tmp_3d
2475	wspeed_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2476	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2477
2478	CASE ( 'wu_av' )
2479	IF ( .NOT. ALLOCATED( wu_av ) ) THEN
2480	ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2481	ENDIF
2482	IF ( k == 1 ) READ ( 13 ) tmp_3d
2483	wu_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2484	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2485
2486	CASE ( 'wv_av' )
2487	IF ( .NOT. ALLOCATED( wv_av ) ) THEN
2488	ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2489	ENDIF
2490	IF ( k == 1 ) READ ( 13 ) tmp_3d
2491	wv_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2492	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2493
2494	CASE ( 'ww_av' )
2495	IF ( .NOT. ALLOCATED( ww_av ) ) THEN
2496	ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2497	ENDIF
2498	IF ( k == 1 ) READ ( 13 ) tmp_3d
2499	ww_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
2500	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
2501
2502
2503	CASE DEFAULT
2504
2505	found = .FALSE.
2506
2507	END SELECT
2508
2509	END SUBROUTINE doq_rrd_local_ftn
2510
2511	!--------------------------------------------------------------------------------------------------!
2512	! Description:
2513	! ------------
2514	!> Read module-specific local restart data arrays (MPI-IO).
2515	!--------------------------------------------------------------------------------------------------!
2516	SUBROUTINE doq_rrd_local_mpi
2517
2518	LOGICAL :: array_found !< control flad indicating whether the array is found in the file or not
2519
2520
2521	CALL rd_mpi_io_check_array( 'pt_2m_av' , found = array_found )
2522	IF ( array_found ) THEN
2523	IF ( .NOT. ALLOCATED( pt_2m_av ) ) ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
2524	CALL rrd_mpi_io( 'pt_2m_av', pt_2m_av )
2525	ENDIF
2526
2527	CALL rd_mpi_io_check_array( 'ta_av' , found = array_found )
2528	IF ( array_found ) THEN
2529	IF ( .NOT. ALLOCATED( ta_av ) ) ALLOCATE( ta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2530	CALL rrd_mpi_io( 'ta_av', ta_av )
2531	ENDIF
2532
2533	CALL rd_mpi_io_check_array( 'ti_av' , found = array_found )
2534	IF ( array_found ) THEN
2535	IF ( .NOT. ALLOCATED( ti_av ) ) ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2536	CALL rrd_mpi_io( 'ti_av', ti_av )
2537	ENDIF
2538
2539	CALL rd_mpi_io_check_array( 'rh_av' , found = array_found )
2540	IF ( array_found ) THEN
2541	IF ( .NOT. ALLOCATED( rh_av ) ) ALLOCATE( ti_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2542	CALL rrd_mpi_io( 'rh_av', rh_av )
2543	ENDIF
2544
2545	CALL rd_mpi_io_check_array( 'u_center_av' , found = array_found )
2546	IF ( array_found ) THEN
2547	IF ( .NOT. ALLOCATED( u_center_av ) ) ALLOCATE( u_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2548	CALL rrd_mpi_io( 'u_center_av', u_center_av )
2549	ENDIF
2550
2551	CALL rd_mpi_io_check_array( 'uu_av' , found = array_found )
2552	IF ( array_found ) THEN
2553	IF ( .NOT. ALLOCATED( uu_av ) ) ALLOCATE( uu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2554	CALL rrd_mpi_io( 'uu_av', uu_av )
2555	ENDIF
2556
2557	CALL rd_mpi_io_check_array( 'uv_10m_av' , found = array_found )
2558	IF ( array_found ) THEN
2559	IF ( .NOT. ALLOCATED( uv_10m_av ) ) ALLOCATE( uv_10m_av(nysg:nyng,nxlg:nxrg) )
2560	CALL rrd_mpi_io( 'uv_10m_av', uv_10m_av )
2561	ENDIF
2562
2563	CALL rd_mpi_io_check_array( 'v_center_av' , found = array_found )
2564	IF ( array_found ) THEN
2565	IF ( .NOT. ALLOCATED( v_center_av ) ) ALLOCATE( v_center_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2566	CALL rrd_mpi_io( 'v_center_av', v_center_av )
2567	ENDIF
2568
2569	CALL rd_mpi_io_check_array( 'vv_av' , found = array_found )
2570	IF ( array_found ) THEN
2571	IF ( .NOT. ALLOCATED( vv_av ) ) ALLOCATE( vv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2572	CALL rrd_mpi_io( 'vv_av', vv_av )
2573	ENDIF
2574
2575	CALL rd_mpi_io_check_array( 'ww_av' , found = array_found )
2576	IF ( array_found ) THEN
2577	IF ( .NOT. ALLOCATED( ww_av ) ) ALLOCATE( ww_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2578	CALL rrd_mpi_io( 'ww_av', ww_av )
2579	ENDIF
2580
2581	CALL rd_mpi_io_check_array( 'wu_av' , found = array_found )
2582	IF ( array_found ) THEN
2583	IF ( .NOT. ALLOCATED( wu_av ) ) ALLOCATE( wu_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2584	CALL rrd_mpi_io( 'wu_av', wu_av )
2585	ENDIF
2586
2587	CALL rd_mpi_io_check_array( 'wv_av' , found = array_found )
2588	IF ( array_found ) THEN
2589	IF ( .NOT. ALLOCATED( wv_av ) ) ALLOCATE( wv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2590	CALL rrd_mpi_io( 'wv_av', wv_av )
2591	ENDIF
2592
2593	CALL rd_mpi_io_check_array( 'wtheta_av' , found = array_found )
2594	IF ( array_found ) THEN
2595	IF ( .NOT. ALLOCATED( wtheta_av ) ) ALLOCATE( wtheta_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2596	CALL rrd_mpi_io( 'wtheta_av', wtheta_av )
2597	ENDIF
2598
2599	CALL rd_mpi_io_check_array( 'wq_av' , found = array_found )
2600	IF ( array_found ) THEN
2601	IF ( .NOT. ALLOCATED( wq_av ) ) ALLOCATE( wq_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2602	CALL rrd_mpi_io( 'wq_av', wq_av )
2603	ENDIF
2604
2605	CALL rd_mpi_io_check_array( 'ws_av' , found = array_found )
2606	IF ( array_found ) THEN
2607	IF ( .NOT. ALLOCATED( ws_av ) ) ALLOCATE( ws_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2608	CALL rrd_mpi_io( 'ws_av', ws_av )
2609	ENDIF
2610
2611	CALL rd_mpi_io_check_array( 'wspeed_av' , found = array_found )
2612	IF ( array_found ) THEN
2613	IF ( .NOT. ALLOCATED( wspeed_av ) ) ALLOCATE( wspeed_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
2614	CALL rrd_mpi_io( 'wspeed_av', wspeed_av )
2615	ENDIF
2616
2617	END SUBROUTINE doq_rrd_local_mpi
2618
2619	!--------------------------------------------------------------------------------------------------!
2620	! Description:
2621	! ------------
2622	!> Subroutine writes local (subdomain) restart data
2623	!--------------------------------------------------------------------------------------------------!
2624	SUBROUTINE doq_wrd_local
2625
2626	IMPLICIT NONE
2627
2628
2629	IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN
2630
2631	IF ( ALLOCATED( pt_2m_av ) ) THEN
2632	CALL wrd_write_string( 'pt_2m_av' )
2633	WRITE ( 14 ) pt_2m_av
2634	ENDIF
2635
2636	IF ( ALLOCATED( rh_av ) ) THEN
2637	CALL wrd_write_string( 'rh_av' )
2638	WRITE ( 14 ) rh_av
2639	ENDIF
2640
2641	IF ( ALLOCATED( ta_av ) ) THEN
2642	CALL wrd_write_string( 'ta_av' )
2643	WRITE ( 14 ) ta_av
2644	ENDIF
2645
2646	IF ( ALLOCATED( ti_av ) ) THEN
2647	CALL wrd_write_string( 'ti_av' )
2648	WRITE ( 14 ) ti_av
2649	ENDIF
2650
2651	IF ( ALLOCATED( u_center_av ) ) THEN
2652	CALL wrd_write_string( 'u_center_av' )
2653	WRITE ( 14 ) u_center_av
2654	ENDIF
2655
2656	IF ( ALLOCATED( uu_av ) ) THEN
2657	CALL wrd_write_string( 'uu_av' )
2658	WRITE ( 14 ) uu_av
2659	ENDIF
2660
2661	IF ( ALLOCATED( uv_10m_av ) ) THEN
2662	CALL wrd_write_string( 'uv_10m_av' )
2663	WRITE ( 14 ) uv_10m_av
2664	ENDIF
2665
2666	IF ( ALLOCATED( v_center_av ) ) THEN
2667	CALL wrd_write_string( 'v_center_av' )
2668	WRITE ( 14 ) v_center_av
2669	ENDIF
2670
2671	IF ( ALLOCATED( vv_av ) ) THEN
2672	CALL wrd_write_string( 'vv_av' )
2673	WRITE ( 14 ) vv_av
2674	ENDIF
2675
2676	IF ( ALLOCATED( ww_av ) ) THEN
2677	CALL wrd_write_string( 'ww_av' )
2678	WRITE ( 14 ) ww_av
2679	ENDIF
2680
2681	IF ( ALLOCATED( wu_av ) ) THEN
2682	CALL wrd_write_string( 'wu_av' )
2683	WRITE ( 14 ) wu_av
2684	ENDIF
2685
2686	IF ( ALLOCATED( wv_av ) ) THEN
2687	CALL wrd_write_string( 'wv_av' )
2688	WRITE ( 14 ) wv_av
2689	ENDIF
2690
2691	IF ( ALLOCATED( wtheta_av ) ) THEN
2692	CALL wrd_write_string( 'wtheta_av' )
2693	WRITE ( 14 ) wtheta_av
2694	ENDIF
2695
2696	IF ( ALLOCATED( wq_av ) ) THEN
2697	CALL wrd_write_string( 'wq_av' )
2698	WRITE ( 14 ) wq_av
2699	ENDIF
2700
2701	IF ( ALLOCATED( ws_av ) ) THEN
2702	CALL wrd_write_string( 'ws_av' )
2703	WRITE ( 14 ) ws_av
2704	ENDIF
2705
2706	IF ( ALLOCATED( wspeed_av ) ) THEN
2707	CALL wrd_write_string( 'wspeed_av' )
2708	WRITE ( 14 ) wspeed_av
2709	ENDIF
2710
2711	ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN
2712
2713	IF ( ALLOCATED( pt_2m_av ) ) CALL wrd_mpi_io( 'pt_2m_av', pt_2m_av )
2714	IF ( ALLOCATED( rh_av ) ) CALL wrd_mpi_io( 'rh_av', rh_av )
2715	IF ( ALLOCATED( ta_av ) ) CALL wrd_mpi_io( 'ta_av', ta_av )
2716	IF ( ALLOCATED( ti_av ) ) CALL wrd_mpi_io( 'ti_av', ti_av )
2717	IF ( ALLOCATED( u_center_av ) ) CALL wrd_mpi_io( 'u_center_av', u_center_av )
2718	IF ( ALLOCATED( uu_av ) ) CALL wrd_mpi_io( 'uu_av', uu_av )
2719	IF ( ALLOCATED( uv_10m_av ) ) CALL wrd_mpi_io( 'uv_10m_av', uv_10m_av )
2720	IF ( ALLOCATED( vv_av ) ) CALL wrd_mpi_io( 'vv_av', vv_av )
2721	IF ( ALLOCATED( v_center_av ) ) CALL wrd_mpi_io( 'v_center_av', v_center_av )
2722	IF ( ALLOCATED( wtheta_av ) ) CALL wrd_mpi_io( 'wtheta_av', wtheta_av )
2723	IF ( ALLOCATED( wq_av ) ) CALL wrd_mpi_io( 'wq_av', wq_av )
2724	IF ( ALLOCATED( ws_av ) ) CALL wrd_mpi_io( 'ws_av', ws_av )
2725	IF ( ALLOCATED( wspeed_av ) ) CALL wrd_mpi_io( 'wspeed_av', wspeed_av )
2726	IF ( ALLOCATED( wu_av ) ) CALL wrd_mpi_io( 'wu_av', wu_av )
2727	IF ( ALLOCATED( wv_av ) ) CALL wrd_mpi_io( 'wv_av', wv_av )
2728	IF ( ALLOCATED( ww_av ) ) CALL wrd_mpi_io( 'ww_av', ww_av )
2729
2730	ENDIF
2731
2732	END SUBROUTINE doq_wrd_local
2733
2734
2735	END MODULE diagnostic_output_quantities_mod

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

Context Navigation

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

Download in other formats: