Home

Context Navigation

source: palm/trunk/SOURCE/data_output_dvrp.f90 @ 869

Last change on this file since 869 was 829, checked in by raasch, 13 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 22.2 KB

Rev	Line
[1]	1	MODULE dvrp_color
	2
	3	USE dvrp_variables
	4
	5	IMPLICIT NONE
	6
	7	CONTAINS
	8
	9	SUBROUTINE color_dvrp( value, color )
	10
	11	REAL, INTENT(IN) :: value
	12	REAL, INTENT(OUT) :: color(4)
	13
	14	REAL :: scale
	15
	16	scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) / &
	17	( slicer_range_limits_dvrp(2,islice_dvrp) - &
	18	slicer_range_limits_dvrp(1,islice_dvrp) )
	19
	20	scale = MODULO( 180.0 + 180.0 * scale, 360.0 )
	21
	22	color = (/ scale, 0.5, 1.0, 0.0 /)
	23
	24	END SUBROUTINE color_dvrp
	25
	26	END MODULE dvrp_color
	27
	28
	29	RECURSIVE SUBROUTINE data_output_dvrp
	30
	31	!------------------------------------------------------------------------------!
[254]	32	! Current revisions:
[1]	33	! -----------------
[829]	34	!
[1]	35	!
	36	! Former revisions:
	37	! -----------------
[3]	38	! $Id: data_output_dvrp.f90 829 2012-02-21 12:24:53Z raasch $
[77]	39	!
[829]	40	! 828 2012-02-21 12:00:36Z raasch
	41	! particle feature color renamed class
	42	!
[392]	43	! 287 2009-04-09 08:59:36Z raasch
	44	! Clipping of dvr-output implemented, using a default colourtable for
	45	! particles,
	46	! output of messages replaced by message handling routine.
	47	!
[226]	48	! 210 2008-11-06 08:54:02Z raasch
	49	! DVRP arguments changed to single precision, mode pathlines added
	50	!
[139]	51	! 130 2007-11-13 14:08:40Z letzel
	52	! allow two instead of one digit to specify isosurface and slicer variables
	53	! for unknown variables (CASE DEFAULT) call new subroutine
	54	! user_data_output_dvrp
	55	!
[83]	56	! 82 2007-04-16 15:40:52Z raasch
	57	! Preprocessor strings for different linux clusters changed to "lc",
	58	! routine local_flush is used for buffer flushing
	59	!
[77]	60	! 75 2007-03-22 09:54:05Z raasch
	61	! Particles-package is now part of the default code,
	62	! moisture renamed humidity
	63	!
[3]	64	! RCS Log replace by Id keyword, revision history cleaned up
	65	!
[1]	66	! Revision 1.13 2006/02/23 10:25:12 raasch
	67	! Former routine plot_dvrp renamed data_output_dvrp,
	68	! Only a fraction of the particles may have a tail,
	69	! pl.. replaced by do.., %size renamed %dvrp_psize
	70	!
	71	! Revision 1.1 2000/04/27 06:27:17 raasch
	72	! Initial revision
	73	!
	74	!
	75	! Description:
	76	! ------------
	77	! Plot of isosurface, particles and slicers with dvrp-software
	78	!------------------------------------------------------------------------------!
	79	#if defined( __dvrp_graphics )
	80
	81	USE arrays_3d
	82	USE cloud_parameters
[210]	83	USE constants
[246]	84	USE control_parameters
[1]	85	USE cpulog
	86	USE DVRP
	87	USE dvrp_color
	88	USE dvrp_variables
	89	USE grid_variables
	90	USE indices
	91	USE interfaces
	92	USE particle_attributes
	93	USE pegrid
	94
	95	IMPLICIT NONE
	96
	97	CHARACTER (LEN=2) :: section_chr
	98	CHARACTER (LEN=6) :: output_variable
[242]	99	INTEGER :: c_mode, c_size_x, c_size_y, c_size_z, dvrp_nop, dvrp_not, &
[287]	100	gradient_normals, i, ip, j, jp, k, l, m, n, n_isosurface, &
[284]	101	n_slicer, nn, section_mode, vn
[1]	102	INTEGER, DIMENSION(:), ALLOCATABLE :: p_c, p_t
[242]	103
	104	LOGICAL, DIMENSION(:), ALLOCATABLE :: dvrp_mask
	105
[287]	106	REAL(4) :: slicer_position, tmp_alpha, tmp_alpha_w, tmp_b, tmp_c_alpha, &
	107	tmp_g, tmp_norm, tmp_pos, tmp_r, tmp_t, tmp_th
[210]	108	REAL(4), DIMENSION(:), ALLOCATABLE :: psize, p_x, p_y, p_z
	109	REAL(4), DIMENSION(:,:,:), ALLOCATABLE :: local_pf
	110	REAL(4), DIMENSION(:,:,:,:), ALLOCATABLE :: local_pfi
[1]	111
	112
	113	CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
	114
	115	!
	116	!-- Loop over all output modes choosed
[284]	117	m = 1
	118	n_isosurface = 0 ! isosurface counter (for threshold values and color)
	119	n_slicer = 0 ! slice plane counter (for range of values)
[1]	120	DO WHILE ( mode_dvrp(m) /= ' ' )
	121	!
	122	!-- Update of the steering variables
	123	IF ( .NOT. lock_steering_update ) THEN
	124	!
	125	!-- Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
	126	lock_steering_update = .TRUE.
[210]	127	! CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
[1]	128	lock_steering_update = .FALSE.
	129	ENDIF
	130
	131	!
	132	!-- Determine the variable which shall be plotted (in case of slicers or
	133	!-- isosurfaces)
	134	IF ( mode_dvrp(m)(1:10) == 'isosurface' ) THEN
[130]	135	READ ( mode_dvrp(m), '(10X,I2)' ) vn
[1]	136	output_variable = do3d(0,vn)
[284]	137	n_isosurface = n_isosurface + 1
[1]	138	ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' ) THEN
[130]	139	READ ( mode_dvrp(m), '(6X,I2)' ) vn
[1]	140	output_variable = do2d(0,vn)
	141	l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
	142	section_chr = do2d(0,vn)(l-1:l)
	143	SELECT CASE ( section_chr )
	144	CASE ( 'xy' )
	145	section_mode = 2
	146	slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
	147	CASE ( 'xz' )
	148	section_mode = 1
	149	slicer_position = slicer_position_dvrp(m) * dy
	150	CASE ( 'yz' )
	151	section_mode = 0
	152	slicer_position = slicer_position_dvrp(m) * dx
	153	END SELECT
	154	ENDIF
	155
	156	!
	157	!-- Select the plot mode (in case of isosurface or slicer only if user has
	158	!-- defined a variable which shall be plotted; otherwise do nothing)
[86]	159	IF ( mode_dvrp(m)(1:9) == 'particles' .AND. particle_advection .AND. &
	160	simulated_time >= particle_advection_start ) THEN
[1]	161	!
	162	!-- DVRP-Calls for plotting particles:
	163	CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
	164
	165	!
	166	!-- Definition of characteristics of particle material
[210]	167	! tmp_r = 0.1; tmp_g = 0.7; tmp_b = 0.1; tmp_t = 0.0
	168	tmp_r = 0.0; tmp_g = 0.0; tmp_b = 0.0; tmp_t = 0.0
	169	CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
[1]	170
	171	!
[242]	172	!-- If clipping is active and if this subdomain is clipped, find out the
	173	!-- number of particles and tails to be plotted; otherwise, all
[246]	174	!-- particles/tails are plotted. dvrp_mask is used to mark the partikles.
[264]	175	ALLOCATE( dvrp_mask(number_of_particles) )
	176
[242]	177	IF ( dvrp_total_overlap ) THEN
[264]	178	dvrp_mask = .TRUE.
	179	dvrp_nop = number_of_particles
	180	dvrp_not = number_of_tails
[242]	181	ELSE
[264]	182	dvrp_mask = .FALSE.
	183	dvrp_nop = 0
	184	dvrp_not = 0
[242]	185	IF ( dvrp_overlap ) THEN
	186	IF ( .NOT. use_particle_tails ) THEN
	187	DO n = 1, number_of_particles
	188	ip = particles(n)%x / dx
	189	jp = particles(n)%y / dy
	190	IF ( ip >= nxl_dvrp .AND. ip <= nxr_dvrp .AND. &
	191	jp >= nys_dvrp .AND. jp <= nyn_dvrp ) THEN
	192	dvrp_nop = dvrp_nop + 1
[264]	193	dvrp_mask(n) = .TRUE.
[242]	194	ENDIF
	195	ENDDO
	196	ELSE
	197	k = 0
	198	DO n = 1, number_of_particles
	199	IF ( particles(n)%tail_id /= 0 ) THEN
	200	k = k + 1
	201	ip = particles(n)%x / dx
	202	jp = particles(n)%y / dy
	203	IF ( ip >= nxl_dvrp .AND. ip <= nxr_dvrp .AND. &
	204	jp >= nys_dvrp .AND. jp <= nyn_dvrp ) THEN
	205	dvrp_not = dvrp_not + 1
[264]	206	dvrp_mask(n) = .TRUE.
[242]	207	ENDIF
	208	ENDIF
	209	ENDDO
	210	ENDIF
	211	ENDIF
	212	ENDIF
	213
	214	!
[1]	215	!-- Move particle coordinates to one-dimensional arrays
	216	IF ( .NOT. use_particle_tails ) THEN
	217	!
	218	!-- All particles are output
[242]	219	ALLOCATE( psize(dvrp_nop), p_t(dvrp_nop), p_c(dvrp_nop), &
	220	p_x(dvrp_nop), p_y(dvrp_nop), p_z(dvrp_nop) )
[1]	221	psize = 0.0; p_t = 0; p_c = 0.0; p_x = 0.0; p_y = 0.0
[242]	222	p_z = 0.0
	223	k = 0
	224	DO n = 1, number_of_particles
	225	IF ( dvrp_mask(n) ) THEN
	226	k = k + 1
	227	psize(k) = particles(n)%dvrp_psize
	228	p_x(k) = particles(n)%x * superelevation_x
	229	p_y(k) = particles(n)%y * superelevation_y
	230	p_z(k) = particles(n)%z * superelevation
[828]	231	p_c(k) = particles(n)%class
[242]	232	ENDIF
	233	ENDDO
[1]	234	ELSE
	235	!
	236	!-- Particles have a tail
[242]	237	ALLOCATE( psize(dvrp_not), p_t(dvrp_not), &
	238	p_c(dvrp_not*maximum_number_of_tailpoints), &
	239	p_x(dvrp_not*maximum_number_of_tailpoints), &
	240	p_y(dvrp_not*maximum_number_of_tailpoints), &
	241	p_z(dvrp_not*maximum_number_of_tailpoints) )
[1]	242	psize = 0.0; p_t = 0; p_c = 0.0; p_x = 0.0; p_y = 0.0
	243	p_z = 0.0;
	244	i = 0
	245	k = 0
[264]	246
[1]	247	DO n = 1, number_of_particles
	248	nn = particles(n)%tail_id
[242]	249	IF ( nn /= 0 .AND. dvrp_mask(n) ) THEN
[1]	250	k = k + 1
	251	DO j = 1, particles(n)%tailpoints
	252	i = i + 1
	253	p_x(i) = particle_tail_coordinates(j,1,nn) * &
	254	superelevation_x
	255	p_y(i) = particle_tail_coordinates(j,2,nn) * &
	256	superelevation_y
	257	p_z(i) = particle_tail_coordinates(j,3,nn) * &
	258	superelevation
	259	p_c(i) = particle_tail_coordinates(j,4,nn)
	260	ENDDO
	261	psize(k) = particles(n)%dvrp_psize
	262	p_t(k) = particles(n)%tailpoints - 1
	263	ENDIF
	264	ENDDO
	265	ENDIF
	266
	267	!
	268	!-- Compute and plot particles in dvr-format
	269	IF ( uniform_particles .AND. .NOT. use_particle_tails ) THEN
	270	!
	271	!-- All particles have the same color. Use simple routine to set
	272	!-- the particle attributes (produces less output data)
	273	CALL DVRP_PARTICLES( m-1, p_x, p_y, p_z, psize )
	274	ELSE
	275	!
	276	!-- Set color definitions
	277	CALL user_dvrp_coltab( 'particles', 'none' )
	278
[264]	279	CALL DVRP_COLORTABLE_HLS( m-1, 0, interval_values_dvrp_prt, &
	280	interval_h_dvrp_prt, &
	281	interval_l_dvrp_prt, &
	282	interval_s_dvrp_prt, &
	283	interval_a_dvrp_prt )
[1]	284
	285	IF ( .NOT. use_particle_tails ) THEN
[242]	286	CALL DVRP_PARTICLES( m-1, dvrp_nop, p_x, p_y, p_z, 3, psize, &
	287	p_c, p_t )
[1]	288	ELSE
[242]	289	CALL DVRP_PARTICLES( m-1, dvrp_not, p_x, p_y, p_z, 15, psize, &
	290	p_c, p_t )
[1]	291	ENDIF
	292	ENDIF
	293
	294	CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
	295
[242]	296	DEALLOCATE( dvrp_mask, psize, p_c, p_t, p_x, p_y, p_z )
[1]	297
	298	CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
	299
	300
	301	ELSEIF ( ( mode_dvrp(m)(1:10) == 'isosurface' .OR. &
	302	mode_dvrp(m)(1:6) == 'slicer' ) &
	303	.AND. output_variable /= ' ' ) THEN
	304
	305	!
	306	!-- Create an intermediate array, properly dimensioned for plot-output
[246]	307	ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
	308	nzb:nz_do3d) )
[1]	309
	310	!
	311	!-- Move original array to intermediate array
[246]	312	IF ( dvrp_overlap ) THEN
[1]	313
[246]	314	SELECT CASE ( output_variable )
	315
	316	CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
	317	DO i = nxl_dvrp, nxr_dvrp+1
	318	DO j = nys_dvrp, nyn_dvrp+1
	319	DO k = nzb, nz_do3d
	320	local_pf(i,j,k) = u(k,j,i)
	321	ENDDO
[1]	322	ENDDO
	323	ENDDO
	324	!
[246]	325	!-- Replace mirrored values at lower surface by real surface
	326	!-- values
	327	IF ( output_variable == 'u_xz' .OR. &
	328	output_variable == 'u_yz' ) THEN
	329	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
	330	ENDIF
[1]	331
	332
[246]	333	CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
	334	DO i = nxl_dvrp, nxr_dvrp+1
	335	DO j = nys_dvrp, nyn_dvrp+1
	336	DO k = nzb, nz_do3d
	337	local_pf(i,j,k) = v(k,j,i)
	338	ENDDO
[1]	339	ENDDO
	340	ENDDO
	341	!
[246]	342	!-- Replace mirrored values at lower surface by real surface
	343	!-- values
	344	IF ( output_variable == 'v_xz' .OR. &
	345	output_variable == 'v_yz' ) THEN
	346	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
	347	ENDIF
[1]	348
[246]	349	CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
	350	DO i = nxl_dvrp, nxr_dvrp+1
	351	DO j = nys_dvrp, nyn_dvrp+1
	352	DO k = nzb, nz_do3d
	353	local_pf(i,j,k) = w(k,j,i)
	354	ENDDO
[1]	355	ENDDO
	356	ENDDO
[106]	357	! Averaging for Langmuir circulation
[246]	358	! DO k = nzb, nz_do3d
	359	! DO j = nys_dvrp+1, nyn_dvrp
	360	! DO i = nxl_dvrp, nxr_dvrp+1
	361	! local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
	362	! 0.50 * local_pf(i,j,k) + &
	363	! 0.25 * local_pf(i,j+1,k)
	364	! ENDDO
[106]	365	! ENDDO
	366	! ENDDO
[1]	367
[246]	368	CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
	369	DO i = nxl_dvrp, nxr_dvrp+1
	370	DO j = nys_dvrp, nyn_dvrp+1
	371	DO k = nzb, nz_do3d
	372	local_pf(i,j,k) = p(k,j,i)
	373	ENDDO
[1]	374	ENDDO
	375	ENDDO
	376
[246]	377	CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
	378	IF ( .NOT. cloud_physics ) THEN
	379	DO i = nxl_dvrp, nxr_dvrp+1
	380	DO j = nys_dvrp, nyn_dvrp+1
	381	DO k = nzb, nz_do3d
	382	local_pf(i,j,k) = pt(k,j,i)
	383	ENDDO
[1]	384	ENDDO
	385	ENDDO
[246]	386	ELSE
	387	DO i = nxl_dvrp, nxr_dvrp+1
	388	DO j = nys_dvrp, nyn_dvrp+1
	389	DO k = nzb, nz_do3d
	390	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
	391	pt_d_t(k) * ql(k,j,i)
	392	ENDDO
[1]	393	ENDDO
	394	ENDDO
[246]	395	ENDIF
[1]	396
[246]	397	CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
	398	IF ( humidity .OR. passive_scalar ) THEN
	399	DO i = nxl_dvrp, nxr_dvrp+1
	400	DO j = nys_dvrp, nyn_dvrp+1
	401	DO k = nzb, nz_do3d
	402	local_pf(i,j,k) = q(k,j,i)
	403	ENDDO
[1]	404	ENDDO
[246]	405	ENDDO
[254]	406	ELSE
[274]	407	message_string = 'if humidity/passive_scalar = ' // &
	408	'FALSE output of ' // TRIM( output_variable ) // &
	409	'is not provided'
	410	CALL message( 'data_output_dvrp', 'PA0183',&
	411	0, 0, 0, 6, 0 )
[1]	412	ENDIF
	413
[246]	414	CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
	415	IF ( cloud_physics .OR. cloud_droplets ) THEN
	416	DO i = nxl_dvrp, nxr_dvrp+1
	417	DO j = nys_dvrp, nyn_dvrp+1
	418	DO k = nzb, nz_do3d
	419	local_pf(i,j,k) = ql(k,j,i)
	420	ENDDO
[1]	421	ENDDO
	422	ENDDO
[254]	423	ELSE
[274]	424	message_string = 'if cloud_physics = FALSE ' // &
	425	'output of ' // TRIM( output_variable) // &
	426	'is not provided'
	427	CALL message( 'data_output_dvrp', 'PA0184',&
	428	0, 0, 0, 6, 0 )
[1]	429	ENDIF
	430
[246]	431	CASE ( 'u*_xy' )
	432	DO i = nxl_dvrp, nxr_dvrp+1
	433	DO j = nys_dvrp, nyn_dvrp+1
	434	local_pf(i,j,nzb+1) = us(j,i)
	435	ENDDO
[1]	436	ENDDO
[246]	437	slicer_position = zu(nzb+1)
[1]	438
[246]	439	CASE ( 't*_xy' )
	440	DO i = nxl_dvrp, nxr_dvrp+1
	441	DO j = nys_dvrp, nyn_dvrp+1
	442	local_pf(i,j,nzb+1) = ts(j,i)
	443	ENDDO
[1]	444	ENDDO
[246]	445	slicer_position = zu(nzb+1)
[1]	446
	447
[246]	448	CASE DEFAULT
[130]	449	!
[246]	450	!-- The DEFAULT case is reached either if output_variable
	451	!-- contains unsupported variable or if the user has coded a
	452	!-- special case in the user interface. There, the subroutine
	453	!-- user_data_output_dvrp checks which of these two conditions
	454	!-- applies.
	455	CALL user_data_output_dvrp( output_variable, local_pf )
[1]	456
[130]	457
[246]	458	END SELECT
[1]	459
[264]	460	ELSE
	461	!
	462	!-- No overlap of clipping domain with the current subdomain
	463	DO i = nxl_dvrp, nxr_dvrp+1
	464	DO j = nys_dvrp, nyn_dvrp+1
	465	DO k = nzb, nz_do3d
	466	local_pf(i,j,k) = 0.0
	467	ENDDO
	468	ENDDO
	469	ENDDO
	470
[246]	471	ENDIF
[1]	472
	473	IF ( mode_dvrp(m)(1:10) == 'isosurface' ) THEN
[392]	474
[1]	475	!
	476	!-- DVRP-Calls for plotting isosurfaces:
	477	CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
	478
	479	!
[284]	480	!-- Definition of isosurface color
	481	tmp_r = isosurface_color(1,n_isosurface)
	482	tmp_g = isosurface_color(2,n_isosurface)
	483	tmp_b = isosurface_color(3,n_isosurface)
	484	tmp_t = 0.0
	485	CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
[1]	486
	487	!
	488	!-- Compute and plot isosurface in dvr-format
	489	CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
	490	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
[210]	491
	492	c_size_x = vc_size_x; c_size_y = vc_size_y; c_size_z = vc_size_z
	493	CALL DVRP_CLUSTER_SIZE( m-1, c_size_x, c_size_y, c_size_z )
	494
	495	c_mode = vc_mode
	496	CALL DVRP_CLUSTERING_MODE( m-1, c_mode )
	497
	498	gradient_normals = vc_gradient_normals
	499	CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
[392]	500
[210]	501	!
	502	!-- A seperate procedure for setting vc_alpha will be in the next
	503	!-- version of libDVRP
	504	tmp_c_alpha = vc_alpha
	505	CALL DVRP_THRESHOLD( -(m-1)-1, tmp_c_alpha )
	506
[246]	507	IF ( dvrp_overlap ) THEN
[284]	508	tmp_th = threshold(n_isosurface)
[246]	509	ELSE
	510	tmp_th = 1.0 ! nothing is plotted because array values are 0
	511	ENDIF
	512
[210]	513	CALL DVRP_THRESHOLD( m-1, tmp_th )
[392]	514
[210]	515	CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
	516
[1]	517	CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
	518
	519	ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' ) THEN
[392]	520
[1]	521	!
	522	!-- DVRP-Calls for plotting slicers:
	523	CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
	524
	525	!
	526	!-- Material and color definitions
[210]	527	tmp_r = 0.0; tmp_g = 0.0; tmp_b = 0.0; tmp_t = 0.0
	528	CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
[1]	529
[284]	530	n_slicer = n_slicer + 1
	531
	532	!
	533	!-- Using dolorfunction has not been properly tested
	534	! islice_dvrp = n_slicer
	535	! CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25, &
	536	! slicer_range_limits_dvrp(:,n_slicer), &
[1]	537	! color_dvrp )
	538
[284]	539	!
	540	!-- Set interval of values defining the colortable
	541	CALL set_slicer_attributes_dvrp( n_slicer )
	542
	543	!
	544	!-- Create user-defined colortable
[1]	545	CALL user_dvrp_coltab( 'slicer', output_variable )
	546
	547	CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp, &
	548	interval_h_dvrp, interval_l_dvrp, &
	549	interval_s_dvrp, interval_a_dvrp )
	550
	551	!
	552	!-- Compute and plot slicer in dvr-format
	553	CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
	554	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
[262]	555	tmp_pos = slicer_position
	556	CALL DVRP_SLICER( m-1, section_mode, tmp_pos )
[106]	557
[1]	558	CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
	559
	560	CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
	561
	562	ENDIF
	563
	564	DEALLOCATE( local_pf )
	565
[210]	566	ELSEIF ( mode_dvrp(m)(1:9) == 'pathlines' ) THEN
	567
	568	ALLOCATE( local_pfi(4,nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
	569	DO i = nxl, nxr+1
	570	DO j = nys, nyn+1
	571	DO k = nzb, nz_do3d
	572	local_pfi(1,i,j,k) = u(k,j,i)
	573	local_pfi(2,i,j,k) = v(k,j,i)
	574	local_pfi(3,i,j,k) = w(k,j,i)
	575	tmp_norm = SQRT( u(k,j,i) * u(k,j,i) + &
	576	v(k,j,i) * v(k,j,i) + &
	577	w(k,j,i) * w(k,j,i) )
	578	tmp_alpha = ACOS( 0.0 * u(k,j,i) / tmp_norm + &
	579	0.0 * v(k,j,i) / tmp_norm - &
	580	1.0 * w(k,j,i) / tmp_norm )
	581	tmp_alpha_w = tmp_alpha / pi * 180.0
	582	local_pfi(4,i,j,k) = tmp_alpha_w
	583	ENDDO
	584	ENDDO
	585	ENDDO
	586
	587	CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'start' )
	588
	589	CALL DVRP_DATA( m-1, local_pfi, 4, nx_dvrp, ny_dvrp, nz_dvrp, &
	590	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
	591	CALL DVRP_VISUALIZE( m-1, 20, dvrp_filecount )
	592
	593	CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'stop' )
	594
	595	DEALLOCATE( local_pfi )
	596
[1]	597	ENDIF
	598
	599	m = m + 1
	600
	601	ENDDO
	602
	603	dvrp_filecount = dvrp_filecount + 1
	604
	605	CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
	606
	607	#endif
	608	END SUBROUTINE data_output_dvrp

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |