Home

Context Navigation

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

Last change on this file since 4313 was 4182, checked in by scharf, 5 years ago
corrected "Former revisions" section minor formatting in "Former revisions" section added "Author" section
Property svn:keywords set to `Id`
File size: 25.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |