Home

Context Navigation

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

Last change on this file since 600 was 559, checked in by weinreis, 14 years ago

Property svn:keywords set to `Id`
File size: 14.9 KB

Rev	Line
[1]	1	SUBROUTINE data_output_3d( av )
	2
	3	!------------------------------------------------------------------------------!
[254]	4	! Current revisions:
[1]	5	! -----------------
[392]	6	!
	7	!
	8	! Former revisions:
	9	! -----------------
	10	! $Id: data_output_3d.f90 559 2010-09-07 15:17:00Z raasch $
	11	!
[494]	12	! 493 2010-03-01 08:30:24Z raasch
	13	! NetCDF4 support (parallel output)
	14	!
[392]	15	! 355 2009-07-17 01:03:01Z letzel
[291]	16	! simulated_time in NetCDF output replaced by time_since_reference_point.
[263]	17	! Output of NetCDF messages with aid of message handling routine.
[254]	18	! Output of messages replaced by message handling routine.
[355]	19	! Bugfix: to_be_resorted => s_av for time-averaged scalars
[1]	20	!
[98]	21	! 96 2007-06-04 08:07:41Z raasch
	22	! Output of density and salinity
	23	!
[77]	24	! 75 2007-03-22 09:54:05Z raasch
	25	! 2nd+3rd argument removed from exchange horiz
	26	!
[3]	27	! RCS Log replace by Id keyword, revision history cleaned up
	28	!
[1]	29	! Revision 1.3 2006/06/02 15:18:59 raasch
	30	! +argument "found", -argument grid in call of routine user_data_output_3d
	31	!
	32	! Revision 1.2 2006/02/23 10:23:07 raasch
	33	! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
	34	! .._anz renamed .._n,
	35	! output extended to (almost) all quantities, output of user-defined quantities
	36	!
	37	! Revision 1.1 1997/09/03 06:29:36 raasch
	38	! Initial revision
	39	!
	40	!
	41	! Description:
	42	! ------------
	43	! Output of the 3D-arrays in NetCDF and/or AVS format.
	44	!------------------------------------------------------------------------------!
	45
	46	USE array_kind
	47	USE arrays_3d
	48	USE averaging
	49	USE cloud_parameters
	50	USE control_parameters
	51	USE cpulog
	52	USE indices
	53	USE interfaces
	54	USE netcdf_control
	55	USE particle_attributes
	56	USE pegrid
	57
	58	IMPLICIT NONE
	59
	60	CHARACTER (LEN=9) :: simulated_time_mod
	61
[559]	62	INTEGER :: av, i, if, j, k, n, pos, prec, psi
[1]	63
	64	LOGICAL :: found, resorted
	65
	66	REAL :: mean_r, s_r3, s_r4
	67
	68	REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: local_pf
	69
	70	REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
	71
	72	!
	73	!-- Return, if nothing to output
	74	IF ( do3d_no(av) == 0 ) RETURN
	75
	76	CALL cpu_log (log_point(14),'data_output_3d','start')
	77
	78	!
	79	!-- Open output file.
	80	!-- Also creates coordinate and fld-file for AVS.
[493]	81	!-- For classic or 64bit NetCDF output or output of other (old) data formats,
	82	!-- for a run on more than one PE, each PE opens its own file and
[1]	83	!-- writes the data of its subdomain in binary format (regardless of the format
	84	!-- the user has requested). After the run, these files are combined to one
	85	!-- file by combine_plot_fields in the format requested by the user (netcdf
[493]	86	!-- and/or avs).
	87	!-- For NetCDF4/HDF5 output, data is written in parallel into one file.
	88	IF ( netcdf_output ) THEN
	89	IF ( netcdf_data_format < 3 ) THEN
	90	CALL check_open( 30 )
	91	IF ( myid == 0 ) CALL check_open( 106+av*10 )
	92	ELSE
	93	CALL check_open( 106+av*10 )
	94	ENDIF
	95	ELSE
	96	IF ( avs_output .OR. ( numprocs > 1 ) ) CALL check_open( 30 )
	97	ENDIF
[1]	98
	99	!
	100	!-- Allocate a temporary array with the desired output dimensions.
	101	ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do3d) )
	102
	103	!
	104	!-- Update the NetCDF time axis
	105	#if defined( __netcdf )
[493]	106	IF ( myid == 0 .OR. netcdf_data_format > 2 ) THEN
	107	do3d_time_count(av) = do3d_time_count(av) + 1
	108	IF ( netcdf_output ) THEN
	109	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
	110	(/ time_since_reference_point /), &
	111	start = (/ do3d_time_count(av) /), &
	112	count = (/ 1 /) )
	113	CALL handle_netcdf_error( 'data_output_3d', 376 )
	114	ENDIF
[1]	115	ENDIF
	116	#endif
	117
	118	!
	119	!-- Loop over all variables to be written.
	120	if = 1
	121
	122	DO WHILE ( do3d(av,if)(1:1) /= ' ' )
	123	!
	124	!-- Set the precision for data compression.
	125	IF ( do3d_compress ) THEN
	126	DO i = 1, 100
	127	IF ( plot_3d_precision(i)%variable == do3d(av,if) ) THEN
	128	prec = plot_3d_precision(i)%precision
	129	EXIT
	130	ENDIF
	131	ENDDO
	132	ENDIF
	133
	134	!
	135	!-- Store the array chosen on the temporary array.
	136	resorted = .FALSE.
	137	SELECT CASE ( TRIM( do3d(av,if) ) )
	138
	139	CASE ( 'e' )
	140	IF ( av == 0 ) THEN
	141	to_be_resorted => e
	142	ELSE
	143	to_be_resorted => e_av
	144	ENDIF
	145
	146	CASE ( 'p' )
	147	IF ( av == 0 ) THEN
	148	to_be_resorted => p
	149	ELSE
	150	to_be_resorted => p_av
	151	ENDIF
	152
	153	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
	154	IF ( av == 0 ) THEN
	155	tend = prt_count
[75]	156	CALL exchange_horiz( tend )
[1]	157	DO i = nxl-1, nxr+1
	158	DO j = nys-1, nyn+1
	159	DO k = nzb, nz_do3d
	160	local_pf(i,j,k) = tend(k,j,i)
	161	ENDDO
	162	ENDDO
	163	ENDDO
	164	resorted = .TRUE.
	165	ELSE
[75]	166	CALL exchange_horiz( pc_av )
[1]	167	to_be_resorted => pc_av
	168	ENDIF
	169
	170	CASE ( 'pr' ) ! mean particle radius
	171	IF ( av == 0 ) THEN
	172	DO i = nxl, nxr
	173	DO j = nys, nyn
	174	DO k = nzb, nzt+1
	175	psi = prt_start_index(k,j,i)
	176	s_r3 = 0.0
	177	s_r4 = 0.0
	178	DO n = psi, psi+prt_count(k,j,i)-1
	179	s_r3 = s_r3 + particles(n)%radius**3
	180	s_r4 = s_r4 + particles(n)%radius**4
	181	ENDDO
	182	IF ( s_r3 /= 0.0 ) THEN
	183	mean_r = s_r4 / s_r3
	184	ELSE
	185	mean_r = 0.0
	186	ENDIF
	187	tend(k,j,i) = mean_r
	188	ENDDO
	189	ENDDO
	190	ENDDO
[75]	191	CALL exchange_horiz( tend )
[1]	192	DO i = nxl-1, nxr+1
	193	DO j = nys-1, nyn+1
	194	DO k = nzb, nzt+1
	195	local_pf(i,j,k) = tend(k,j,i)
	196	ENDDO
	197	ENDDO
	198	ENDDO
	199	resorted = .TRUE.
	200	ELSE
[75]	201	CALL exchange_horiz( pr_av )
[1]	202	to_be_resorted => pr_av
	203	ENDIF
	204
	205	CASE ( 'pt' )
	206	IF ( av == 0 ) THEN
	207	IF ( .NOT. cloud_physics ) THEN
	208	to_be_resorted => pt
	209	ELSE
	210	DO i = nxl-1, nxr+1
	211	DO j = nys-1, nyn+1
	212	DO k = nzb, nz_do3d
	213	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
	214	pt_d_t(k) * &
	215	ql(k,j,i)
	216	ENDDO
	217	ENDDO
	218	ENDDO
	219	resorted = .TRUE.
	220	ENDIF
	221	ELSE
	222	to_be_resorted => pt_av
	223	ENDIF
	224
	225	CASE ( 'q' )
	226	IF ( av == 0 ) THEN
	227	to_be_resorted => q
	228	ELSE
	229	to_be_resorted => q_av
	230	ENDIF
	231
	232	CASE ( 'ql' )
	233	IF ( av == 0 ) THEN
	234	to_be_resorted => ql
	235	ELSE
	236	to_be_resorted => ql_av
	237	ENDIF
	238
	239	CASE ( 'ql_c' )
	240	IF ( av == 0 ) THEN
	241	to_be_resorted => ql_c
	242	ELSE
	243	to_be_resorted => ql_c_av
	244	ENDIF
	245
	246	CASE ( 'ql_v' )
	247	IF ( av == 0 ) THEN
	248	to_be_resorted => ql_v
	249	ELSE
	250	to_be_resorted => ql_v_av
	251	ENDIF
	252
	253	CASE ( 'ql_vp' )
	254	IF ( av == 0 ) THEN
	255	to_be_resorted => ql_vp
	256	ELSE
	257	to_be_resorted => ql_vp_av
	258	ENDIF
	259
	260	CASE ( 'qv' )
	261	IF ( av == 0 ) THEN
	262	DO i = nxl-1, nxr+1
	263	DO j = nys-1, nyn+1
	264	DO k = nzb, nz_do3d
	265	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
	266	ENDDO
	267	ENDDO
	268	ENDDO
	269	resorted = .TRUE.
	270	ELSE
	271	to_be_resorted => qv_av
	272	ENDIF
	273
[96]	274	CASE ( 'rho' )
	275	IF ( av == 0 ) THEN
	276	to_be_resorted => rho
	277	ELSE
	278	to_be_resorted => rho_av
	279	ENDIF
	280
[1]	281	CASE ( 's' )
	282	IF ( av == 0 ) THEN
	283	to_be_resorted => q
	284	ELSE
[355]	285	to_be_resorted => s_av
[1]	286	ENDIF
	287
[96]	288	CASE ( 'sa' )
	289	IF ( av == 0 ) THEN
	290	to_be_resorted => sa
	291	ELSE
	292	to_be_resorted => sa_av
	293	ENDIF
	294
[1]	295	CASE ( 'u' )
	296	IF ( av == 0 ) THEN
	297	to_be_resorted => u
	298	ELSE
	299	to_be_resorted => u_av
	300	ENDIF
	301
	302	CASE ( 'v' )
	303	IF ( av == 0 ) THEN
	304	to_be_resorted => v
	305	ELSE
	306	to_be_resorted => v_av
	307	ENDIF
	308
	309	CASE ( 'vpt' )
	310	IF ( av == 0 ) THEN
	311	to_be_resorted => vpt
	312	ELSE
	313	to_be_resorted => vpt_av
	314	ENDIF
	315
	316	CASE ( 'w' )
	317	IF ( av == 0 ) THEN
	318	to_be_resorted => w
	319	ELSE
	320	to_be_resorted => w_av
	321	ENDIF
	322
	323	CASE DEFAULT
	324	!
	325	!-- User defined quantity
	326	CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
	327	nz_do3d )
	328	resorted = .TRUE.
	329
[254]	330	IF ( .NOT. found ) THEN
[274]	331	message_string = 'no output available for: ' // &
	332	TRIM( do3d(av,if) )
[254]	333	CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
[1]	334	ENDIF
	335
	336	END SELECT
	337
	338	!
	339	!-- Resort the array to be output, if not done above
	340	IF ( .NOT. resorted ) THEN
	341	DO i = nxl-1, nxr+1
	342	DO j = nys-1, nyn+1
	343	DO k = nzb, nz_do3d
	344	local_pf(i,j,k) = to_be_resorted(k,j,i)
	345	ENDDO
	346	ENDDO
	347	ENDDO
	348	ENDIF
	349
	350	!
	351	!-- Output of the volume data information for the AVS-FLD-file.
	352	do3d_avs_n = do3d_avs_n + 1
	353	IF ( myid == 0 .AND. avs_output ) THEN
	354	!
	355	!-- AVS-labels must not contain any colons. Hence they must be removed
	356	!-- from the time character string.
	357	simulated_time_mod = simulated_time_chr
	358	DO WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 )
	359	pos = SCAN( simulated_time_mod, ':' )
	360	simulated_time_mod(pos:pos) = '/'
	361	ENDDO
	362
	363	IF ( av == 0 ) THEN
	364	WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
	365	skip_do_avs, TRIM( do3d(av,if) ), &
	366	TRIM( simulated_time_mod )
	367	ELSE
	368	WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
	369	skip_do_avs, TRIM( do3d(av,if) ) // &
	370	' averaged', TRIM( simulated_time_mod )
	371	ENDIF
	372	!
	373	!-- Determine the Skip-value for the next array. Record end and start
	374	!-- require 4 byte each.
	375	skip_do_avs = skip_do_avs + ( ((nx+2)(ny+2)(nz_do3d+1)) * 4 + 8 )
	376	ENDIF
	377
	378	!
	379	!-- Output of the 3D-array. (compressed/uncompressed)
	380	IF ( do3d_compress ) THEN
	381	!
	382	!-- Compression, output of compression information on FLD-file and output
	383	!-- of compressed data.
[559]	384	CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
	385	nzb, nz_do3d, prec )
[1]	386	ELSE
	387	!
	388	!-- Uncompressed output.
	389	#if defined( __parallel )
[493]	390	IF ( netcdf_output ) THEN
	391	IF ( netcdf_data_format < 3 ) THEN
	392	!
	393	!-- Classic or 64bit format. Data is output in parallel in FORTRAN
	394	!-- binary format here, and later collected into one file by
	395	!-- combine_plot_fields
	396	IF ( myid == 0 ) THEN
	397	WRITE ( 30 ) simulated_time, do3d_time_count(av), av
	398	ENDIF
[559]	399	WRITE ( 30 ) nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
	400	WRITE ( 30 ) local_pf
	401
[493]	402	ELSE
	403	!
	404	!-- Output in NetCDF4/HDF5 format.
	405	!-- Do not output redundant ghost point data except for the
	406	!-- boundaries of the total domain.
	407	IF ( nxr == nx .AND. nyn /= ny ) THEN
	408	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	409	local_pf(nxl:nxr+1,nys:nyn,nzb:nz_do3d), &
	410	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
	411	count = (/ nxr-nxl+2, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
	412	ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
	413	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	414	local_pf(nxl:nxr,nys:nyn+1,nzb:nz_do3d), &
	415	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
	416	count = (/ nxr-nxl+1, nyn-nys+2, nz_do3d-nzb+1, 1 /) )
	417	ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
	418	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	419	local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), &
	420	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
	421	count = (/ nxr-nxl+2, nyn-nys+2, nz_do3d-nzb+1, 1 /) )
	422	ELSE
	423	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	424	local_pf(nxl:nxr,nys:nyn,nzb:nz_do3d), &
	425	start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
	426	count = (/ nxr-nxl+1, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
	427	ENDIF
	428	CALL handle_netcdf_error( 'data_output_3d', 386 )
	429	ENDIF
[1]	430	ENDIF
	431	#else
	432	IF ( avs_output ) THEN
	433	WRITE ( 30 ) local_pf(nxl:nxr+1,nys:nyn+1,:)
	434	ENDIF
	435	#if defined( __netcdf )
	436	IF ( netcdf_output ) THEN
[493]	437
	438	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
	439	local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), &
	440	start = (/ 1, 1, 1, do3d_time_count(av) /), &
	441	count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
	442	CALL handle_netcdf_error( 'data_output_3d', 446 )
	443
[1]	444	ENDIF
	445	#endif
	446	#endif
	447	ENDIF
	448
	449	if = if + 1
	450
	451	ENDDO
	452
	453	!
	454	!-- Deallocate temporary array.
	455	DEALLOCATE( local_pf )
	456
	457
	458	CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier')
	459
	460	!
	461	!-- Formats.
	462	3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &
	463	'label = ',A,A)
	464
	465	END SUBROUTINE data_output_3d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |