Home

Context Navigation

source: palm/trunk/SOURCE/data_output_mask.f90 @ 554

Last change on this file since 554 was 494, checked in by raasch, 15 years ago
last commit documented; configuration example file for netcdf4 added
Property svn:keywords set to `Id`
File size: 14.9 KB

Rev	Line
[298]	1	SUBROUTINE data_output_mask( av )
	2
	3	!------------------------------------------------------------------------------!
[484]	4	! Current revisions:
[298]	5	! -----------------
[482]	6	!
[298]	7	!
	8	! Former revisions:
	9	! -----------------
	10	! $Id: data_output_mask.f90 494 2010-03-01 12:23:32Z weinreis $
	11	!
[494]	12	! 493 2010-03-01 08:30:24Z raasch
	13	! netcdf_format_mask* and format_parallel_io replaced by netcdf_data_format
	14	!
[482]	15	! 475 2010-02-04 02:26:16Z raasch
	16	! Bugfix in serial branch: arguments from array local_pf removed in N90_PUT_VAR
	17	!
[449]	18	! 410 2009-12-04 17:05:40Z letzel
	19	! Initial version
[298]	20	!
	21	! Description:
	22	! ------------
	23	! Masked data output in NetCDF format for current mask (current value of mid).
	24	!------------------------------------------------------------------------------!
	25
	26	#if defined( __netcdf )
	27	USE arrays_3d
	28	USE averaging
	29	USE cloud_parameters
	30	USE control_parameters
	31	USE cpulog
	32	USE grid_variables
	33	USE indices
	34	USE interfaces
	35	USE netcdf
	36	USE netcdf_control
	37	USE particle_attributes
	38	USE pegrid
	39
	40	IMPLICIT NONE
	41
	42	INTEGER :: av, ngp, file_id, i, if, is, j, k, l, n, psi, s, sender, &
	43	ind(6)
	44	LOGICAL :: found, resorted
	45	REAL :: mean_r, s_r3, s_r4
	46	REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
	47	#if defined( __parallel )
	48	REAL, DIMENSION(:,:,:), ALLOCATABLE :: total_pf
	49	#endif
	50	REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
	51
	52	!
	53	!-- Return, if nothing to output
	54	IF ( domask_no(mid,av) == 0 ) RETURN
	55
	56	CALL cpu_log (log_point(49),'data_output_mask','start')
	57
[493]	58	!
[298]	59	!-- Open output file.
[493]	60	IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) &
	61	THEN
[409]	62	CALL check_open( 120+mid+av*max_masks )
	63	ENDIF
[298]	64
	65	!
	66	!-- Allocate total and local output arrays.
	67	#if defined( __parallel )
	68	IF ( myid == 0 ) THEN
	69	ALLOCATE( total_pf(mask_size(mid,1),mask_size(mid,2),mask_size(mid,3)) )
	70	ENDIF
	71	#endif
	72	ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
	73	mask_size_l(mid,3)) )
	74
	75	!
	76	!-- Update the NetCDF time axis.
	77	domask_time_count(mid,av) = domask_time_count(mid,av) + 1
[493]	78	IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) &
	79	THEN
[298]	80	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &
	81	(/ simulated_time /), &
	82	start = (/ domask_time_count(mid,av) /), &
	83	count = (/ 1 /) )
	84	CALL handle_netcdf_error( 'data_output_mask', 9998 )
	85	ENDIF
	86
	87	!
	88	!-- Loop over all variables to be written.
	89	if = 1
	90
	91	DO WHILE ( domask(mid,av,if)(1:1) /= ' ' )
	92	!
	93	!-- Reallocate local_pf on PE 0 since its shape changes during MPI exchange
[493]	94	IF ( netcdf_data_format < 3 .AND. myid == 0 .AND. if > 1 ) THEN
[298]	95	DEALLOCATE( local_pf )
	96	ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
	97	mask_size_l(mid,3)) )
	98	ENDIF
	99	!
	100	!-- Store the variable chosen.
	101	resorted = .FALSE.
	102	SELECT CASE ( TRIM( domask(mid,av,if) ) )
	103
	104	CASE ( 'e' )
	105	IF ( av == 0 ) THEN
	106	to_be_resorted => e
	107	ELSE
	108	to_be_resorted => e_av
	109	ENDIF
	110
	111	CASE ( 'p' )
	112	IF ( av == 0 ) THEN
	113	to_be_resorted => p
	114	ELSE
	115	to_be_resorted => p_av
	116	ENDIF
	117
	118	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
	119	IF ( av == 0 ) THEN
	120	tend = prt_count
	121	CALL exchange_horiz( tend )
	122	DO i = 1, mask_size_l(mid,1)
	123	DO j = 1, mask_size_l(mid,2)
	124	DO k = 1, mask_size_l(mid,3)
	125	local_pf(i,j,k) = tend(mask_k(mid,k), &
	126	mask_j(mid,j),mask_i(mid,i))
	127	ENDDO
	128	ENDDO
	129	ENDDO
	130	resorted = .TRUE.
	131	ELSE
	132	CALL exchange_horiz( pc_av )
	133	to_be_resorted => pc_av
	134	ENDIF
	135
	136	CASE ( 'pr' ) ! mean particle radius
	137	IF ( av == 0 ) THEN
	138	DO i = nxl, nxr
	139	DO j = nys, nyn
	140	DO k = nzb, nzt+1
	141	psi = prt_start_index(k,j,i)
	142	s_r3 = 0.0
	143	s_r4 = 0.0
	144	DO n = psi, psi+prt_count(k,j,i)-1
	145	s_r3 = s_r3 + particles(n)%radius**3
	146	s_r4 = s_r4 + particles(n)%radius**4
	147	ENDDO
	148	IF ( s_r3 /= 0.0 ) THEN
	149	mean_r = s_r4 / s_r3
	150	ELSE
	151	mean_r = 0.0
	152	ENDIF
	153	tend(k,j,i) = mean_r
	154	ENDDO
	155	ENDDO
	156	ENDDO
	157	CALL exchange_horiz( tend )
	158	DO i = 1, mask_size_l(mid,1)
	159	DO j = 1, mask_size_l(mid,2)
	160	DO k = 1, mask_size_l(mid,3)
	161	local_pf(i,j,k) = tend(mask_k(mid,k), &
	162	mask_j(mid,j),mask_i(mid,i))
	163	ENDDO
	164	ENDDO
	165	ENDDO
	166	resorted = .TRUE.
	167	ELSE
	168	CALL exchange_horiz( pr_av )
	169	to_be_resorted => pr_av
	170	ENDIF
	171
	172	CASE ( 'pt' )
	173	IF ( av == 0 ) THEN
	174	IF ( .NOT. cloud_physics ) THEN
	175	to_be_resorted => pt
	176	ELSE
	177	DO i = 1, mask_size_l(mid,1)
	178	DO j = 1, mask_size_l(mid,2)
	179	DO k = 1, mask_size_l(mid,3)
	180	local_pf(i,j,k) = &
	181	pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
	182	+ l_d_cp * pt_d_t(mask_k(mid,k)) * &
	183	ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
	184	ENDDO
	185	ENDDO
	186	ENDDO
	187	resorted = .TRUE.
	188	ENDIF
	189	ELSE
	190	to_be_resorted => pt_av
	191	ENDIF
	192
	193	CASE ( 'q' )
	194	IF ( av == 0 ) THEN
	195	to_be_resorted => q
	196	ELSE
	197	to_be_resorted => q_av
	198	ENDIF
	199
	200	CASE ( 'ql' )
	201	IF ( av == 0 ) THEN
	202	to_be_resorted => ql
	203	ELSE
	204	to_be_resorted => ql_av
	205	ENDIF
	206
	207	CASE ( 'ql_c' )
	208	IF ( av == 0 ) THEN
	209	to_be_resorted => ql_c
	210	ELSE
	211	to_be_resorted => ql_c_av
	212	ENDIF
	213
	214	CASE ( 'ql_v' )
	215	IF ( av == 0 ) THEN
	216	to_be_resorted => ql_v
	217	ELSE
	218	to_be_resorted => ql_v_av
	219	ENDIF
	220
	221	CASE ( 'ql_vp' )
	222	IF ( av == 0 ) THEN
	223	to_be_resorted => ql_vp
	224	ELSE
	225	to_be_resorted => ql_vp_av
	226	ENDIF
	227
	228	CASE ( 'qv' )
	229	IF ( av == 0 ) THEN
	230	DO i = 1, mask_size_l(mid,1)
	231	DO j = 1, mask_size_l(mid,2)
	232	DO k = 1, mask_size_l(mid,3)
	233	local_pf(i,j,k) = &
	234	q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) - &
	235	ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
	236	ENDDO
	237	ENDDO
	238	ENDDO
	239	resorted = .TRUE.
	240	ELSE
	241	to_be_resorted => qv_av
	242	ENDIF
	243
	244	CASE ( 'rho' )
	245	IF ( av == 0 ) THEN
	246	to_be_resorted => rho
	247	ELSE
	248	to_be_resorted => rho_av
	249	ENDIF
	250
	251	CASE ( 's' )
	252	IF ( av == 0 ) THEN
	253	to_be_resorted => q
	254	ELSE
[356]	255	to_be_resorted => s_av
[298]	256	ENDIF
	257
	258	CASE ( 'sa' )
	259	IF ( av == 0 ) THEN
	260	to_be_resorted => sa
	261	ELSE
	262	to_be_resorted => sa_av
	263	ENDIF
	264
	265	CASE ( 'u' )
	266	IF ( av == 0 ) THEN
	267	to_be_resorted => u
	268	ELSE
	269	to_be_resorted => u_av
	270	ENDIF
	271
	272	CASE ( 'v' )
	273	IF ( av == 0 ) THEN
	274	to_be_resorted => v
	275	ELSE
	276	to_be_resorted => v_av
	277	ENDIF
	278
	279	CASE ( 'vpt' )
	280	IF ( av == 0 ) THEN
	281	to_be_resorted => vpt
	282	ELSE
	283	to_be_resorted => vpt_av
	284	ENDIF
	285
	286	CASE ( 'w' )
	287	IF ( av == 0 ) THEN
	288	to_be_resorted => w
	289	ELSE
	290	to_be_resorted => w_av
	291	ENDIF
	292
	293	CASE DEFAULT
	294	!
	295	!-- User defined quantity
	296	CALL user_data_output_mask(av, domask(mid,av,if), found, local_pf )
	297	resorted = .TRUE.
	298
	299	IF ( .NOT. found ) THEN
	300	WRITE ( message_string, * ) 'no output available for: ', &
	301	TRIM( domask(mid,av,if) )
	302	CALL message( 'data_output_mask', 'PA9998', 0, 0, 0, 6, 0 )
	303	ENDIF
	304
	305	END SELECT
	306
	307	!
	308	!-- Resort the array to be output, if not done above
	309	IF ( .NOT. resorted ) THEN
	310	DO i = 1, mask_size_l(mid,1)
	311	DO j = 1, mask_size_l(mid,2)
	312	DO k = 1, mask_size_l(mid,3)
	313	local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), &
	314	mask_j(mid,j),mask_i(mid,i))
	315	ENDDO
	316	ENDDO
	317	ENDDO
	318	ENDIF
	319
	320	!
	321	!-- I/O block. I/O methods are implemented
	322	!-- (1) for parallel execution
	323	!-- a. with NetCDF 4 parallel I/O-enabled library
	324	!-- b. with NetCDF 3 library
	325	!-- (2) for serial execution.
	326	!-- The choice of method depends on the correct setting of preprocessor
	327	!-- directives __parallel and __netcdf4 as well as on the parameter
[493]	328	!-- netcdf_data_format.
[298]	329	#if defined( __parallel )
	330	#if defined( __netcdf4 )
[493]	331	IF ( netcdf_data_format > 2 ) THEN
[298]	332	!
	333	!-- (1) a. Parallel I/O using NetCDF 4 (not yet tested)
	334	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
[340]	335	id_var_domask(mid,av,if), &
[409]	336	local_pf, &
[340]	337	start = (/ mask_start_l(mid,1), mask_start_l(mid,2), &
[409]	338	mask_start_l(mid,3), domask_time_count(mid,av) /), &
	339	count = (/ mask_size_l(mid,1), mask_size_l(mid,2), &
	340	mask_size_l(mid,3), 1 /) )
[298]	341	CALL handle_netcdf_error( 'data_output_mask', 9998 )
	342	ELSE
	343	#endif
	344	!
	345	!-- (1) b. Conventional I/O only through PE0
	346	!-- PE0 receives partial arrays from all processors of the respective mask
	347	!-- and outputs them. Here a barrier has to be set, because otherwise
	348	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
	349	CALL MPI_BARRIER( comm2d, ierr )
	350
	351	ngp = mask_size_l(mid,1) * mask_size_l(mid,2) * mask_size_l(mid,3)
	352	IF ( myid == 0 ) THEN
	353	!
	354	!-- Local array can be relocated directly.
	355	total_pf( &
	356	mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, &
	357	mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, &
	358	mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) &
	359	= local_pf
	360	!
	361	!-- Receive data from all other PEs.
	362	DO n = 1, numprocs-1
	363	!
	364	!-- Receive index limits first, then array.
	365	!-- Index limits are received in arbitrary order from the PEs.
	366	CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, &
	367	comm2d, status, ierr )
	368	!
	369	!-- Not all PEs have data for the mask
	370	IF ( ind(1) /= -9999 ) THEN
	371	ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) * &
	372	( ind(6)-ind(5)+1 )
	373	sender = status(MPI_SOURCE)
	374	DEALLOCATE( local_pf )
	375	ALLOCATE(local_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)))
	376	CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp, &
	377	MPI_REAL, sender, 1, comm2d, status, ierr )
	378	total_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)) &
	379	= local_pf
	380	ENDIF
	381	ENDDO
	382
	383	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
	384	id_var_domask(mid,av,if), total_pf, &
	385	start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
	386	count = (/ mask_size(mid,1), mask_size(mid,2), &
	387	mask_size(mid,3), 1 /) )
	388	CALL handle_netcdf_error( 'data_output_mask', 9998 )
	389
	390	ELSE
	391	!
	392	!-- If at least part of the mask resides on the PE, send the index
	393	!-- limits for the target array, otherwise send -9999 to PE0.
	394	IF ( mask_size_l(mid,1) > 0 .AND. mask_size_l(mid,2) > 0 .AND. &
	395	mask_size_l(mid,3) > 0 ) &
	396	THEN
	397	ind(1) = mask_start_l(mid,1)
	398	ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
	399	ind(3) = mask_start_l(mid,2)
	400	ind(4) = mask_start_l(mid,2) + mask_size_l(mid,2) - 1
	401	ind(5) = mask_start_l(mid,3)
	402	ind(6) = mask_start_l(mid,3) + mask_size_l(mid,3) - 1
	403	ELSE
	404	ind(1) = -9999; ind(2) = -9999
	405	ind(3) = -9999; ind(4) = -9999
	406	ind(5) = -9999; ind(6) = -9999
	407	ENDIF
	408	CALL MPI_SEND( ind(1), 6, MPI_INTEGER, 0, 0, comm2d, ierr )
	409	!
	410	!-- If applicable, send data to PE0.
	411	IF ( ind(1) /= -9999 ) THEN
	412	CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, &
	413	ierr )
	414	ENDIF
	415	ENDIF
	416	!
	417	!-- A barrier has to be set, because otherwise some PEs may proceed too
	418	!-- fast so that PE0 may receive wrong data on tag 0.
	419	CALL MPI_BARRIER( comm2d, ierr )
	420	#if defined( __netcdf4 )
	421	ENDIF
	422	#endif
	423	#else
	424	!
	425	!-- (2) For serial execution of PALM, the single processor (PE0) holds all
	426	!-- data and writes them directly to file.
	427	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
	428	id_var_domask(mid,av,if), &
[475]	429	local_pf, &
[298]	430	start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
	431	count = (/ mask_size_l(mid,1), mask_size_l(mid,2), &
	432	mask_size_l(mid,3), 1 /) )
	433	CALL handle_netcdf_error( 'data_output_mask', 9998 )
	434	#endif
	435
	436	if = if + 1
	437	ENDDO
	438
	439	!
	440	!-- Deallocate temporary arrays.
	441	DEALLOCATE( local_pf )
	442	#if defined( __parallel )
	443	IF ( myid == 0 ) THEN
	444	DEALLOCATE( total_pf )
	445	ENDIF
	446	#endif
	447
	448
	449	CALL cpu_log (log_point(49),'data_output_mask','stop','nobarrier')
	450	#endif
	451
	452	END SUBROUTINE data_output_mask

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |