Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |