Home

Context Navigation

source: palm/trunk/SOURCE/data_output_3d.f90 @ 4768

Last change on this file since 4768 was 4768, checked in by suehring, 3 years ago
Enable 3D data output also with 64-bit precision
Property svn:keywords set to `Id`
File size: 26.5 KB

Line
1	!> @file data_output_3d.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-2020 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! ------------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: data_output_3d.f90 4768 2020-11-02 19:11:23Z suehring $
26	! Enable 3D data output also with 64-bit precision
27	!
28	! 4559 2020-06-11 08:51:48Z raasch
29	! file re-formatted to follow the PALM coding standard
30	!
31	! 4457 2020-03-11 14:20:43Z raasch
32	! use statement for exchange horiz added
33	!
34	! 4444 2020-03-05 15:59:50Z raasch
35	! bugfix: cpp-directives for serial mode added
36	!
37	! 4360 2020-01-07 11:25:50Z suehring
38	! Introduction of wall_flags_total_0, which currently sets bits based on static topography
39	! information used in wall_flags_static_0
40	!
41	! 4329 2019-12-10 15:46:36Z motisi
42	! Renamed wall_flags_0 to wall_flags_static_0
43	!
44	! 4182 2019-08-22 15:20:23Z scharf
45	! Corrected "Former revisions" section
46	!
47	! 4162 2019-08-16 05:54:29Z raasch
48	! bugfix for r4155
49	!
50	! 4155 2019-08-14 06:25:18Z raasch
51	! bugfix for 3d-output in serial mode (ghost points must not be written)
52	!
53	! 4127 2019-07-30 14:47:10Z suehring
54	! Adjustment for top boundary index for plant-canopy model outputs (merge from branch resler)
55	!
56	! 4048 2019-06-21 21:00:21Z knoop
57	! Moved tcm_data_output_3d to module_interface
58	!
59	! 4039 2019-06-18 10:32:41Z suehring
60	! modularize diagnostic output
61	!
62	! 3994 2019-05-22 18:08:09Z suehring
63	! output of turbulence intensity added
64	!
65	! 3987 2019-05-22 09:52:13Z kanani
66	! Introduce alternative switch for debug output during timestepping
67	!
68	! 3885 2019-04-11 11:29:34Z kanani
69	! Changes related to global restructuring of location messages and introduction of additional debug
70	! messages
71	!
72	! 3814 2019-03-26 08:40:31Z pavelkrc
73	! unused variables removed
74	!
75	! 3655 2019-01-07 16:51:22Z knoop
76	! Bugfix: use time_since_reference_point instead of simulated_time (relevant when using wall/soil
77	! spinup)
78	!
79	! Revision 1.1 1997/09/03 06:29:36 raasch
80	! Initial revision
81	!
82	!
83	! Description:
84	! ------------
85	!> Output of the 3D-arrays in netCDF and/or AVS format.
86	!--------------------------------------------------------------------------------------------------!
87	SUBROUTINE data_output_3d( av )
88
89
90	USE arrays_3d, &
91	ONLY: d_exner, e, p, pt, q, ql, ql_c, ql_v, s, tend, u, v, vpt, w
92
93	USE averaging
94
95	USE basic_constants_and_equations_mod, &
96	ONLY: lv_d_cp
97
98	USE bulk_cloud_model_mod, &
99	ONLY: bulk_cloud_model
100
101	USE control_parameters, &
102	ONLY: debug_output_timestep, do3d, do3d_no, do3d_time_count, land_surface, message_string,&
103	ntdim_3d, nz_do3d, plant_canopy, psolver, time_since_reference_point, urban_surface,&
104	varnamelength
105
106	#if defined( __parallel )
107	USE control_parameters, &
108	ONLY: io_blocks, io_group
109	#endif
110
111	USE cpulog, &
112	ONLY: cpu_log, log_point
113
114	USE exchange_horiz_mod, &
115	ONLY: exchange_horiz
116
117	USE indices, &
118	ONLY: nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, wall_flags_total_0
119
120	#if ! defined( __parallel )
121	USE indices, &
122	ONLY: nx, ny
123	#endif
124
125	USE kinds
126
127	USE land_surface_model_mod, &
128	ONLY: lsm_data_output_3d, nzb_soil, nzt_soil
129
130	USE module_interface, &
131	ONLY: module_interface_data_output_3d
132
133	#if defined( __netcdf )
134	USE NETCDF
135	#endif
136
137	USE netcdf_interface, &
138	ONLY: fill_value, id_set_3d, id_var_do3d, id_var_time_3d, nc_stat, netcdf_data_format, &
139	netcdf_handle_error
140
141	USE particle_attributes, &
142	ONLY: grid_particles, number_of_particles, particles, particle_advection_start, prt_count
143
144	USE pegrid
145
146	USE plant_canopy_model_mod, &
147	ONLY: pch_index
148
149	USE radiation_model_mod, &
150	ONLY: nz_urban_b, nz_urban_t
151
152	USE urban_surface_mod, &
153	ONLY: usm_data_output_3d
154
155
156	IMPLICIT NONE
157
158	INTEGER(iwp) :: av !< flag for (non-)average output
159	INTEGER(iwp) :: flag_nr !< number of masking flag
160	INTEGER(iwp) :: i !< loop index
161	INTEGER(iwp) :: ivar !< variable index
162	INTEGER(iwp) :: j !< loop index
163	INTEGER(iwp) :: k !< loop index
164	INTEGER(iwp) :: n !< loop index
165	INTEGER(iwp) :: nzb_do !< vertical lower limit for data output
166	INTEGER(iwp) :: nzt_do !< vertical upper limit for data output
167
168	LOGICAL :: found !< true if output variable was found
169	LOGICAL :: resorted !< true if variable is resorted
170
171	REAL(wp) :: mean_r !< mean particle radius
172	REAL(wp) :: s_r2 !< sum( particle-radius**2 )
173	REAL(wp) :: s_r3 !< sum( particle-radius**3 )
174
175	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array
176
177	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer to array which shall be
178	!< output
179
180	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
181
182	!
183	!-- Return, if nothing to output
184	IF ( do3d_no(av) == 0 ) RETURN
185
186	IF ( debug_output_timestep ) CALL debug_message( 'data_output_3d', 'start' )
187
188	CALL cpu_log (log_point(14),'data_output_3d','start')
189
190	!
191	!-- Open output file.
192	!-- For classic or 64bit netCDF output on more than one PE, each PE opens its own file and writes
193	!-- the data of its subdomain in binary format. After the run, these files are combined to one
194	!-- NetCDF file by combine_plot_fields.
195	!-- For netCDF4/HDF5 output, data is written in parallel into one file.
196	IF ( netcdf_data_format < 5 ) THEN
197	#if defined( __parallel )
198	CALL check_open( 30 )
199	#endif
200	IF ( myid == 0 ) CALL check_open( 106+av*10 )
201	ELSE
202	CALL check_open( 106+av*10 )
203	ENDIF
204
205	!
206	!-- For parallel netcdf output the time axis must be limited. Return, if this limit is exceeded.
207	!-- This could be the case, if the simulated time exceeds the given end time by the length of the
208	!-- given output interval.
209	IF ( netcdf_data_format > 4 ) THEN
210	IF ( do3d_time_count(av) + 1 > ntdim_3d(av) ) THEN
211	WRITE ( message_string, * ) 'Output of 3d data is not given at t=', &
212	time_since_reference_point, 's because the maximum ', &
213	'number of output time levels is ', &
214	'exceeded.'
215	CALL message( 'data_output_3d', 'PA0387', 0, 1, 0, 6, 0 )
216	CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
217	RETURN
218	ENDIF
219	ENDIF
220
221	!
222	!-- Update the netCDF time axis.
223	!-- In case of parallel output, this is only done by PE0 to increase the performance.
224	#if defined( __netcdf )
225	do3d_time_count(av) = do3d_time_count(av) + 1
226	IF ( myid == 0 ) THEN
227	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
228	(/ time_since_reference_point /), &
229	start = (/ do3d_time_count(av) /), &
230	count = (/ 1 /) )
231	CALL netcdf_handle_error( 'data_output_3d', 376 )
232	ENDIF
233	#endif
234
235	!
236	!-- Loop over all variables to be written.
237	ivar = 1
238
239	DO WHILE ( do3d(av,ivar)(1:1) /= ' ' )
240
241	!
242	!-- Initiate found flag and resorting flag
243	found = .FALSE.
244	resorted = .FALSE.
245	trimvar = TRIM( do3d(av,ivar) )
246
247	!
248	!-- Temporary solution to account for data output within the new urban surface model
249	!-- (urban_surface_mod.f90), see also SELECT CASE ( trimvar ).
250	!-- Store the array chosen on the temporary array.
251	nzb_do = nzb
252	!
253	!-- Set top index for 3D output. Note in case of plant-canopy model these index is determined by
254	!-- pch_index.
255	IF ( plant_canopy .AND. trimvar(1:4) == 'pcm_' ) THEN
256	nzt_do = pch_index
257	ELSE
258	nzt_do = nz_do3d
259	ENDIF
260
261	!
262	!-- Allocate a temporary array with the desired output dimensions.
263	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
264	!
265	!-- Before each output, set array local_pf to fill value
266	local_pf = REAL( fill_value, KIND=wp )
267	!
268	!-- Set masking flag for topography for not resorted arrays
269	flag_nr = 0
270
271	SELECT CASE ( trimvar )
272
273	CASE ( 'e' )
274	IF ( av == 0 ) THEN
275	to_be_resorted => e
276	ELSE
277	IF ( .NOT. ALLOCATED( e_av ) ) THEN
278	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
279	e_av = REAL( fill_value, KIND = wp )
280	ENDIF
281	to_be_resorted => e_av
282	ENDIF
283
284	CASE ( 'thetal' )
285	IF ( av == 0 ) THEN
286	to_be_resorted => pt
287	ELSE
288	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
289	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
290	lpt_av = REAL( fill_value, KIND = wp )
291	ENDIF
292	to_be_resorted => lpt_av
293	ENDIF
294
295	CASE ( 'p' )
296	IF ( av == 0 ) THEN
297	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
298	to_be_resorted => p
299	ELSE
300	IF ( .NOT. ALLOCATED( p_av ) ) THEN
301	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
302	p_av = REAL( fill_value, KIND = wp )
303	ENDIF
304	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
305	to_be_resorted => p_av
306	ENDIF
307
308	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
309	IF ( av == 0 ) THEN
310	IF ( time_since_reference_point >= particle_advection_start ) THEN
311	tend = prt_count
312	ELSE
313	tend = 0.0_wp
314	ENDIF
315	DO i = nxl, nxr
316	DO j = nys, nyn
317	DO k = nzb_do, nzt_do
318	local_pf(i,j,k) = tend(k,j,i)
319	ENDDO
320	ENDDO
321	ENDDO
322	resorted = .TRUE.
323	ELSE
324	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
325	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
326	pc_av = REAL( fill_value, KIND = wp )
327	ENDIF
328	to_be_resorted => pc_av
329	ENDIF
330
331	CASE ( 'pr' ) ! mean particle radius (effective radius)
332	IF ( av == 0 ) THEN
333	IF ( time_since_reference_point >= particle_advection_start ) THEN
334	DO i = nxl, nxr
335	DO j = nys, nyn
336	DO k = nzb_do, nzt_do
337	number_of_particles = prt_count(k,j,i)
338	IF ( number_of_particles <= 0 ) CYCLE
339	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
340	s_r2 = 0.0_wp
341	s_r3 = 0.0_wp
342	DO n = 1, number_of_particles
343	IF ( particles(n)%particle_mask ) THEN
344	s_r2 = s_r2 + particles(n)%radius*2 particles(n)%weight_factor
345	s_r3 = s_r3 + particles(n)%radius*3 particles(n)%weight_factor
346	ENDIF
347	ENDDO
348	IF ( s_r2 > 0.0_wp ) THEN
349	mean_r = s_r3 / s_r2
350	ELSE
351	mean_r = 0.0_wp
352	ENDIF
353	tend(k,j,i) = mean_r
354	ENDDO
355	ENDDO
356	ENDDO
357	ELSE
358	tend = 0.0_wp
359	ENDIF
360	DO i = nxl, nxr
361	DO j = nys, nyn
362	DO k = nzb_do, nzt_do
363	local_pf(i,j,k) = tend(k,j,i)
364	ENDDO
365	ENDDO
366	ENDDO
367	resorted = .TRUE.
368	ELSE
369	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
370	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
371	pr_av = REAL( fill_value, KIND = wp )
372	ENDIF
373	to_be_resorted => pr_av
374	ENDIF
375
376	CASE ( 'theta' )
377	IF ( av == 0 ) THEN
378	IF ( .NOT. bulk_cloud_model ) THEN
379	to_be_resorted => pt
380	ELSE
381	DO i = nxl, nxr
382	DO j = nys, nyn
383	DO k = nzb_do, nzt_do
384	local_pf(i,j,k) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i)
385	ENDDO
386	ENDDO
387	ENDDO
388	resorted = .TRUE.
389	ENDIF
390	ELSE
391	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
392	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
393	pt_av = REAL( fill_value, KIND = wp )
394	ENDIF
395	to_be_resorted => pt_av
396	ENDIF
397
398	CASE ( 'q' )
399	IF ( av == 0 ) THEN
400	to_be_resorted => q
401	ELSE
402	IF ( .NOT. ALLOCATED( q_av ) ) THEN
403	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
404	q_av = REAL( fill_value, KIND = wp )
405	ENDIF
406	to_be_resorted => q_av
407	ENDIF
408
409	CASE ( 'ql' )
410	IF ( av == 0 ) THEN
411	to_be_resorted => ql
412	ELSE
413	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
414	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
415	ql_av = REAL( fill_value, KIND = wp )
416	ENDIF
417	to_be_resorted => ql_av
418	ENDIF
419
420	CASE ( 'ql_c' )
421	IF ( av == 0 ) THEN
422	to_be_resorted => ql_c
423	ELSE
424	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
425	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
426	ql_c_av = REAL( fill_value, KIND = wp )
427	ENDIF
428	to_be_resorted => ql_c_av
429	ENDIF
430
431	CASE ( 'ql_v' )
432	IF ( av == 0 ) THEN
433	to_be_resorted => ql_v
434	ELSE
435	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
436	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
437	ql_v_av = REAL( fill_value, KIND = wp )
438	ENDIF
439	to_be_resorted => ql_v_av
440	ENDIF
441
442	CASE ( 'ql_vp' )
443	IF ( av == 0 ) THEN
444	IF ( time_since_reference_point >= particle_advection_start ) THEN
445	DO i = nxl, nxr
446	DO j = nys, nyn
447	DO k = nzb_do, nzt_do
448	number_of_particles = prt_count(k,j,i)
449	IF (number_of_particles <= 0) CYCLE
450	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
451	DO n = 1, number_of_particles
452	IF ( particles(n)%particle_mask ) THEN
453	tend(k,j,i) = tend(k,j,i) + &
454	particles(n)%weight_factor / prt_count(k,j,i)
455	ENDIF
456	ENDDO
457	ENDDO
458	ENDDO
459	ENDDO
460	ELSE
461	tend = 0.0_wp
462	ENDIF
463	DO i = nxl, nxr
464	DO j = nys, nyn
465	DO k = nzb_do, nzt_do
466	local_pf(i,j,k) = tend(k,j,i)
467	ENDDO
468	ENDDO
469	ENDDO
470	resorted = .TRUE.
471	ELSE
472	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
473	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
474	ql_vp_av = REAL( fill_value, KIND = wp )
475	ENDIF
476	to_be_resorted => ql_vp_av
477	ENDIF
478
479	CASE ( 'qv' )
480	IF ( av == 0 ) THEN
481	DO i = nxl, nxr
482	DO j = nys, nyn
483	DO k = nzb_do, nzt_do
484	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
485	ENDDO
486	ENDDO
487	ENDDO
488	resorted = .TRUE.
489	ELSE
490	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
491	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
492	qv_av = REAL( fill_value, KIND = wp )
493	ENDIF
494	to_be_resorted => qv_av
495	ENDIF
496
497	CASE ( 's' )
498	IF ( av == 0 ) THEN
499	to_be_resorted => s
500	ELSE
501	IF ( .NOT. ALLOCATED( s_av ) ) THEN
502	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
503	s_av = REAL( fill_value, KIND = wp )
504	ENDIF
505	to_be_resorted => s_av
506	ENDIF
507
508	CASE ( 'u' )
509	flag_nr = 1
510	IF ( av == 0 ) THEN
511	to_be_resorted => u
512	ELSE
513	IF ( .NOT. ALLOCATED( u_av ) ) THEN
514	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
515	u_av = REAL( fill_value, KIND = wp )
516	ENDIF
517	to_be_resorted => u_av
518	ENDIF
519
520	CASE ( 'v' )
521	flag_nr = 2
522	IF ( av == 0 ) THEN
523	to_be_resorted => v
524	ELSE
525	IF ( .NOT. ALLOCATED( v_av ) ) THEN
526	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
527	v_av = REAL( fill_value, KIND = wp )
528	ENDIF
529	to_be_resorted => v_av
530	ENDIF
531
532	CASE ( 'thetav' )
533	IF ( av == 0 ) THEN
534	to_be_resorted => vpt
535	ELSE
536	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
537	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
538	vpt_av = REAL( fill_value, KIND = wp )
539	ENDIF
540	to_be_resorted => vpt_av
541	ENDIF
542
543	CASE ( 'w' )
544	flag_nr = 3
545	IF ( av == 0 ) THEN
546	to_be_resorted => w
547	ELSE
548	IF ( .NOT. ALLOCATED( w_av ) ) THEN
549	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
550	w_av = REAL( fill_value, KIND = wp )
551	ENDIF
552	to_be_resorted => w_av
553	ENDIF
554
555	CASE DEFAULT
556	!
557	!-- Quantities of other modules
558	IF ( .NOT. found ) THEN
559	CALL module_interface_data_output_3d( av, trimvar, found, local_pf, fill_value, &
560	resorted, nzb_do, nzt_do &
561	)
562	ENDIF
563
564	!
565	!-- Temporary workaround: ToDo: refactor local_pf allocation
566	IF ( .NOT. found .AND. urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN
567	!
568	!-- For urban model quantities, it is required to re-allocate local_pf
569	nzb_do = nz_urban_b
570	nzt_do = nz_urban_t
571
572	DEALLOCATE ( local_pf )
573	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
574	local_pf = fill_value
575
576	CALL usm_data_output_3d( av, trimvar, found, local_pf, nzb_do, nzt_do )
577	resorted = .TRUE.
578
579	!
580	!-- If no soil model variable was found, re-allocate local_pf
581	IF ( .NOT. found ) THEN
582	nzb_do = nzb
583	nzt_do = nz_do3d
584
585	DEALLOCATE ( local_pf )
586	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
587	ENDIF
588
589	ENDIF
590
591	!
592	!-- Temporary workaround: ToDo: refactor local_pf allocation
593	IF ( .NOT. found .AND. land_surface ) THEN
594	!
595	!-- For soil model quantities, it is required to re-allocate local_pf
596	nzb_do = nzb_soil
597	nzt_do = nzt_soil
598
599	DEALLOCATE ( local_pf )
600	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
601	local_pf = fill_value
602
603	CALL lsm_data_output_3d( av, trimvar, found, local_pf )
604	resorted = .TRUE.
605
606	!
607	!-- If no soil model variable was found, re-allocate local_pf
608	IF ( .NOT. found ) THEN
609	nzb_do = nzb
610	nzt_do = nz_do3d
611
612	DEALLOCATE ( local_pf )
613	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
614	ENDIF
615
616	ENDIF
617
618	IF ( .NOT. found ) THEN
619	message_string = 'no output available for: ' // TRIM( do3d(av,ivar) )
620	CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
621	ENDIF
622
623	END SELECT
624
625	!
626	!-- Resort the array to be output, if not done above
627	IF ( .NOT. resorted ) THEN
628	DO i = nxl, nxr
629	DO j = nys, nyn
630	DO k = nzb_do, nzt_do
631	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
632	REAL( fill_value, KIND = wp ), &
633	BTEST( wall_flags_total_0(k,j,i), flag_nr ) )
634	ENDDO
635	ENDDO
636	ENDDO
637	ENDIF
638
639	!
640	!-- Output of the 3D-array
641	#if defined( __parallel )
642	IF ( netcdf_data_format < 5 ) THEN
643	!
644	!-- Non-parallel netCDF output. Data is output in parallel in FORTRAN binary format here, and
645	!-- later collected into one file by combine_plot_fields
646	IF ( myid == 0 ) THEN
647	WRITE ( 30 ) time_since_reference_point, do3d_time_count(av), av
648	ENDIF
649	DO i = 0, io_blocks-1
650	IF ( i == io_group ) THEN
651	WRITE ( 30 ) nxl, nxr, nys, nyn, nzb_do, nzt_do
652	WRITE ( 30 ) local_pf(:,:,nzb_do:nzt_do)
653	ENDIF
654
655	CALL MPI_BARRIER( comm2d, ierr )
656
657	ENDDO
658
659	ELSE
660	#if defined( __netcdf )
661	!
662	!-- Parallel output in netCDF4/HDF5 format.
663	! IF ( nxr == nx .AND. nyn /= ny ) THEN
664	! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), &
665	! local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do), &
666	! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
667	! count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
668	! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
669	! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), &
670	! local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do), &
671	! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
672	! count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
673	! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
674	! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), &
675	! local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do ), &
676	! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
677	! count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
678	! ELSE
679	!
680	!-- Call for parallel runs
681	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), &
682	local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do), &
683	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
684	count = (/ nxr-nxl+1, nyn-nys+1, nzt_do-nzb_do+1, 1 /) &
685	)
686	! ENDIF
687	CALL netcdf_handle_error( 'data_output_3d', 386 )
688	#endif
689	ENDIF
690	#else
691	#if defined( __netcdf )
692	!
693	!-- Call for non-parallel runs
694	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), &
695	local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do), &
696	start = (/ 1, 1, 1, do3d_time_count(av) /), &
697	count = (/ nx+1, ny+1, nzt_do-nzb_do+1, 1 /) )
698	CALL netcdf_handle_error( 'data_output_3d', 446 )
699	#endif
700	#endif
701
702	ivar = ivar + 1
703
704	!
705	!-- Deallocate temporary array
706	DEALLOCATE ( local_pf )
707
708	ENDDO
709
710	CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
711
712	IF ( debug_output_timestep ) CALL debug_message( 'data_output_3d', 'end' )
713
714
715	END SUBROUTINE data_output_3d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |