Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |