Home

Context Navigation

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

Last change on this file since 1745 was 1745, checked in by gronemeier, 9 years ago
Bugfix:calculation of time levels for parallel NetCDF output
Property svn:keywords set to `Id`
File size: 24.2 KB

Rev	Line
[1682]	1	!> @file data_output_3d.f90
[1036]	2	!--------------------------------------------------------------------------------!
	3	! This file is part of PALM.
	4	!
	5	! PALM is free software: you can redistribute it and/or modify it under the terms
	6	! of the GNU General Public License as published by the Free Software Foundation,
	7	! either version 3 of the License, or (at your option) any later version.
	8	!
	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	10	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	11	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	12	!
	13	! You should have received a copy of the GNU General Public License along with
	14	! PALM. If not, see <http://www.gnu.org/licenses/>.
	15	!
[1691]	16	! Copyright 1997-2015 Leibniz Universitaet Hannover
[1036]	17	!--------------------------------------------------------------------------------!
	18	!
[254]	19	! Current revisions:
[1106]	20	! ------------------
[1745]	21	! Bugfix: test if time axis limit exceeds moved to point after call of check_open
[1552]	22	!
	23	! Former revisions:
	24	! -----------------
	25	! $Id: data_output_3d.f90 1745 2016-02-05 13:06:51Z gronemeier $
	26	!
[1692]	27	! 1691 2015-10-26 16:17:44Z maronga
	28	! Added output of radiative heating rates for RRTMG
	29	!
[1683]	30	! 1682 2015-10-07 23:56:08Z knoop
	31	! Code annotations made doxygen readable
	32	!
[1586]	33	! 1585 2015-04-30 07:05:52Z maronga
	34	! Added support for RRTMG
	35	!
[1552]	36	! 1551 2015-03-03 14:18:16Z maronga
[1551]	37	! Added suppport for land surface model and radiation model output. In the course
	38	! of this action, the limits for vertical loops have been changed (from nzb and
	39	! nzt+1 to nzb_do and nzt_do, respectively in order to allow soil model output).
	40	! Moreover, a new vertical grid zs was introduced.
[1329]	41	!
[1360]	42	! 1359 2014-04-11 17:15:14Z hoffmann
	43	! New particle structure integrated.
	44	!
[1354]	45	! 1353 2014-04-08 15:21:23Z heinze
	46	! REAL constants provided with KIND-attribute
	47	!
[1329]	48	! 1327 2014-03-21 11:00:16Z raasch
	49	! parts concerning avs output removed,
	50	! -netcdf output queries
	51	!
[1321]	52	! 1320 2014-03-20 08:40:49Z raasch
[1320]	53	! ONLY-attribute added to USE-statements,
	54	! kind-parameters added to all INTEGER and REAL declaration statements,
	55	! kinds are defined in new module kinds,
	56	! old module precision_kind is removed,
	57	! revision history before 2012 removed,
	58	! comment fields (!:) to be used for variable explanations added to
	59	! all variable declaration statements
[674]	60	!
[1319]	61	! 1318 2014-03-17 13:35:16Z raasch
	62	! barrier argument removed from cpu_log,
	63	! module interfaces removed
	64	!
[1309]	65	! 1308 2014-03-13 14:58:42Z fricke
	66	! Check, if the limit of the time dimension is exceeded for parallel output
	67	! To increase the performance for parallel output, the following is done:
	68	! - Update of time axis is only done by PE0
	69	!
[1245]	70	! 1244 2013-10-31 08:16:56Z raasch
	71	! Bugfix for index bounds in case of 3d-parallel output
	72	!
[1116]	73	! 1115 2013-03-26 18:16:16Z hoffmann
	74	! ql is calculated by calc_liquid_water_content
	75	!
[1107]	76	! 1106 2013-03-04 05:31:38Z raasch
	77	! array_kind renamed precision_kind
	78	!
[1077]	79	! 1076 2012-12-05 08:30:18Z hoffmann
	80	! Bugfix in output of ql
	81	!
[1054]	82	! 1053 2012-11-13 17:11:03Z hoffmann
	83	! +nr, qr, prr, qc and averaged quantities
	84	!
[1037]	85	! 1036 2012-10-22 13:43:42Z raasch
	86	! code put under GPL (PALM 3.9)
	87	!
[1035]	88	! 1031 2012-10-19 14:35:30Z raasch
	89	! netCDF4 without parallel file support implemented
	90	!
[1008]	91	! 1007 2012-09-19 14:30:36Z franke
	92	! Bugfix: missing calculation of ql_vp added
	93	!
[1]	94	! Revision 1.1 1997/09/03 06:29:36 raasch
	95	! Initial revision
	96	!
	97	!
	98	! Description:
	99	! ------------
[1682]	100	!> Output of the 3D-arrays in netCDF and/or AVS format.
[1]	101	!------------------------------------------------------------------------------!
[1682]	102	SUBROUTINE data_output_3d( av )
	103
[1]	104
[1320]	105	USE arrays_3d, &
	106	ONLY: e, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho, sa, tend, u, v, &
	107	vpt, w
	108
[1]	109	USE averaging
[1320]	110
	111	USE cloud_parameters, &
	112	ONLY: l_d_cp, prr, pt_d_t
	113
	114	USE control_parameters, &
[1327]	115	ONLY: avs_data_file, cloud_physics, do3d, do3d_avs_n, &
	116	do3d_no, do3d_time_count, io_blocks, io_group, &
	117	message_string, netcdf_data_format, ntdim_3d, &
[1320]	118	nz_do3d, plot_3d_precision, psolver, simulated_time, &
	119	simulated_time_chr, skip_do_avs, time_since_reference_point
	120
	121	USE cpulog, &
	122	ONLY: log_point, cpu_log
	123
	124	USE indices, &
	125	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzt, &
	126	nzb
	127
	128	USE kinds
	129
[1551]	130	USE land_surface_model_mod, &
	131	ONLY: m_soil, m_soil_av, nzb_soil, nzt_soil, t_soil, t_soil_av
	132
[1]	133	USE netcdf_control
[1320]	134
	135	USE particle_attributes, &
[1359]	136	ONLY: grid_particles, number_of_particles, particles, &
	137	particle_advection_start, prt_count
[1320]	138
[1]	139	USE pegrid
	140
[1585]	141	USE radiation_model_mod, &
	142	ONLY: rad_lw_in, rad_lw_in_av, rad_lw_out, rad_lw_out_av, &
[1691]	143	rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr, rad_lw_hr_av, &
	144	rad_sw_in, rad_sw_in_av, rad_sw_out, rad_sw_out_av, &
	145	rad_sw_cs_hr, rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av
[1585]	146
	147
[1]	148	IMPLICIT NONE
	149
[1682]	150	CHARACTER (LEN=9) :: simulated_time_mod !<
[1]	151
[1682]	152	INTEGER(iwp) :: av !<
	153	INTEGER(iwp) :: i !<
	154	INTEGER(iwp) :: if !<
	155	INTEGER(iwp) :: j !<
	156	INTEGER(iwp) :: k !<
	157	INTEGER(iwp) :: n !<
	158	INTEGER(iwp) :: nzb_do !< vertical lower limit for data output
	159	INTEGER(iwp) :: nzt_do !< vertical upper limit for data output
	160	INTEGER(iwp) :: pos !<
	161	INTEGER(iwp) :: prec !<
	162	INTEGER(iwp) :: psi !<
[1]	163
[1682]	164	LOGICAL :: found !<
	165	LOGICAL :: resorted !<
[1]	166
[1682]	167	REAL(wp) :: mean_r !<
	168	REAL(wp) :: s_r2 !<
	169	REAL(wp) :: s_r3 !<
[1]	170
[1682]	171	REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !<
[1]	172
[1682]	173	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !<
[1]	174
	175	!
	176	!-- Return, if nothing to output
	177	IF ( do3d_no(av) == 0 ) RETURN
	178
	179	CALL cpu_log (log_point(14),'data_output_3d','start')
	180
	181	!
	182	!-- Open output file.
	183	!-- Also creates coordinate and fld-file for AVS.
[1031]	184	!-- For classic or 64bit netCDF output or output of other (old) data formats,
[493]	185	!-- for a run on more than one PE, each PE opens its own file and
[1]	186	!-- writes the data of its subdomain in binary format (regardless of the format
	187	!-- the user has requested). After the run, these files are combined to one
	188	!-- file by combine_plot_fields in the format requested by the user (netcdf
[493]	189	!-- and/or avs).
[1031]	190	!-- For netCDF4/HDF5 output, data is written in parallel into one file.
[1327]	191	IF ( netcdf_data_format < 5 ) THEN
	192	CALL check_open( 30 )
	193	IF ( myid == 0 ) CALL check_open( 106+av*10 )
[493]	194	ELSE
[1327]	195	CALL check_open( 106+av*10 )
[493]	196	ENDIF
[1]	197
	198	!
[1745]	199	!-- For parallel netcdf output the time axis must be limited. Return, if this
	200	!-- limit is exceeded. This could be the case, if the simulated time exceeds
	201	!-- the given end time by the length of the given output interval.
	202	IF ( netcdf_data_format > 4 ) THEN
	203	IF ( do3d_time_count(av) + 1 > ntdim_3d(av) ) THEN
	204	WRITE ( message_string, * ) 'Output of 3d data is not given at t=', &
	205	simulated_time, '&because the maximum ', &
	206	'number of output time levels is ', &
	207	'exceeded.'
	208	CALL message( 'data_output_3d', 'PA0387', 0, 1, 0, 6, 0 )
	209	CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
	210	RETURN
	211	ENDIF
	212	ENDIF
	213	WRITE(9,*) '___hier4'
	214	CALL local_flush(9)
	215
	216	!
[1031]	217	!-- Update the netCDF time axis
[1308]	218	!-- In case of parallel output, this is only done by PE0 to increase the
	219	!-- performance.
[1]	220	#if defined( __netcdf )
[1308]	221	do3d_time_count(av) = do3d_time_count(av) + 1
	222	IF ( myid == 0 ) THEN
[1327]	223	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
	224	(/ time_since_reference_point /), &
	225	start = (/ do3d_time_count(av) /), &
	226	count = (/ 1 /) )
	227	CALL handle_netcdf_error( 'data_output_3d', 376 )
[1]	228	ENDIF
	229	#endif
	230
	231	!
	232	!-- Loop over all variables to be written.
	233	if = 1
	234
	235	DO WHILE ( do3d(av,if)(1:1) /= ' ' )
	236	!
	237	!-- Store the array chosen on the temporary array.
	238	resorted = .FALSE.
[1551]	239	nzb_do = nzb
	240	nzt_do = nz_do3d
	241
	242	!
	243	!-- Allocate a temporary array with the desired output dimensions.
	244	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
	245
[1]	246	SELECT CASE ( TRIM( do3d(av,if) ) )
	247
	248	CASE ( 'e' )
	249	IF ( av == 0 ) THEN
	250	to_be_resorted => e
	251	ELSE
	252	to_be_resorted => e_av
	253	ENDIF
	254
[771]	255	CASE ( 'lpt' )
	256	IF ( av == 0 ) THEN
	257	to_be_resorted => pt
	258	ELSE
	259	to_be_resorted => lpt_av
	260	ENDIF
	261
[1551]	262	CASE ( 'm_soil' )
	263	nzb_do = nzb_soil
	264	nzt_do = nzt_soil
	265	!
	266	!-- For soil model quantities, it is required to re-allocate local_pf
	267	DEALLOCATE ( local_pf )
	268	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
	269
	270	IF ( av == 0 ) THEN
	271	to_be_resorted => m_soil
	272	ELSE
	273	to_be_resorted => m_soil_av
	274	ENDIF
	275
[1053]	276	CASE ( 'nr' )
	277	IF ( av == 0 ) THEN
	278	to_be_resorted => nr
	279	ELSE
	280	to_be_resorted => nr_av
	281	ENDIF
	282
[1]	283	CASE ( 'p' )
	284	IF ( av == 0 ) THEN
[727]	285	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
[1]	286	to_be_resorted => p
	287	ELSE
[727]	288	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
[1]	289	to_be_resorted => p_av
	290	ENDIF
	291
	292	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
	293	IF ( av == 0 ) THEN
[1359]	294	IF ( simulated_time >= particle_advection_start ) THEN
	295	tend = prt_count
	296	CALL exchange_horiz( tend, nbgp )
	297	ELSE
	298	tend = 0.0_wp
	299	ENDIF
[667]	300	DO i = nxlg, nxrg
	301	DO j = nysg, nyng
[1551]	302	DO k = nzb_do, nzt_do
[1]	303	local_pf(i,j,k) = tend(k,j,i)
	304	ENDDO
	305	ENDDO
	306	ENDDO
	307	resorted = .TRUE.
	308	ELSE
[667]	309	CALL exchange_horiz( pc_av, nbgp )
[1]	310	to_be_resorted => pc_av
	311	ENDIF
	312
[1359]	313	CASE ( 'pr' ) ! mean particle radius (effective radius)
[1]	314	IF ( av == 0 ) THEN
[1359]	315	IF ( simulated_time >= particle_advection_start ) THEN
	316	DO i = nxl, nxr
	317	DO j = nys, nyn
[1551]	318	DO k = nzb_do, nzt_do
[1359]	319	number_of_particles = prt_count(k,j,i)
	320	IF (number_of_particles <= 0) CYCLE
	321	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	322	s_r2 = 0.0_wp
	323	s_r3 = 0.0_wp
	324	DO n = 1, number_of_particles
	325	IF ( particles(n)%particle_mask ) THEN
	326	s_r2 = s_r2 + particles(n)%radius*2 &
	327	particles(n)%weight_factor
	328	s_r3 = s_r3 + particles(n)%radius*3 &
	329	particles(n)%weight_factor
	330	ENDIF
	331	ENDDO
	332	IF ( s_r2 > 0.0_wp ) THEN
	333	mean_r = s_r3 / s_r2
	334	ELSE
	335	mean_r = 0.0_wp
	336	ENDIF
	337	tend(k,j,i) = mean_r
[1]	338	ENDDO
	339	ENDDO
	340	ENDDO
[1359]	341	CALL exchange_horiz( tend, nbgp )
	342	ELSE
	343	tend = 0.0_wp
	344	ENDIF
[667]	345	DO i = nxlg, nxrg
	346	DO j = nysg, nyng
[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
[667]	354	CALL exchange_horiz( pr_av, nbgp )
[1]	355	to_be_resorted => pr_av
	356	ENDIF
	357
[1053]	358	CASE ( 'prr' )
	359	IF ( av == 0 ) THEN
	360	CALL exchange_horiz( prr, nbgp )
	361	DO i = nxlg, nxrg
	362	DO j = nysg, nyng
	363	DO k = nzb, nzt+1
	364	local_pf(i,j,k) = prr(k,j,i)
	365	ENDDO
	366	ENDDO
	367	ENDDO
	368	ELSE
	369	CALL exchange_horiz( prr_av, nbgp )
	370	DO i = nxlg, nxrg
	371	DO j = nysg, nyng
	372	DO k = nzb, nzt+1
	373	local_pf(i,j,k) = prr_av(k,j,i)
	374	ENDDO
	375	ENDDO
	376	ENDDO
	377	ENDIF
	378	resorted = .TRUE.
	379
[1]	380	CASE ( 'pt' )
	381	IF ( av == 0 ) THEN
	382	IF ( .NOT. cloud_physics ) THEN
	383	to_be_resorted => pt
	384	ELSE
[667]	385	DO i = nxlg, nxrg
	386	DO j = nysg, nyng
[1551]	387	DO k = nzb_do, nzt_do
[1320]	388	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
	389	pt_d_t(k) * &
[1]	390	ql(k,j,i)
	391	ENDDO
	392	ENDDO
	393	ENDDO
	394	resorted = .TRUE.
	395	ENDIF
	396	ELSE
	397	to_be_resorted => pt_av
	398	ENDIF
	399
	400	CASE ( 'q' )
	401	IF ( av == 0 ) THEN
	402	to_be_resorted => q
	403	ELSE
	404	to_be_resorted => q_av
	405	ENDIF
[691]	406
[1053]	407	CASE ( 'qc' )
[1]	408	IF ( av == 0 ) THEN
[1115]	409	to_be_resorted => qc
[1]	410	ELSE
[1115]	411	to_be_resorted => qc_av
[1]	412	ENDIF
	413
[1053]	414	CASE ( 'ql' )
	415	IF ( av == 0 ) THEN
[1115]	416	to_be_resorted => ql
[1053]	417	ELSE
[1115]	418	to_be_resorted => ql_av
[1053]	419	ENDIF
	420
[1]	421	CASE ( 'ql_c' )
	422	IF ( av == 0 ) THEN
	423	to_be_resorted => ql_c
	424	ELSE
	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	to_be_resorted => ql_v_av
	433	ENDIF
	434
	435	CASE ( 'ql_vp' )
	436	IF ( av == 0 ) THEN
[1359]	437	IF ( simulated_time >= particle_advection_start ) THEN
	438	DO i = nxl, nxr
	439	DO j = nys, nyn
[1551]	440	DO k = nzb_do, nzt_do
[1359]	441	number_of_particles = prt_count(k,j,i)
	442	IF (number_of_particles <= 0) CYCLE
	443	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	444	DO n = 1, number_of_particles
	445	IF ( particles(n)%particle_mask ) THEN
	446	tend(k,j,i) = tend(k,j,i) + &
	447	particles(n)%weight_factor / &
	448	prt_count(k,j,i)
	449	ENDIF
	450	ENDDO
[1007]	451	ENDDO
	452	ENDDO
	453	ENDDO
[1359]	454	CALL exchange_horiz( tend, nbgp )
	455	ELSE
	456	tend = 0.0_wp
	457	ENDIF
[1007]	458	DO i = nxlg, nxrg
	459	DO j = nysg, nyng
[1551]	460	DO k = nzb_do, nzt_do
[1007]	461	local_pf(i,j,k) = tend(k,j,i)
	462	ENDDO
	463	ENDDO
	464	ENDDO
	465	resorted = .TRUE.
[1]	466	ELSE
[1007]	467	CALL exchange_horiz( ql_vp_av, nbgp )
[1]	468	to_be_resorted => ql_vp_av
	469	ENDIF
	470
[1053]	471	CASE ( 'qr' )
	472	IF ( av == 0 ) THEN
	473	to_be_resorted => qr
	474	ELSE
	475	to_be_resorted => qr_av
	476	ENDIF
	477
[1]	478	CASE ( 'qv' )
	479	IF ( av == 0 ) THEN
[667]	480	DO i = nxlg, nxrg
	481	DO j = nysg, nyng
[1551]	482	DO k = nzb_do, nzt_do
[1]	483	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
	484	ENDDO
	485	ENDDO
	486	ENDDO
	487	resorted = .TRUE.
	488	ELSE
	489	to_be_resorted => qv_av
	490	ENDIF
	491
[1585]	492	CASE ( 'rad_sw_in' )
	493	IF ( av == 0 ) THEN
	494	to_be_resorted => rad_sw_in
	495	ELSE
	496	to_be_resorted => rad_sw_in_av
	497	ENDIF
	498
	499	CASE ( 'rad_sw_out' )
	500	IF ( av == 0 ) THEN
	501	to_be_resorted => rad_sw_out
	502	ELSE
	503	to_be_resorted => rad_sw_out_av
	504	ENDIF
	505
[1691]	506	CASE ( 'rad_sw_cs_hr' )
	507	IF ( av == 0 ) THEN
	508	to_be_resorted => rad_sw_cs_hr
	509	ELSE
	510	to_be_resorted => rad_sw_cs_hr_av
	511	ENDIF
	512
	513	CASE ( 'rad_sw_hr' )
	514	IF ( av == 0 ) THEN
	515	to_be_resorted => rad_sw_hr
	516	ELSE
	517	to_be_resorted => rad_sw_hr_av
	518	ENDIF
	519
[1585]	520	CASE ( 'rad_lw_in' )
	521	IF ( av == 0 ) THEN
	522	to_be_resorted => rad_lw_in
	523	ELSE
	524	to_be_resorted => rad_lw_in_av
	525	ENDIF
	526
	527	CASE ( 'rad_lw_out' )
	528	IF ( av == 0 ) THEN
	529	to_be_resorted => rad_lw_out
	530	ELSE
	531	to_be_resorted => rad_lw_out_av
	532	ENDIF
	533
[1691]	534	CASE ( 'rad_lw_cs_hr' )
	535	IF ( av == 0 ) THEN
	536	to_be_resorted => rad_lw_cs_hr
	537	ELSE
	538	to_be_resorted => rad_lw_cs_hr_av
	539	ENDIF
	540
	541	CASE ( 'rad_lw_hr' )
	542	IF ( av == 0 ) THEN
	543	to_be_resorted => rad_lw_hr
	544	ELSE
	545	to_be_resorted => rad_lw_hr_av
	546	ENDIF
	547
[96]	548	CASE ( 'rho' )
	549	IF ( av == 0 ) THEN
	550	to_be_resorted => rho
	551	ELSE
	552	to_be_resorted => rho_av
	553	ENDIF
[691]	554
[1]	555	CASE ( 's' )
	556	IF ( av == 0 ) THEN
	557	to_be_resorted => q
	558	ELSE
[355]	559	to_be_resorted => s_av
[1]	560	ENDIF
[691]	561
[96]	562	CASE ( 'sa' )
	563	IF ( av == 0 ) THEN
	564	to_be_resorted => sa
	565	ELSE
	566	to_be_resorted => sa_av
	567	ENDIF
[691]	568
[1551]	569	CASE ( 't_soil' )
	570	nzb_do = nzb_soil
	571	nzt_do = nzt_soil
	572	!
	573	!-- For soil model quantities, it is required to re-allocate local_pf
	574	DEALLOCATE ( local_pf )
	575	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
	576
	577	IF ( av == 0 ) THEN
	578	to_be_resorted => t_soil
	579	ELSE
	580	to_be_resorted => t_soil_av
	581	ENDIF
	582
[1]	583	CASE ( 'u' )
	584	IF ( av == 0 ) THEN
	585	to_be_resorted => u
	586	ELSE
	587	to_be_resorted => u_av
	588	ENDIF
	589
	590	CASE ( 'v' )
	591	IF ( av == 0 ) THEN
	592	to_be_resorted => v
	593	ELSE
	594	to_be_resorted => v_av
	595	ENDIF
	596
	597	CASE ( 'vpt' )
	598	IF ( av == 0 ) THEN
	599	to_be_resorted => vpt
	600	ELSE
	601	to_be_resorted => vpt_av
	602	ENDIF
	603
	604	CASE ( 'w' )
	605	IF ( av == 0 ) THEN
	606	to_be_resorted => w
	607	ELSE
	608	to_be_resorted => w_av
	609	ENDIF
	610
	611	CASE DEFAULT
	612	!
	613	!-- User defined quantity
[1320]	614	CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
[1551]	615	nzb_do, nzt_do )
[1]	616	resorted = .TRUE.
	617
[254]	618	IF ( .NOT. found ) THEN
[1320]	619	message_string = 'no output available for: ' // &
[274]	620	TRIM( do3d(av,if) )
[254]	621	CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
[1]	622	ENDIF
	623
	624	END SELECT
	625
	626	!
	627	!-- Resort the array to be output, if not done above
	628	IF ( .NOT. resorted ) THEN
[667]	629	DO i = nxlg, nxrg
	630	DO j = nysg, nyng
[1551]	631	DO k = nzb_do, nzt_do
[1]	632	local_pf(i,j,k) = to_be_resorted(k,j,i)
	633	ENDDO
	634	ENDDO
	635	ENDDO
	636	ENDIF
	637
	638	!
[1327]	639	!-- Output of the 3D-array
	640	#if defined( __parallel )
	641	IF ( netcdf_data_format < 5 ) THEN
[1]	642	!
[1327]	643	!-- Non-parallel netCDF output. Data is output in parallel in
	644	!-- FORTRAN binary format here, and later collected into one file by
	645	!-- combine_plot_fields
	646	IF ( myid == 0 ) THEN
	647	WRITE ( 30 ) time_since_reference_point, &
	648	do3d_time_count(av), av
[1]	649	ENDIF
[1327]	650	DO i = 0, io_blocks-1
	651	IF ( i == io_group ) THEN
[1551]	652	WRITE ( 30 ) nxlg, nxrg, nysg, nyng, nzb_do, nzt_do
	653	WRITE ( 30 ) local_pf(:,:,nzb_do:nzt_do)
[1327]	654	ENDIF
[1]	655	#if defined( __parallel )
[1327]	656	CALL MPI_BARRIER( comm2d, ierr )
[759]	657	#endif
[1327]	658	ENDDO
[559]	659
[1327]	660	ELSE
[646]	661	#if defined( __netcdf )
[493]	662	!
[1327]	663	!-- Parallel output in netCDF4/HDF5 format.
	664	!-- Do not output redundant ghost point data except for the
	665	!-- boundaries of the total domain.
	666	IF ( nxr == nx .AND. nyn /= ny ) THEN
	667	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	668	local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do), &
	669	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	670	count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
[1327]	671	ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
	672	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	673	local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do), &
	674	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	675	count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
[1327]	676	ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
	677	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	678	local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do ), &
	679	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	680	count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
[1327]	681	ELSE
	682	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	683	local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do), &
	684	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	685	count = (/ nxr-nxl+1, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
[1327]	686	ENDIF
	687	CALL handle_netcdf_error( 'data_output_3d', 386 )
[646]	688	#endif
[1327]	689	ENDIF
[1]	690	#else
	691	#if defined( __netcdf )
[1327]	692	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	693	local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do), &
[1327]	694	start = (/ 1, 1, 1, do3d_time_count(av) /), &
[1551]	695	count = (/ nx+2, ny+2, nzt_do-nzb_do+1, 1 /) )
[1327]	696	CALL handle_netcdf_error( 'data_output_3d', 446 )
[1]	697	#endif
	698	#endif
	699
	700	if = if + 1
	701
	702	!
[1551]	703	!-- Deallocate temporary array
	704	DEALLOCATE ( local_pf )
[1]	705
[1551]	706	ENDDO
[1]	707
[1318]	708	CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
[1]	709
	710	!
	711	!-- Formats.
[1320]	712	3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &
[1]	713	'label = ',A,A)
	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 |