Home

Context Navigation

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

Last change on this file since 1 was 1, checked in by raasch, 18 years ago
Initial repository layout and content
File size: 18.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	!------------------------------------------------------------------------------!
	32	! Actual revisions:
	33	! -----------------
	34	!
	35	! TEST: write statements
	36	!
	37	! Former revisions:
	38	! -----------------
	39	! $Log: data_output_dvrp.f90,v $
	40	! Revision 1.13 2006/02/23 10:25:12 raasch
	41	! Former routine plot_dvrp renamed data_output_dvrp,
	42	! Only a fraction of the particles may have a tail,
	43	! pl.. replaced by do.., %size renamed %dvrp_psize
	44	!
	45	! Revision 1.12 2005/03/31 07:00:46 raasch
	46	! Testversion with print statements checked in
	47	!
	48	! Revision 1.11 2003/08/01 08:44:50 raasch
	49	! Routine defined as recursive, because it is called from DVRP_STEERING_UPDATE
	50	! in case that the user has suspended the run by steering control.
	51	! Routine color_dvrp placed at the beginning of this file. This routine is used
	52	! for slicer colortable settings.
	53	!
	54	! Revision 1.10 2003/03/16 09:42:34 raasch
	55	! Two underscores (_) are placed in front of all define-strings
	56	!
	57	! Revision 1.9 2003/03/04 11:35:07 raasch
	58	! Update for new version of dvrp software (e.g. using module dvrp is now
	59	! mandatory)
	60	!
	61	! Revision 1.8 2001/11/09 13:41:21 raasch
	62	! Colour can change along the particle tails
	63	!
	64	! Revision 1.7 2001/08/21 09:55:20 raasch
	65	! Superelevation for particles implemented, plotting of particle tails added,
	66	! colourtable definitions moved to subroutine user_dvrp_coltab
	67	!
	68	! Revision 1.6 2001/07/12 12:44:12 raasch
	69	! Test: color definitions for particles changed
	70	!
	71	! Revision 1.5 2001/03/30 07:45:00 raasch
	72	! Translation of remaining German identifiers (variables, subroutines, etc.)
	73	!
	74	! Revision 1.4 2001/01/29 12:32:51 raasch
	75	! Passive scalar considered
	76	!
	77	! Revision 1.3 2001/01/22 07:41:12 raasch
	78	! Module test_variables removed
	79	!
	80	! Revision 1.2 2000/12/28 13:37:19 raasch
	81	! Total revision due to new features of dvrp-software,
	82	! plot of slicers included,
	83	! code is used only optionally (cpp-directives are added)
	84	!
	85	! Revision 1.1 2000/04/27 06:27:17 raasch
	86	! Initial revision
	87	!
	88	!
	89	! Description:
	90	! ------------
	91	! Plot of isosurface, particles and slicers with dvrp-software
	92	!------------------------------------------------------------------------------!
	93	#if defined( __dvrp_graphics )
	94
	95	USE arrays_3d
	96	USE cloud_parameters
	97	USE cpulog
	98	USE DVRP
	99	USE dvrp_color
	100	USE dvrp_variables
	101	USE grid_variables
	102	USE indices
	103	USE interfaces
	104	USE particle_attributes
	105	USE pegrid
	106	USE control_parameters
	107
	108	IMPLICIT NONE
	109
	110	CHARACTER (LEN=2) :: section_chr
	111	CHARACTER (LEN=6) :: output_variable
	112	INTEGER :: i, j, k, l, m, n, nn, section_mode, tv, vn
	113	INTEGER, DIMENSION(:), ALLOCATABLE :: p_c, p_t
	114	REAL :: center(3), distance, slicer_position, surface_value
	115	REAL, DIMENSION(:), ALLOCATABLE :: psize, p_x, p_y, p_z
	116	REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
	117
	118
	119	WRITE ( 9, * ) '*** myid=', myid, ' Anfang data_output_dvrp'
	120	CALL FLUSH_( 9 )
	121	CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
	122
	123	!
	124	!-- Loop over all output modes choosed
	125	m = 1
	126	tv = 0 ! threshold counter
	127	islice_dvrp = 0 ! slice plane counter
	128	DO WHILE ( mode_dvrp(m) /= ' ' )
	129	!
	130	!-- Update of the steering variables
	131	IF ( .NOT. lock_steering_update ) THEN
	132	!
	133	!-- Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
	134	lock_steering_update = .TRUE.
	135	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: vor steering_update'
	136	CALL FLUSH_( 9 )
	137	CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
	138	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: nach steering_update'
	139	CALL FLUSH_( 9 )
	140	lock_steering_update = .FALSE.
	141	ENDIF
	142
	143	!
	144	!-- Determine the variable which shall be plotted (in case of slicers or
	145	!-- isosurfaces)
	146	IF ( mode_dvrp(m)(1:10) == 'isosurface' ) THEN
	147	READ ( mode_dvrp(m), '(10X,I1)' ) vn
	148	output_variable = do3d(0,vn)
	149	tv = tv + 1
	150	ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' ) THEN
	151	READ ( mode_dvrp(m), '(6X,I1)' ) vn
	152	output_variable = do2d(0,vn)
	153	l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
	154	section_chr = do2d(0,vn)(l-1:l)
	155	SELECT CASE ( section_chr )
	156	CASE ( 'xy' )
	157	section_mode = 2
	158	slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
	159	CASE ( 'xz' )
	160	section_mode = 1
	161	slicer_position = slicer_position_dvrp(m) * dy
	162	CASE ( 'yz' )
	163	section_mode = 0
	164	slicer_position = slicer_position_dvrp(m) * dx
	165	END SELECT
	166	ENDIF
	167
	168	!
	169	!-- Select the plot mode (in case of isosurface or slicer only if user has
	170	!-- defined a variable which shall be plotted; otherwise do nothing)
	171	IF ( mode_dvrp(m)(1:9) == 'particles' ) THEN
	172
	173	#if defined( __particles )
	174	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang particles'
	175	CALL FLUSH_( 9 )
	176	!
	177	!-- DVRP-Calls for plotting particles:
	178	CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
	179
	180	!
	181	!-- Definition of characteristics of particle material
	182	CALL DVRP_MATERIAL_RGB( m-1, 1, 0.1, 0.7, 0.1, 0.0 )
	183
	184	!
	185	!-- Move particle coordinates to one-dimensional arrays
	186	IF ( .NOT. use_particle_tails ) THEN
	187	!
	188	!-- All particles are output
	189	ALLOCATE( psize(number_of_particles), p_t(number_of_particles), &
	190	p_c(number_of_particles), p_x(number_of_particles), &
	191	p_y(number_of_particles), p_z(number_of_particles) )
	192	psize = 0.0; p_t = 0; p_c = 0.0; p_x = 0.0; p_y = 0.0
	193	p_z = 0.0;
	194	psize = particles(1:number_of_particles)%dvrp_psize
	195	p_x = particles(1:number_of_particles)%x * superelevation_x
	196	p_y = particles(1:number_of_particles)%y * superelevation_y
	197	p_z = particles(1:number_of_particles)%z * superelevation
	198	p_c = particles(1:number_of_particles)%color
	199	ELSE
	200	!
	201	!-- Particles have a tail
	202	WRITE (9,*) '--- before ALLOCATE simtime=',simulated_time,' #of_tails=', number_of_tails, &
	203	' max#of_tp=', maximum_number_of_tailpoints
	204	CALL FLUSH_( 9 )
	205	ALLOCATE( psize(number_of_tails), p_t(number_of_tails), &
	206	p_c(number_of_tails*maximum_number_of_tailpoints), &
	207	p_x(number_of_tails*maximum_number_of_tailpoints), &
	208	p_y(number_of_tails*maximum_number_of_tailpoints), &
	209	p_z(number_of_tails*maximum_number_of_tailpoints) )
	210	WRITE (9,*) '--- after ALLOCATE'
	211	CALL FLUSH_( 9 )
	212	psize = 0.0; p_t = 0; p_c = 0.0; p_x = 0.0; p_y = 0.0
	213	p_z = 0.0;
	214	i = 0
	215	k = 0
	216	DO n = 1, number_of_particles
	217	nn = particles(n)%tail_id
	218	IF ( nn /= 0 ) THEN
	219	k = k + 1
	220	IF ( simulated_time > 1338.0 ) THEN
	221	WRITE (9,*) '--- particle ',n,' tail_id=',nn,' #of_tp=',particles(n)%tailpoints
	222	CALL FLUSH_( 9 )
	223	ENDIF
	224	DO j = 1, particles(n)%tailpoints
	225	i = i + 1
	226	p_x(i) = particle_tail_coordinates(j,1,nn) * &
	227	superelevation_x
	228	p_y(i) = particle_tail_coordinates(j,2,nn) * &
	229	superelevation_y
	230	p_z(i) = particle_tail_coordinates(j,3,nn) * &
	231	superelevation
	232	p_c(i) = particle_tail_coordinates(j,4,nn)
	233	IF ( simulated_time > 1338.0 ) THEN
	234	WRITE (9,*) '--- tp= ',i,' x=',p_x(i),' y=',p_y(i), &
	235	' z=',p_z(i),' c=',p_c(i)
	236	CALL FLUSH_( 9 )
	237	ENDIF
	238	ENDDO
	239	psize(k) = particles(n)%dvrp_psize
	240	p_t(k) = particles(n)%tailpoints - 1
	241	IF ( simulated_time > 1338.0 ) THEN
	242	WRITE (9,*) '--- t= ',k,' psize=',psize(k),' p_t=',p_t(k)
	243	CALL FLUSH_( 9 )
	244	ENDIF
	245	ENDIF
	246	ENDDO
	247	WRITE (9,*) '--- after locally storing the particle attributes'
	248	CALL FLUSH_( 9 )
	249	ENDIF
	250
	251	!
	252	!-- Compute and plot particles in dvr-format
	253	IF ( uniform_particles .AND. .NOT. use_particle_tails ) THEN
	254	!
	255	!-- All particles have the same color. Use simple routine to set
	256	!-- the particle attributes (produces less output data)
	257	CALL DVRP_PARTICLES( m-1, p_x, p_y, p_z, psize )
	258	ELSE
	259	!
	260	!-- Set color definitions
	261	CALL user_dvrp_coltab( 'particles', 'none' )
	262
	263	CALL DVRP_COLORTABLE_HLS( m-1, 0, interval_values_dvrp, &
	264	interval_h_dvrp, interval_l_dvrp, &
	265	interval_s_dvrp, interval_a_dvrp )
	266
	267	IF ( .NOT. use_particle_tails ) THEN
	268	CALL DVRP_PARTICLES( m-1, number_of_particles, p_x, p_y, p_z, &
	269	3, psize, p_c, p_t )
	270	ELSE
	271	WRITE (9,*) '--- before DVRP_PARTICLES'
	272	CALL FLUSH_( 9 )
	273	CALL DVRP_PARTICLES( m-1, number_of_tails, p_x, p_y, p_z, 15, &
	274	psize, p_c, p_t )
	275	WRITE (9,*) '--- after DVRP_PARTICLES'
	276	CALL FLUSH_( 9 )
	277	ENDIF
	278	ENDIF
	279
	280	CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
	281	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende particles'
	282	CALL FLUSH_( 9 )
	283
	284	DEALLOCATE( psize, p_c, p_t, p_x, p_y, p_z )
	285
	286	CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
	287	#endif
	288
	289
	290	ELSEIF ( ( mode_dvrp(m)(1:10) == 'isosurface' .OR. &
	291	mode_dvrp(m)(1:6) == 'slicer' ) &
	292	.AND. output_variable /= ' ' ) THEN
	293
	294	!
	295	!-- Create an intermediate array, properly dimensioned for plot-output
	296	ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
	297
	298	!
	299	!-- Move original array to intermediate array
	300	SELECT CASE ( output_variable )
	301
	302	CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
	303	DO i = nxl, nxr+1
	304	DO j = nys, nyn+1
	305	DO k = nzb, nz_do3d
	306	local_pf(i,j,k) = u(k,j,i)
	307	ENDDO
	308	ENDDO
	309	ENDDO
	310	!
	311	!-- Replace mirrored values at lower surface by real surface values
	312	IF ( output_variable == 'u_xz' .OR. &
	313	output_variable == 'u_yz' ) THEN
	314	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
	315	ENDIF
	316
	317
	318	CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
	319	DO i = nxl, nxr+1
	320	DO j = nys, nyn+1
	321	DO k = nzb, nz_do3d
	322	local_pf(i,j,k) = v(k,j,i)
	323	ENDDO
	324	ENDDO
	325	ENDDO
	326	!
	327	!-- Replace mirrored values at lower surface by real surface values
	328	IF ( output_variable == 'v_xz' .OR. &
	329	output_variable == 'v_yz' ) THEN
	330	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
	331	ENDIF
	332
	333	CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
	334	DO i = nxl, nxr+1
	335	DO j = nys, nyn+1
	336	DO k = nzb, nz_do3d
	337	local_pf(i,j,k) = w(k,j,i)
	338	ENDDO
	339	ENDDO
	340	ENDDO
	341
	342	CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
	343	DO i = nxl, nxr+1
	344	DO j = nys, nyn+1
	345	DO k = nzb, nz_do3d
	346	local_pf(i,j,k) = p(k,j,i)
	347	ENDDO
	348	ENDDO
	349	ENDDO
	350
	351	CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
	352	IF ( .NOT. cloud_physics ) THEN
	353	DO i = nxl, nxr+1
	354	DO j = nys, nyn+1
	355	DO k = nzb, nz_do3d
	356	local_pf(i,j,k) = pt(k,j,i)
	357	ENDDO
	358	ENDDO
	359	ENDDO
	360	ELSE
	361	DO i = nxl, nxr+1
	362	DO j = nys, nyn+1
	363	DO k = nzb, nz_do3d
	364	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * pt_d_t(k) * &
	365	ql(k,j,i)
	366	ENDDO
	367	ENDDO
	368	ENDDO
	369	ENDIF
	370
	371	CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
	372	IF ( moisture .OR. passive_scalar ) THEN
	373	DO i = nxl, nxr+1
	374	DO j = nys, nyn+1
	375	DO k = nzb, nz_do3d
	376	local_pf(i,j,k) = q(k,j,i)
	377	ENDDO
	378	ENDDO
	379	ENDDO
	380	ELSE
	381	IF ( myid == 0 ) THEN
	382	PRINT*, '+++ data_output_dvrp: if moisture/passive_scalar = ', &
	383	'FALSE output of ', output_variable, &
	384	'is not provided'
	385	ENDIF
	386	ENDIF
	387
	388	CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
	389	IF ( cloud_physics .OR. cloud_droplets ) THEN
	390	DO i = nxl, nxr+1
	391	DO j = nys, nyn+1
	392	DO k = nzb, nz_do3d
	393	local_pf(i,j,k) = ql(k,j,i)
	394	ENDDO
	395	ENDDO
	396	ENDDO
	397	ELSE
	398	IF ( myid == 0 ) THEN
	399	PRINT*, '+++ data_output_dvrp: if cloud_physics = FALSE ', &
	400	'output of ', output_variable, 'is not provided'
	401	ENDIF
	402	ENDIF
	403
	404	CASE ( 'u*_xy' )
	405	DO i = nxl, nxr+1
	406	DO j = nys, nyn+1
	407	local_pf(i,j,nzb+1) = us(j,i)
	408	ENDDO
	409	ENDDO
	410	slicer_position = zu(nzb+1)
	411
	412	CASE ( 't*_xy' )
	413	DO i = nxl, nxr+1
	414	DO j = nys, nyn+1
	415	local_pf(i,j,nzb+1) = ts(j,i)
	416	ENDDO
	417	ENDDO
	418	slicer_position = zu(nzb+1)
	419
	420
	421	CASE DEFAULT
	422	IF ( myid == 0 ) THEN
	423	PRINT*,'+++ data_output_dvrp: no output possible for: ', &
	424	output_variable
	425	ENDIF
	426
	427	END SELECT
	428
	429
	430	IF ( mode_dvrp(m)(1:10) == 'isosurface' ) THEN
	431
	432	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang isosurface'
	433	CALL FLUSH_( 9 )
	434	!
	435	!-- DVRP-Calls for plotting isosurfaces:
	436	CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
	437
	438	!
	439	!-- Definition of characteristics of isosurface material
	440	!-- Preliminary settings for w!
	441	IF ( output_variable == 'w' ) THEN
	442	CALL DVRP_MATERIAL_RGB( m-1, 1, 0.3, 0.8, 0.3, 0.0 )
	443	ELSE
	444	CALL DVRP_MATERIAL_RGB( m-1, 1, 0.9, 0.9, 0.9, 0.0 )
	445	ENDIF
	446
	447	!
	448	!-- Compute and plot isosurface in dvr-format
	449	CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
	450	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
	451	CALL DVRP_THRESHOLD( m-1, threshold(tv) )
	452	CALL DVRP_VISUALIZE( m-1, 1, dvrp_filecount )
	453	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende isosurface'
	454	CALL FLUSH_( 9 )
	455
	456	CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
	457
	458	ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' ) THEN
	459
	460	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang slicer'
	461	CALL FLUSH_( 9 )
	462	!
	463	!-- DVRP-Calls for plotting slicers:
	464	CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
	465
	466	!
	467	!-- Material and color definitions
	468	CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.0, 0.0, 0.0 )
	469
	470	islice_dvrp = islice_dvrp + 1
	471	! CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25, &
	472	! slicer_range_limits_dvrp(:,islice_dvrp), &
	473	! color_dvrp )
	474
	475	CALL user_dvrp_coltab( 'slicer', output_variable )
	476
	477	CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp, &
	478	interval_h_dvrp, interval_l_dvrp, &
	479	interval_s_dvrp, interval_a_dvrp )
	480
	481	!
	482	!-- Compute and plot slicer in dvr-format
	483	CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
	484	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
	485	CALL DVRP_SLICER( m-1, section_mode, slicer_position )
	486	CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
	487
	488	CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
	489
	490	WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende slicer'
	491	CALL FLUSH_( 9 )
	492	ENDIF
	493
	494	DEALLOCATE( local_pf )
	495
	496	ENDIF
	497
	498	m = m + 1
	499
	500	ENDDO
	501
	502	dvrp_filecount = dvrp_filecount + 1
	503
	504	CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
	505	WRITE ( 9, * ) '*** myid=', myid, ' Ende data_output_dvrp'
	506	CALL FLUSH_( 9 )
	507
	508	#endif
	509	END SUBROUTINE data_output_dvrp

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |