Home

Context Navigation

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

Last change on this file since 1099 was 1077, checked in by hoffmann, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 20.8 KB

Rev	Line
[1]	1	SUBROUTINE data_output_3d( av )
	2
[1036]	3	!--------------------------------------------------------------------------------!
	4	! This file is part of PALM.
	5	!
	6	! PALM is free software: you can redistribute it and/or modify it under the terms
	7	! of the GNU General Public License as published by the Free Software Foundation,
	8	! either version 3 of the License, or (at your option) any later version.
	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	!
	17	! Copyright 1997-2012 Leibniz University Hannover
	18	!--------------------------------------------------------------------------------!
	19	!
[254]	20	! Current revisions:
[1]	21	! -----------------
[674]	22	!
[392]	23	! Former revisions:
	24	! -----------------
	25	! $Id: data_output_3d.f90 1077 2012-12-05 08:43:46Z raasch $
	26	!
[1077]	27	! 1076 2012-12-05 08:30:18Z hoffmann
	28	! Bugfix in output of ql
	29	!
[1054]	30	! 1053 2012-11-13 17:11:03Z hoffmann
	31	! +nr, qr, prr, qc and averaged quantities
	32	!
[1037]	33	! 1036 2012-10-22 13:43:42Z raasch
	34	! code put under GPL (PALM 3.9)
	35	!
[1035]	36	! 1031 2012-10-19 14:35:30Z raasch
	37	! netCDF4 without parallel file support implemented
	38	!
[1008]	39	! 1007 2012-09-19 14:30:36Z franke
	40	! Bugfix: missing calculation of ql_vp added
	41	!
[791]	42	! 790 2011-11-29 03:11:20Z raasch
	43	! bugfix: calculation of 'pr' must depend on the particle weighting factor,
	44	! nzt+1 replaced by nz_do3d for 'pr'
	45	!
[772]	46	! 771 2011-10-27 10:56:21Z heinze
	47	! +lpt
	48	!
[760]	49	! 759 2011-09-15 13:58:31Z raasch
	50	! Splitting of parallel I/O
	51	!
[728]	52	! 727 2011-04-20 20:05:25Z suehring
	53	! Exchange ghost layers also for p_av.
	54	!
[726]	55	! 725 2011-04-11 09:37:01Z suehring
	56	! Exchange ghost layers for p regardless of used pressure solver (except SOR).
	57	!
[692]	58	! 691 2011-03-04 08:45:30Z maronga
	59	! Replaced simulated_time by time_since_reference_point
	60	!
[674]	61	! 673 2011-01-18 16:19:48Z suehring
	62	! When using Multigrid or SOR solver an additional CALL exchange_horiz is
	63	! is needed for pressure output.
	64	!
[668]	65	! 667 2010-12-23 12:06:00Z suehring/gryschka
	66	! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
	67	! allocation of arrays. Calls of exchange_horiz are modified.
	68	! Skip-value skip_do_avs changed to a dynamic adaption of ghost points.
	69	!
[647]	70	! 646 2010-12-15 13:03:52Z raasch
	71	! bugfix: missing define statements for netcdf added
	72	!
[494]	73	! 493 2010-03-01 08:30:24Z raasch
[1031]	74	! netCDF4 support (parallel output)
[494]	75	!
[392]	76	! 355 2009-07-17 01:03:01Z letzel
[1031]	77	! simulated_time in netCDF output replaced by time_since_reference_point.
	78	! Output of netCDF messages with aid of message handling routine.
[254]	79	! Output of messages replaced by message handling routine.
[355]	80	! Bugfix: to_be_resorted => s_av for time-averaged scalars
[1]	81	!
[98]	82	! 96 2007-06-04 08:07:41Z raasch
	83	! Output of density and salinity
	84	!
[77]	85	! 75 2007-03-22 09:54:05Z raasch
	86	! 2nd+3rd argument removed from exchange horiz
	87	!
[3]	88	! RCS Log replace by Id keyword, revision history cleaned up
	89	!
[1]	90	! Revision 1.3 2006/06/02 15:18:59 raasch
	91	! +argument "found", -argument grid in call of routine user_data_output_3d
	92	!
	93	! Revision 1.2 2006/02/23 10:23:07 raasch
	94	! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
	95	! .._anz renamed .._n,
	96	! output extended to (almost) all quantities, output of user-defined quantities
	97	!
	98	! Revision 1.1 1997/09/03 06:29:36 raasch
	99	! Initial revision
	100	!
	101	!
	102	! Description:
	103	! ------------
[1031]	104	! Output of the 3D-arrays in netCDF and/or AVS format.
[1]	105	!------------------------------------------------------------------------------!
	106
	107	USE array_kind
	108	USE arrays_3d
	109	USE averaging
	110	USE cloud_parameters
	111	USE control_parameters
	112	USE cpulog
	113	USE indices
	114	USE interfaces
	115	USE netcdf_control
	116	USE particle_attributes
	117	USE pegrid
	118
	119	IMPLICIT NONE
	120
	121	CHARACTER (LEN=9) :: simulated_time_mod
	122
[559]	123	INTEGER :: av, i, if, j, k, n, pos, prec, psi
[1]	124
	125	LOGICAL :: found, resorted
	126
	127	REAL :: mean_r, s_r3, s_r4
	128
	129	REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: local_pf
	130
	131	REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
	132
	133	!
	134	!-- Return, if nothing to output
	135	IF ( do3d_no(av) == 0 ) RETURN
	136
	137	CALL cpu_log (log_point(14),'data_output_3d','start')
	138
	139	!
	140	!-- Open output file.
	141	!-- Also creates coordinate and fld-file for AVS.
[1031]	142	!-- For classic or 64bit netCDF output or output of other (old) data formats,
[493]	143	!-- for a run on more than one PE, each PE opens its own file and
[1]	144	!-- writes the data of its subdomain in binary format (regardless of the format
	145	!-- the user has requested). After the run, these files are combined to one
	146	!-- file by combine_plot_fields in the format requested by the user (netcdf
[493]	147	!-- and/or avs).
[1031]	148	!-- For netCDF4/HDF5 output, data is written in parallel into one file.
[493]	149	IF ( netcdf_output ) THEN
[1031]	150	IF ( netcdf_data_format < 5 ) THEN
[493]	151	CALL check_open( 30 )
	152	IF ( myid == 0 ) CALL check_open( 106+av*10 )
	153	ELSE
	154	CALL check_open( 106+av*10 )
	155	ENDIF
	156	ELSE
	157	IF ( avs_output .OR. ( numprocs > 1 ) ) CALL check_open( 30 )
	158	ENDIF
[1]	159
	160	!
	161	!-- Allocate a temporary array with the desired output dimensions.
[667]	162	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nz_do3d) )
[1]	163
	164	!
[1031]	165	!-- Update the netCDF time axis
[1]	166	#if defined( __netcdf )
[1031]	167	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	168	do3d_time_count(av) = do3d_time_count(av) + 1
	169	IF ( netcdf_output ) THEN
	170	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
	171	(/ time_since_reference_point /), &
	172	start = (/ do3d_time_count(av) /), &
	173	count = (/ 1 /) )
	174	CALL handle_netcdf_error( 'data_output_3d', 376 )
	175	ENDIF
[1]	176	ENDIF
	177	#endif
	178
	179	!
	180	!-- Loop over all variables to be written.
	181	if = 1
	182
	183	DO WHILE ( do3d(av,if)(1:1) /= ' ' )
	184	!
	185	!-- Set the precision for data compression.
	186	IF ( do3d_compress ) THEN
	187	DO i = 1, 100
	188	IF ( plot_3d_precision(i)%variable == do3d(av,if) ) THEN
	189	prec = plot_3d_precision(i)%precision
	190	EXIT
	191	ENDIF
	192	ENDDO
	193	ENDIF
	194
	195	!
	196	!-- Store the array chosen on the temporary array.
	197	resorted = .FALSE.
	198	SELECT CASE ( TRIM( do3d(av,if) ) )
	199
	200	CASE ( 'e' )
	201	IF ( av == 0 ) THEN
	202	to_be_resorted => e
	203	ELSE
	204	to_be_resorted => e_av
	205	ENDIF
	206
[771]	207	CASE ( 'lpt' )
	208	IF ( av == 0 ) THEN
	209	to_be_resorted => pt
	210	ELSE
	211	to_be_resorted => lpt_av
	212	ENDIF
	213
[1053]	214	CASE ( 'nr' )
	215	IF ( av == 0 ) THEN
	216	to_be_resorted => nr
	217	ELSE
	218	to_be_resorted => nr_av
	219	ENDIF
	220
[1]	221	CASE ( 'p' )
	222	IF ( av == 0 ) THEN
[727]	223	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
[1]	224	to_be_resorted => p
	225	ELSE
[727]	226	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
[1]	227	to_be_resorted => p_av
	228	ENDIF
	229
	230	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
	231	IF ( av == 0 ) THEN
	232	tend = prt_count
[667]	233	CALL exchange_horiz( tend, nbgp )
	234	DO i = nxlg, nxrg
	235	DO j = nysg, nyng
[1]	236	DO k = nzb, nz_do3d
	237	local_pf(i,j,k) = tend(k,j,i)
	238	ENDDO
	239	ENDDO
	240	ENDDO
	241	resorted = .TRUE.
	242	ELSE
[667]	243	CALL exchange_horiz( pc_av, nbgp )
[1]	244	to_be_resorted => pc_av
	245	ENDIF
	246
	247	CASE ( 'pr' ) ! mean particle radius
	248	IF ( av == 0 ) THEN
	249	DO i = nxl, nxr
	250	DO j = nys, nyn
[790]	251	DO k = nzb, nz_do3d
[1]	252	psi = prt_start_index(k,j,i)
	253	s_r3 = 0.0
	254	s_r4 = 0.0
	255	DO n = psi, psi+prt_count(k,j,i)-1
[790]	256	s_r3 = s_r3 + particles(n)%radius*3 &
	257	particles(n)%weight_factor
	258	s_r4 = s_r4 + particles(n)%radius*4 &
	259	particles(n)%weight_factor
[1]	260	ENDDO
	261	IF ( s_r3 /= 0.0 ) THEN
	262	mean_r = s_r4 / s_r3
	263	ELSE
	264	mean_r = 0.0
	265	ENDIF
	266	tend(k,j,i) = mean_r
	267	ENDDO
	268	ENDDO
	269	ENDDO
[667]	270	CALL exchange_horiz( tend, nbgp )
	271	DO i = nxlg, nxrg
	272	DO j = nysg, nyng
[790]	273	DO k = nzb, nz_do3d
[1]	274	local_pf(i,j,k) = tend(k,j,i)
	275	ENDDO
	276	ENDDO
	277	ENDDO
	278	resorted = .TRUE.
	279	ELSE
[667]	280	CALL exchange_horiz( pr_av, nbgp )
[1]	281	to_be_resorted => pr_av
	282	ENDIF
	283
[1053]	284	CASE ( 'prr' )
	285	IF ( av == 0 ) THEN
	286	CALL exchange_horiz( prr, nbgp )
	287	DO i = nxlg, nxrg
	288	DO j = nysg, nyng
	289	DO k = nzb, nzt+1
	290	local_pf(i,j,k) = prr(k,j,i)
	291	ENDDO
	292	ENDDO
	293	ENDDO
	294	ELSE
	295	CALL exchange_horiz( prr_av, nbgp )
	296	DO i = nxlg, nxrg
	297	DO j = nysg, nyng
	298	DO k = nzb, nzt+1
	299	local_pf(i,j,k) = prr_av(k,j,i)
	300	ENDDO
	301	ENDDO
	302	ENDDO
	303	ENDIF
	304	resorted = .TRUE.
	305
[1]	306	CASE ( 'pt' )
	307	IF ( av == 0 ) THEN
	308	IF ( .NOT. cloud_physics ) THEN
	309	to_be_resorted => pt
	310	ELSE
[667]	311	DO i = nxlg, nxrg
	312	DO j = nysg, nyng
[1]	313	DO k = nzb, nz_do3d
	314	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
	315	pt_d_t(k) * &
	316	ql(k,j,i)
	317	ENDDO
	318	ENDDO
	319	ENDDO
	320	resorted = .TRUE.
	321	ENDIF
	322	ELSE
	323	to_be_resorted => pt_av
	324	ENDIF
	325
	326	CASE ( 'q' )
	327	IF ( av == 0 ) THEN
	328	to_be_resorted => q
	329	ELSE
	330	to_be_resorted => q_av
	331	ENDIF
[691]	332
[1053]	333	CASE ( 'qc' )
[1]	334	IF ( av == 0 ) THEN
	335	to_be_resorted => ql
	336	ELSE
	337	to_be_resorted => ql_av
	338	ENDIF
	339
[1053]	340	CASE ( 'ql' )
	341	IF ( av == 0 ) THEN
[1076]	342	IF ( cloud_physics .AND. icloud_scheme == 0 ) THEN
[1053]	343	DO i = nxlg, nxrg
	344	DO j = nysg, nyng
	345	DO k = nzb, nz_do3d
	346	local_pf(i,j,k) = ql(k,j,i) + qr(k,j,i)
	347	ENDDO
	348	ENDDO
	349	ENDDO
	350	resorted = .TRUE.
	351	ELSE
	352	to_be_resorted => ql
	353	ENDIF
	354	ELSE
[1076]	355	IF ( cloud_physics .AND. icloud_scheme == 0 ) THEN
[1053]	356	DO i = nxlg, nxrg
	357	DO j = nysg, nyng
	358	DO k = nzb, nz_do3d
	359	local_pf(i,j,k) = ql_av(k,j,i) + qr_av(k,j,i)
	360	ENDDO
	361	ENDDO
	362	ENDDO
	363	resorted = .TRUE.
	364	ELSE
	365	to_be_resorted => ql_av
	366	ENDIF
	367	ENDIF
	368
[1]	369	CASE ( 'ql_c' )
	370	IF ( av == 0 ) THEN
	371	to_be_resorted => ql_c
	372	ELSE
	373	to_be_resorted => ql_c_av
	374	ENDIF
	375
	376	CASE ( 'ql_v' )
	377	IF ( av == 0 ) THEN
	378	to_be_resorted => ql_v
	379	ELSE
	380	to_be_resorted => ql_v_av
	381	ENDIF
	382
	383	CASE ( 'ql_vp' )
	384	IF ( av == 0 ) THEN
[1007]	385	DO i = nxl, nxr
	386	DO j = nys, nyn
	387	DO k = nzb, nz_do3d
	388	psi = prt_start_index(k,j,i)
	389	DO n = psi, psi+prt_count(k,j,i)-1
	390	tend(k,j,i) = tend(k,j,i) + &
	391	particles(n)%weight_factor / &
	392	prt_count(k,j,i)
	393	ENDDO
	394	ENDDO
	395	ENDDO
	396	ENDDO
	397	CALL exchange_horiz( tend, nbgp )
	398	DO i = nxlg, nxrg
	399	DO j = nysg, nyng
	400	DO k = nzb, nz_do3d
	401	local_pf(i,j,k) = tend(k,j,i)
	402	ENDDO
	403	ENDDO
	404	ENDDO
	405	resorted = .TRUE.
[1]	406	ELSE
[1007]	407	CALL exchange_horiz( ql_vp_av, nbgp )
[1]	408	to_be_resorted => ql_vp_av
	409	ENDIF
	410
[1053]	411	CASE ( 'qr' )
	412	IF ( av == 0 ) THEN
	413	to_be_resorted => qr
	414	ELSE
	415	to_be_resorted => qr_av
	416	ENDIF
	417
[1]	418	CASE ( 'qv' )
	419	IF ( av == 0 ) THEN
[667]	420	DO i = nxlg, nxrg
	421	DO j = nysg, nyng
[1]	422	DO k = nzb, nz_do3d
	423	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
	424	ENDDO
	425	ENDDO
	426	ENDDO
	427	resorted = .TRUE.
	428	ELSE
	429	to_be_resorted => qv_av
	430	ENDIF
	431
[96]	432	CASE ( 'rho' )
	433	IF ( av == 0 ) THEN
	434	to_be_resorted => rho
	435	ELSE
	436	to_be_resorted => rho_av
	437	ENDIF
[691]	438
[1]	439	CASE ( 's' )
	440	IF ( av == 0 ) THEN
	441	to_be_resorted => q
	442	ELSE
[355]	443	to_be_resorted => s_av
[1]	444	ENDIF
[691]	445
[96]	446	CASE ( 'sa' )
	447	IF ( av == 0 ) THEN
	448	to_be_resorted => sa
	449	ELSE
	450	to_be_resorted => sa_av
	451	ENDIF
[691]	452
[1]	453	CASE ( 'u' )
	454	IF ( av == 0 ) THEN
	455	to_be_resorted => u
	456	ELSE
	457	to_be_resorted => u_av
	458	ENDIF
	459
	460	CASE ( 'v' )
	461	IF ( av == 0 ) THEN
	462	to_be_resorted => v
	463	ELSE
	464	to_be_resorted => v_av
	465	ENDIF
	466
	467	CASE ( 'vpt' )
	468	IF ( av == 0 ) THEN
	469	to_be_resorted => vpt
	470	ELSE
	471	to_be_resorted => vpt_av
	472	ENDIF
	473
	474	CASE ( 'w' )
	475	IF ( av == 0 ) THEN
	476	to_be_resorted => w
	477	ELSE
	478	to_be_resorted => w_av
	479	ENDIF
	480
	481	CASE DEFAULT
	482	!
	483	!-- User defined quantity
	484	CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
	485	nz_do3d )
	486	resorted = .TRUE.
	487
[254]	488	IF ( .NOT. found ) THEN
[274]	489	message_string = 'no output available for: ' // &
	490	TRIM( do3d(av,if) )
[254]	491	CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
[1]	492	ENDIF
	493
	494	END SELECT
	495
	496	!
	497	!-- Resort the array to be output, if not done above
	498	IF ( .NOT. resorted ) THEN
[667]	499	DO i = nxlg, nxrg
	500	DO j = nysg, nyng
[1]	501	DO k = nzb, nz_do3d
	502	local_pf(i,j,k) = to_be_resorted(k,j,i)
	503	ENDDO
	504	ENDDO
	505	ENDDO
	506	ENDIF
	507
	508	!
	509	!-- Output of the volume data information for the AVS-FLD-file.
	510	do3d_avs_n = do3d_avs_n + 1
	511	IF ( myid == 0 .AND. avs_output ) THEN
	512	!
	513	!-- AVS-labels must not contain any colons. Hence they must be removed
	514	!-- from the time character string.
	515	simulated_time_mod = simulated_time_chr
	516	DO WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 )
	517	pos = SCAN( simulated_time_mod, ':' )
	518	simulated_time_mod(pos:pos) = '/'
	519	ENDDO
	520
	521	IF ( av == 0 ) THEN
	522	WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
	523	skip_do_avs, TRIM( do3d(av,if) ), &
	524	TRIM( simulated_time_mod )
	525	ELSE
	526	WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
	527	skip_do_avs, TRIM( do3d(av,if) ) // &
	528	' averaged', TRIM( simulated_time_mod )
	529	ENDIF
	530	!
	531	!-- Determine the Skip-value for the next array. Record end and start
	532	!-- require 4 byte each.
[759]	533	skip_do_avs = skip_do_avs + ( ( ( nx+2nbgp ) ( ny+2nbgp ) &
	534	( nz_do3d+1 ) ) * 4 + 8 )
[1]	535	ENDIF
	536
	537	!
	538	!-- Output of the 3D-array. (compressed/uncompressed)
	539	IF ( do3d_compress ) THEN
	540	!
	541	!-- Compression, output of compression information on FLD-file and output
	542	!-- of compressed data.
[559]	543	CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
[667]	544	nzb, nz_do3d, prec, nbgp )
[1]	545	ELSE
	546	!
	547	!-- Uncompressed output.
	548	#if defined( __parallel )
[493]	549	IF ( netcdf_output ) THEN
[1031]	550	IF ( netcdf_data_format < 5 ) THEN
[493]	551	!
[1031]	552	!-- Non-parallel netCDF output. Data is output in parallel in
	553	!-- FORTRAN binary format here, and later collected into one file by
[493]	554	!-- combine_plot_fields
	555	IF ( myid == 0 ) THEN
[691]	556	WRITE ( 30 ) time_since_reference_point, &
	557	do3d_time_count(av), av
[493]	558	ENDIF
[759]	559	DO i = 0, io_blocks-1
	560	IF ( i == io_group ) THEN
	561	WRITE ( 30 ) nxlg, nxrg, nysg, nyng, nzb, nz_do3d
	562	WRITE ( 30 ) local_pf
	563	ENDIF
	564	#if defined( __parallel )
	565	CALL MPI_BARRIER( comm2d, ierr )
	566	#endif
	567	ENDDO
[559]	568
[493]	569	ELSE
[646]	570	#if defined( __netcdf )
[493]	571	!
[1031]	572	!-- Parallel output in netCDF4/HDF5 format.
[493]	573	!-- Do not output redundant ghost point data except for the
	574	!-- boundaries of the total domain.
	575	IF ( nxr == nx .AND. nyn /= ny ) THEN
	576	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[667]	577	local_pf(nxl:nxrg,nys:nyn,nzb:nz_do3d), &
[493]	578	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
[667]	579	count = (/ nxr-nxl+1+nbgp, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
[493]	580	ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
	581	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[667]	582	local_pf(nxl:nxr,nys:nyng,nzb:nz_do3d), &
[493]	583	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
[667]	584	count = (/ nxr-nxl+1, nyn-nys+1+nbgp, nz_do3d-nzb+1, 1 /) )
[493]	585	ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
	586	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[667]	587	local_pf(nxl:nxrg,nys:nyng,nzb:nz_do3d), &
[493]	588	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
[667]	589	count = (/ nxr-nxl+1+nbgp, nyn-nys+1+nbgp, nz_do3d-nzb+1, 1 /) )
[493]	590	ELSE
	591	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	592	local_pf(nxl:nxr,nys:nyn,nzb:nz_do3d), &
	593	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
	594	count = (/ nxr-nxl+1, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
	595	ENDIF
	596	CALL handle_netcdf_error( 'data_output_3d', 386 )
[646]	597	#endif
[493]	598	ENDIF
[1]	599	ENDIF
	600	#else
	601	IF ( avs_output ) THEN
	602	WRITE ( 30 ) local_pf(nxl:nxr+1,nys:nyn+1,:)
	603	ENDIF
	604	#if defined( __netcdf )
	605	IF ( netcdf_output ) THEN
[493]	606
	607	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	608	local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), &
	609	start = (/ 1, 1, 1, do3d_time_count(av) /), &
	610	count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
	611	CALL handle_netcdf_error( 'data_output_3d', 446 )
	612
[1]	613	ENDIF
	614	#endif
	615	#endif
	616	ENDIF
	617
	618	if = if + 1
	619
	620	ENDDO
	621
	622	!
	623	!-- Deallocate temporary array.
	624	DEALLOCATE( local_pf )
	625
	626
	627	CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier')
	628
	629	!
	630	!-- Formats.
	631	3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &
	632	'label = ',A,A)
	633
	634	END SUBROUTINE data_output_3d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |