Home

Context Navigation

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

Last change on this file since 2 was 1, checked in by raasch, 17 years ago
Initial repository layout and content
File size: 18.2 KB

Line
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 |