Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |