Home

Context Navigation

source: palm/trunk/SOURCE/init_dvrp.f90 @ 269

Last change on this file since 269 was 264, checked in by raasch, 16 years ago
new dvrp features added
Property svn:keywords set to `Id`
File size: 26.6 KB

Line
1	SUBROUTINE init_dvrp
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	! Definition of a colortable to be used for particles.
7	! Output names are changed: surface=groundplate, buildings=topography
8	! Output of messages replaced by message handling routine.
9	! Clipping implemented.
10	! Polygon reduction for building and ground plate isosurface. Reduction level
11	! for buildings can be chosen with parameter cluster_size.
12	! ToDo: checking of mode_dvrp for legal values is not correct
13	! Implementation of a MPI-1 coupling: __mpi2 adjustments for MPI_COMM_WORLD
14	!
15	! Former revisions:
16	! -----------------
17	! $Id: init_dvrp.f90 264 2009-03-21 08:14:44Z weinreis $
18	!
19	! 210 2008-11-06 08:54:02Z raasch
20	! DVRP arguments changed to single precision, mode pathlines added
21	!
22	! 155 2008-03-28 10:56:30Z letzel
23	! introduce prefix_chr to ensure unique dvrp_file path
24	!
25	! 130 2007-11-13 14:08:40Z letzel
26	! allow two instead of one digit to specify isosurface and slicer variables
27	! Test output of isosurface on camera file
28	!
29	! 82 2007-04-16 15:40:52Z raasch
30	! Preprocessor strings for different linux clusters changed to "lc",
31	! routine local_flush is used for buffer flushing
32	!
33	! 17 2007-02-19 01:57:39Z raasch
34	! dvrp_output_local activated for all streams
35	!
36	! 13 2007-02-14 12:15:07Z raasch
37	! RCS Log replace by Id keyword, revision history cleaned up
38	!
39	! Revision 1.12 2006/02/23 12:30:22 raasch
40	! ebene renamed section, pl.. replaced by do..,
41	!
42	! Revision 1.1 2000/04/27 06:24:39 raasch
43	! Initial revision
44	!
45	!
46	! Description:
47	! ------------
48	! Initializing actions needed when using dvrp-software
49	!------------------------------------------------------------------------------!
50	#if defined( __dvrp_graphics )
51
52	USE arrays_3d
53	USE DVRP
54	USE dvrp_variables
55	USE grid_variables
56	USE indices
57	USE pegrid
58	USE control_parameters
59
60	IMPLICIT NONE
61
62	CHARACTER (LEN=2) :: section_chr
63	CHARACTER (LEN=3) :: prefix_chr
64	CHARACTER (LEN=80) :: dvrp_file_local
65	INTEGER :: cluster_mode, cluster_size_x, cluster_size_y, cluster_size_z, &
66	gradient_normals, i, j, k, l, m, nx_dvrp_l, nx_dvrp_r, &
67	ny_dvrp_n, ny_dvrp_s, pn, tv, vn
68	LOGICAL :: allocated
69	REAL(4) :: center(3), cluster_alpha, distance, tmp_b, tmp_g, tmp_r, &
70	tmp_t, tmp_th, tmp_thr, tmp_x1, tmp_x2, tmp_y1, tmp_y2, &
71	tmp_z1, tmp_z2, tmp_1, tmp_2, tmp_3, tmp_4, tmp_5, tmp_6, tmp_7
72
73	REAL(4), DIMENSION(:,:,:), ALLOCATABLE :: local_pf
74
75	TYPE(CSTRING), SAVE :: dvrp_directory_c, dvrp_file_c, &
76	dvrp_file_local_c,dvrp_host_c, &
77	dvrp_password_c, dvrp_username_c, name_c
78
79	!
80	!-- Set clipping to default (total domain), if not set by user
81	IF ( clip_dvrp_l == 9999999.9 ) clip_dvrp_l = 0.0
82	IF ( clip_dvrp_r == 9999999.9 ) clip_dvrp_r = ( nx + 1 ) * dx
83	IF ( clip_dvrp_s == 9999999.9 ) clip_dvrp_s = 0.0
84	IF ( clip_dvrp_n == 9999999.9 ) clip_dvrp_n = ( ny + 1 ) * dy
85
86	!
87	!-- Calculate the clipping index limits
88	nx_dvrp_l = clip_dvrp_l / dx
89	nx_dvrp_r = clip_dvrp_r / dx
90	ny_dvrp_s = clip_dvrp_s / dy
91	ny_dvrp_n = clip_dvrp_n / dy
92
93	IF ( nx_dvrp_l < nxr .AND. nx_dvrp_r > nxl .AND. &
94	ny_dvrp_s < nyn .AND. ny_dvrp_n > nys ) THEN
95
96	dvrp_overlap = .TRUE.
97	nxl_dvrp = MAX( nxl, nx_dvrp_l )
98	nxr_dvrp = MIN( nxr, nx_dvrp_r )
99	nys_dvrp = MAX( nys, ny_dvrp_s )
100	nyn_dvrp = MIN( nyn, ny_dvrp_n )
101
102	IF ( nxl_dvrp == nxl .AND. nxr_dvrp == nxr .AND. &
103	nys_dvrp == nys .AND. nyn_dvrp == nyn ) THEN
104	dvrp_total_overlap = .TRUE.
105	ELSE
106	dvrp_total_overlap = .FALSE.
107	ENDIF
108
109	ELSE
110	!
111	!-- This subdomain does not overlap with the clipping area. Define an
112	!-- arbitrary (small) domain within in the clipping area.
113	dvrp_overlap = .FALSE.
114	dvrp_total_overlap = .FALSE.
115	! nxl_dvrp = nx_dvrp_l
116	! nxr_dvrp = nxl_dvrp + 4
117	! nys_dvrp = ny_dvrp_s
118	! nyn_dvrp = nys_dvrp + 4
119	nxl_dvrp = nxl
120	nxr_dvrp = MIN( nxl+4, nxr )
121	nys_dvrp = nys
122	nyn_dvrp = MIN( nys+4, nyn )
123
124	ENDIF
125
126	!
127	!-- Set the maximum time the program can be suspended on user request (by
128	!-- dvrp steering). This variable is defined in module DVRP.
129	DVRP_MAX_SUSPEND_TIME = 7200
130
131	!
132	!-- Allocate array holding the names and limits of the steering variables
133	!-- (must have the same number of elements as array mode_dvrp!)
134	ALLOCATE( steering_dvrp(10) )
135
136	!
137	!-- Check, if output parameters are given and/or allowed
138	!-- and set default-values, where necessary
139	IF ( dvrp_username == ' ' ) THEN
140	message_string = 'dvrp_username is undefined'
141	CALL message( 'init_dvrp', 'PA0195', 1, 2, 0, 6, 0 )
142	ENDIF
143
144	IF ( dvrp_output /= 'ftp' .AND. dvrp_output /= 'rtsp' .AND. &
145	dvrp_output /= 'local' ) THEN
146	message_string = 'dvrp_output="' // TRIM( dvrp_output ) // '" not allowed'
147	CALL message( 'init_dvrp', 'PA0196', 1, 2, 0, 6, 0 )
148	ENDIF
149
150	IF ( dvrp_directory == 'default' ) THEN
151	dvrp_directory = TRIM( dvrp_username ) // '/' // TRIM( run_identifier )
152	ENDIF
153
154	!
155	!-- A local dvrserver running always outputs on temporary directory DATA_DVR
156	IF ( local_dvrserver_running ) THEN
157	dvrp_directory = 'DATA_DVR'
158	ENDIF
159
160	IF ( dvrp_output /= 'local' ) THEN
161	IF ( dvrp_file /= 'default' .AND. dvrp_file /= '/dev/null' ) THEN
162	message_string = 'dvrp_file="' // TRIM( dvrp_file ) // '" not allowed'
163	CALL message( 'init_dvrp', 'PA0197', 1, 2, 0, 6, 0 )
164	ENDIF
165	ENDIF
166
167	!
168	!-- Strings are assigned to strings of special type which have a CHAR( 0 )
169	!-- (C end-of-character symbol) at their end. This is needed when strings are
170	!-- passed to C routines.
171	dvrp_directory_c = dvrp_directory
172	dvrp_file_c = dvrp_file
173	dvrp_host_c = dvrp_host
174	dvrp_password_c = dvrp_password
175	dvrp_username_c = dvrp_username
176
177	!
178	!-- Loop over all output modes choosed
179	m = 1
180	allocated = .FALSE.
181	DO WHILE ( mode_dvrp(m) /= ' ' )
182
183	!
184	!-- Check, if mode is allowed
185	IF ( mode_dvrp(m)(1:10) /= 'isosurface' .AND. &
186	mode_dvrp(m)(1:6) /= 'slicer' .AND. &
187	mode_dvrp(m)(1:9) /= 'particles' .AND. &
188	mode_dvrp(m)(1:9) /= 'pathlines' ) THEN
189
190	message_string = 'mode_dvrp="' // TRIM( mode_dvrp(m) ) // '" not allowed'
191	CALL message( 'init_dvrp', 'PA0198', 1, 2, 0, 6, 0 )
192	CALL local_stop
193
194	ENDIF
195	!
196	!-- Determine prefix for dvrp_file
197	WRITE ( prefix_chr, '(I2.2,''_'')' ) m
198	!
199	!-- Camera position must be computed and written on file when no dvrp-output
200	!-- has been generated so far (in former runs)
201	! IF ( dvrp_filecount == 0 ) THEN
202	!
203	!-- Compute center of domain and distance of camera from center
204	center(1) = ( clip_dvrp_l + clip_dvrp_r ) * 0.5 * superelevation_x
205	center(2) = ( clip_dvrp_s + clip_dvrp_n ) * 0.5 * superelevation_y
206	center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5 * superelevation
207	distance = 1.5 * MAX( (clip_dvrp_r-clip_dvrp_l) * superelevation_x, &
208	(clip_dvrp_n-clip_dvrp_s) * superelevation_y, &
209	( zu(nz_do3d) - zu(nzb) ) * superelevation )
210
211	!
212	!-- Write camera position on file
213	CALL DVRP_INIT( m-1, 0 )
214
215	!
216	!-- Create filename for camera
217	IF ( dvrp_output == 'rtsp' ) THEN
218
219	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/camera.dvr'
220	dvrp_file_c = dvrp_file
221	CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
222	dvrp_password_c, dvrp_directory_c, &
223	dvrp_file_c )
224
225	ELSEIF ( dvrp_output == 'ftp' ) THEN
226
227	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '.camera.dvr'
228	dvrp_file_c = dvrp_file
229	! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
230	! dvrp_password_c, dvrp_directory_c, &
231	! dvrp_file_c )
232
233	ELSE
234
235	IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
236	dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) &
237	// '.camera.dvr'
238	dvrp_file_local_c = dvrp_file_local
239	ELSE
240	dvrp_file_local_c = dvrp_file_c
241	ENDIF
242	CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
243
244	ENDIF
245
246	CALL DVRP_CAMERA( m-1, center, distance )
247
248	!
249	!-- Define bounding box material and create a bounding box
250	tmp_r = 0.5; tmp_g = 0.5; tmp_b = 0.5; tmp_t = 0.0
251	CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
252
253	tmp_1 = 0.01;
254	tmp_2 = clip_dvrp_l * superelevation_x
255	tmp_3 = clip_dvrp_s * superelevation_y
256	tmp_4 = 0.0
257	tmp_5 = (clip_dvrp_r+dx) * superelevation_x
258	tmp_6 = (clip_dvrp_n+dy) * superelevation_y
259	tmp_7 = zu(nz_do3d) * superelevation
260	CALL DVRP_BOUNDINGBOX( m-1, 1, tmp_1, tmp_2, tmp_3, tmp_4, tmp_5, &
261	tmp_6, tmp_7 )
262
263	CALL DVRP_VISUALIZE( m-1, 0, 0 )
264	CALL DVRP_EXIT( m-1 )
265
266	!
267	!-- Write topography isosurface on file
268	IF ( TRIM( topography ) /= 'flat' ) THEN
269
270	CALL DVRP_INIT( m-1, 0 )
271
272	!
273	!-- Create filename for topography
274	IF ( dvrp_output == 'rtsp' ) THEN
275
276	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) &
277	// '/topography.dvr'
278	dvrp_file_c = dvrp_file
279	CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
280	dvrp_password_c, dvrp_directory_c, &
281	dvrp_file_c )
282
283	ELSEIF ( dvrp_output == 'ftp' ) THEN
284
285	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) &
286	// '.topography.dvr'
287	dvrp_file_c = dvrp_file
288	! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
289	! dvrp_password_c, dvrp_directory_c, &
290	! dvrp_file_c )
291
292	ELSE
293
294	IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
295	dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) &
296	// '.topography.dvr'
297	dvrp_file_local_c = dvrp_file_local
298	ELSE
299	dvrp_file_local_c = dvrp_file_c
300	ENDIF
301	CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
302
303	ENDIF
304
305	!
306	!-- Determine local gridpoint coordinates
307	IF ( .NOT. allocated ) THEN
308	ALLOCATE( xcoor_dvrp(nxl_dvrp:nxr_dvrp+1), &
309	ycoor_dvrp(nys_dvrp:nyn_dvrp+1), &
310	zcoor_dvrp(nzb:nz_do3d) )
311	allocated = .TRUE.
312
313	DO i = nxl_dvrp, nxr_dvrp+1
314	xcoor_dvrp(i) = i * dx * superelevation_x
315	ENDDO
316	DO j = nys_dvrp, nyn_dvrp+1
317	ycoor_dvrp(j) = j * dy * superelevation_y
318	ENDDO
319	zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
320	nx_dvrp = nxr_dvrp+1 - nxl_dvrp + 1
321	ny_dvrp = nyn_dvrp+1 - nys_dvrp + 1
322	nz_dvrp = nz_do3d - nzb + 1
323	ENDIF
324
325	!
326	!-- Define the grid used by dvrp
327	CALL DVRP_NO_GLOBAL_GRID( m-1, 1 )
328	CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
329	ycoor_dvrp, zcoor_dvrp )
330
331	tmp_r = 0.8; tmp_g = 0.7; tmp_b = 0.6; tmp_t = 0.0
332	CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
333
334	!
335	!-- Compute and plot isosurface in dvr-format
336	ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
337	nzb:nz_do3d) )
338	local_pf = 0.0
339	IF ( dvrp_overlap ) THEN
340	DO i = nxl_dvrp, nxr_dvrp+1
341	DO j = nys_dvrp, nyn_dvrp+1
342	IF ( nzb_s_inner(j,i) > 0 ) THEN
343	local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0
344	ENDIF
345	ENDDO
346	ENDDO
347	ENDIF
348
349	CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
350	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
351
352	tmp_th = 1.0
353	CALL DVRP_THRESHOLD( m-1, tmp_th )
354
355	!
356	!-- Reduce the number of polygones, if required
357	IF ( cluster_size > 1 ) THEN
358
359	cluster_size_x = cluster_size
360	cluster_size_y = cluster_size
361	cluster_size_z = cluster_size
362	cluster_mode = 4 ! vertex clustering mode
363	gradient_normals = 0 ! use flat-shading
364
365	CALL DVRP_CLUSTER_SIZE( m-1, cluster_size_x, cluster_size_y, &
366	cluster_size_z )
367	CALL DVRP_CLUSTERING_MODE( m-1, cluster_mode )
368	CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
369	!
370	!-- Set parameter for vertex clustering mode 4.
371	!-- ATTENTION: A seperate procedure for setting cluster_alpha will
372	!-- be in the next version of libDVRP (Feb 09)
373	cluster_alpha = 38.0
374	CALL DVRP_THRESHOLD( -(m-1)-1, cluster_alpha )
375
376	CALL DVRP_VISUALIZE( m-1, 21, 0 )
377
378	ELSE
379	!
380	!-- No polygon reduction
381	CALL DVRP_VISUALIZE( m-1, 1, 0 )
382
383	ENDIF
384
385	DEALLOCATE( local_pf )
386
387	CALL DVRP_EXIT( m-1 )
388
389	ENDIF
390
391	!
392	!-- Write the ground plate (z=0) isosurface on file
393	CALL DVRP_INIT( m-1, 0 )
394
395	!
396	!-- Create filename for surface
397	IF ( dvrp_output == 'rtsp' ) THEN
398
399	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // &
400	'/groundplate.dvr'
401	dvrp_file_c = dvrp_file
402	CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
403	dvrp_password_c, dvrp_directory_c, &
404	dvrp_file_c )
405
406	ELSEIF ( dvrp_output == 'ftp' ) THEN
407
408	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // &
409	'.groundplate.dvr'
410	dvrp_file_c = dvrp_file
411	! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
412	! dvrp_password_c, dvrp_directory_c, &
413	! dvrp_file_c )
414
415	ELSE
416
417	IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
418	dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) &
419	// '.groundplate.dvr'
420	dvrp_file_local_c = dvrp_file_local
421	ELSE
422	dvrp_file_local_c = dvrp_file_c
423	ENDIF
424	CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
425
426	ENDIF
427
428	!
429	!-- Determine local gridpoint coordinates
430	IF ( .NOT. allocated ) THEN
431	ALLOCATE( xcoor_dvrp(nxl_dvrp:nxr_dvrp+1), &
432	ycoor_dvrp(nys_dvrp:nyn_dvrp+1), &
433	zcoor_dvrp(nzb:nz_do3d) )
434	allocated = .TRUE.
435
436	DO i = nxl_dvrp, nxr_dvrp+1
437	xcoor_dvrp(i) = i * dx * superelevation_x
438	ENDDO
439	DO j = nys_dvrp, nyn_dvrp+1
440	ycoor_dvrp(j) = j * dy * superelevation_y
441	ENDDO
442	zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
443	nx_dvrp = nxr_dvrp+1 - nxl_dvrp + 1
444	ny_dvrp = nyn_dvrp+1 - nys_dvrp + 1
445	nz_dvrp = nz_do3d - nzb + 1
446	ENDIF
447
448	!
449	!-- Define the grid used by dvrp
450	CALL DVRP_NO_GLOBAL_GRID( m-1, 1 )
451	CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
452	ycoor_dvrp, zcoor_dvrp )
453
454	tmp_r = 0.0; tmp_g = 0.6; tmp_b = 0.0; tmp_t = 0.0
455	CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
456
457	!
458	!-- Compute and plot isosurface in dvr-format
459	ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
460	nzb:nz_do3d) )
461	local_pf = 0.0
462	IF (dvrp_overlap ) local_pf(:,:,0) = 1.0
463
464	CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
465	cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
466	tmp_th = 1.0
467	CALL DVRP_THRESHOLD( m-1, tmp_th )
468
469	!
470	!-- Always reduce the number of polygones as much as possible
471	cluster_size_x = 5
472	cluster_size_y = 5
473	cluster_size_z = 5
474	cluster_mode = 4 ! vertex clustering mode
475	gradient_normals = 0 ! use flat-shading
476
477	CALL DVRP_CLUSTER_SIZE( m-1, cluster_size_x, cluster_size_y, &
478	cluster_size_z )
479	CALL DVRP_CLUSTERING_MODE( m-1, cluster_mode )
480	CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
481	!
482	!-- Set parameter for vertex clustering mode 4.
483	!-- ATTENTION: A seperate procedure for setting cluster_alpha will be in
484	!-- the next version of libDVRP (Feb 09)
485	cluster_alpha = 38.0
486	CALL DVRP_THRESHOLD( -(m-1)-1, cluster_alpha )
487
488	CALL DVRP_VISUALIZE( m-1, 21, 0 )
489
490	DEALLOCATE( local_pf )
491
492	CALL DVRP_EXIT( m-1 )
493
494	! ENDIF
495
496
497	!
498	!-- Initialize dvrp for all dvrp-calls during the run
499	CALL DVRP_INIT( m-1, 0 )
500
501	!
502	!-- Preliminary definition of filename for dvrp-output
503	IF ( dvrp_output == 'rtsp' ) THEN
504
505	!
506	!-- First initialize parameters for possible interactive steering.
507	!-- Every parameter has to be passed to the respective stream.
508	pn = 1
509	!
510	!-- Initialize threshold counter needed for initialization of the
511	!-- isosurface steering variables
512	tv = 0
513
514	DO WHILE ( mode_dvrp(pn) /= ' ' )
515
516	IF ( mode_dvrp(pn)(1:10) == 'isosurface' ) THEN
517
518	READ ( mode_dvrp(pn), '(10X,I2)' ) vn
519	steering_dvrp(pn)%name = do3d(0,vn)
520	tv = tv + 1
521
522	IF ( do3d(0,vn)(1:1) == 'w' ) THEN
523	steering_dvrp(pn)%min = -4.0
524	steering_dvrp(pn)%max = 5.0
525	ELSE
526	steering_dvrp(pn)%min = 288.0
527	steering_dvrp(pn)%max = 292.0
528	ENDIF
529
530	name_c = TRIM( do3d(0,vn) )
531	tmp_thr = threshold(tv)
532	CALL DVRP_STEERING_INIT( m-1, name_c, steering_dvrp(pn)%min, &
533	steering_dvrp(pn)%max, tmp_thr )
534
535	ELSEIF ( mode_dvrp(pn)(1:6) == 'slicer' ) THEN
536
537	READ ( mode_dvrp(pn), '(6X,I2)' ) vn
538	steering_dvrp(pn)%name = do2d(0,vn)
539	name_c = TRIM( do2d(0,vn) )
540
541	l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
542	section_chr = do2d(0,vn)(l-1:l)
543	SELECT CASE ( section_chr )
544	CASE ( 'xy' )
545	steering_dvrp(pn)%imin = 0
546	steering_dvrp(pn)%imax = nz_do3d
547	slicer_position_dvrp(pn) = section(1,1)
548	CALL DVRP_STEERING_INIT( m-1, name_c, &
549	steering_dvrp(pn)%imin, &
550	steering_dvrp(pn)%imax, &
551	slicer_position_dvrp(pn) )
552	CASE ( 'xz' )
553	steering_dvrp(pn)%imin = 0
554	steering_dvrp(pn)%imax = ny
555	slicer_position_dvrp(pn) = section(1,2)
556	CALL DVRP_STEERING_INIT( m-1, name_c, &
557	steering_dvrp(pn)%imin, &
558	steering_dvrp(pn)%imax, &
559	slicer_position_dvrp(pn) )
560	CASE ( 'yz' )
561	steering_dvrp(pn)%imin = 0
562	steering_dvrp(pn)%imax = nx
563	slicer_position_dvrp(pn) = section(1,3)
564	CALL DVRP_STEERING_INIT( m-1, name_c, &
565	steering_dvrp(pn)%imin, &
566	steering_dvrp(pn)%imax, &
567	slicer_position_dvrp(pn) )
568	END SELECT
569
570	ENDIF
571
572	pn = pn + 1
573
574	ENDDO
575
576	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/*****.dvr'
577	dvrp_file_c = dvrp_file
578	CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
579	dvrp_password_c, dvrp_directory_c, &
580	dvrp_file_c )
581
582	ELSEIF ( dvrp_output == 'ftp' ) THEN
583
584	dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '.%05d.dvr'
585	dvrp_file_c = dvrp_file
586	! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
587	! dvrp_password_c, dvrp_directory_c, dvrp_file_c )
588
589	ELSE
590
591	IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
592	dvrp_file_local = prefix_chr // TRIM( mode_dvrp(m) ) &
593	// '_%05d.dvr'
594	dvrp_file_local_c = dvrp_file_local
595	ELSE
596	dvrp_file_local_c = dvrp_file_c
597	ENDIF
598	CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
599
600	ENDIF
601
602	!
603	!-- Determine local gridpoint coordinates
604	IF ( .NOT. allocated ) THEN
605	ALLOCATE( xcoor_dvrp(nxl_dvrp:nxr_dvrp+1), &
606	ycoor_dvrp(nys_dvrp:nyn_dvrp+1), &
607	zcoor_dvrp(nzb:nz_do3d) )
608	allocated = .TRUE.
609
610	DO i = nxl_dvrp, nxr_dvrp+1
611	xcoor_dvrp(i) = i * dx * superelevation_x
612	ENDDO
613	DO j = nys_dvrp, nyn_dvrp+1
614	ycoor_dvrp(j) = j * dy * superelevation_y
615	ENDDO
616	zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
617	nx_dvrp = nxr_dvrp+1 - nxl_dvrp + 1
618	ny_dvrp = nyn_dvrp+1 - nys_dvrp + 1
619	nz_dvrp = nz_do3d - nzb + 1
620	ENDIF
621
622	!
623	!-- Define the grid used by dvrp
624	IF ( mode_dvrp(m) /= 'pathlines' ) THEN
625	CALL DVRP_NO_GLOBAL_GRID( m-1, 1 )
626	ENDIF
627	CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, ycoor_dvrp, &
628	zcoor_dvrp )
629
630	IF ( mode_dvrp(m) == 'pathlines' ) THEN
631
632	tmp_x1 = 0.0; tmp_y1 = 0.0; tmp_z1 = 0.0
633	tmp_x2 = 1.0; tmp_y2 = 1.0; tmp_z2 = 0.3
634	CALL DVRP_CUBIC_SEEDING( m-1, tmp_x1, tmp_y1, tmp_z1, tmp_x2, tmp_y2,&
635	tmp_z2, pathlines_linecount, 2, 0 )
636	!
637	!-- Set wavecount and wavetime
638	CALL DVRP_PATHLINES_BEHAVIOUR_WAVE( m-1, pathlines_wavecount, &
639	pathlines_wavetime, &
640	pathlines_fadeintime, &
641	pathlines_fadeouttime )
642	!
643	!-- Set pathline length
644	CALL DVRP_PATHLINES_SETMAXHISTORY( m-1, pathlines_maxhistory )
645	CALL DVRP_PATHLINES_SETFADING( m-1, 1, 0.0 )
646
647	CALL DVRP_INIT_PATHLINES( m-1, 0 )
648
649	ENDIF
650
651	IF ( mode_dvrp(m) == 'particles' ) THEN
652	!
653	!-- Define a default colourtable for particles
654	DO i = 1, 11
655	interval_values_dvrp_prt(1,i) = i - 1.0
656	interval_values_dvrp_prt(2,i) = REAL( i )
657	interval_h_dvrp_prt(:,i) = 270.0 - ( i - 1.0 ) * 9.0
658	ENDDO
659
660	DO j = 12, 22
661	interval_values_dvrp_prt(1,i) = i - 1.0
662	interval_values_dvrp_prt(2,i) = REAL( i )
663	interval_h_dvrp_prt(:,i) = 70.0 - ( i - 12.0 ) * 9.5
664	ENDDO
665
666	dvrp_colortable_entries_prt = 22
667
668	ENDIF
669
670	m = m + 1
671
672	ENDDO
673
674	#endif
675	END SUBROUTINE init_dvrp
676
677
678	SUBROUTINE init_dvrp_logging
679
680	!------------------------------------------------------------------------------!
681	! Description:
682	! ------------
683	! Initializes logging events for time measurement with dvrp software
684	! and splits one PE from the global communicator in case that dvrp output
685	! shall be done by one single PE.
686	!------------------------------------------------------------------------------!
687	#if defined( __dvrp_graphics )
688
689	USE control_parameters
690	USE dvrp_variables
691	USE pegrid
692
693	IMPLICIT NONE
694
695	CHARACTER (LEN=4) :: chr
696	INTEGER :: idummy
697
698	!
699	!-- Initialize logging of calls by DVRP graphic software
700	CALL DVRP_LOG_INIT( 'DVRP_LOG' // CHAR( 0 ), 0 )
701
702	!
703	!-- User-defined logging events: #1 (total time needed by PALM)
704	CALL DVRP_LOG_SYMBOL( 1, 'PALM_total' // CHAR( 0 ) )
705	CALL DVRP_LOG_SYMBOL( 2, 'PALM_timestep' // CHAR( 0 ) )
706	CALL DVRP_LOG_EVENT( 1, 1 )
707
708	#if defined( __parallel )
709	!
710	!-- Find out, if dvrp output shall be done by a dedicated PE
711	CALL local_getenv( 'use_seperate_pe_for_dvrp_output', 31, chr, idummy )
712	IF ( chr == 'true' ) THEN
713
714	use_seperate_pe_for_dvrp_output = .TRUE.
715
716	!
717	!-- Adjustment for new MPI-1 coupling. This might be unnecessary.
718	#if defined( __mpi2 )
719	CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
720	#else
721	IF ( coupling_mode /= 'uncoupled' ) THEN
722	message_string = 'split of communicator not realized with' // &
723	' MPI1 coupling atmosphere-ocean'
724	CALL message( 'init_dvrp_logging', 'PA0199', 1, 2, 0, 6, 0 )
725
726	! CALL DVRP_SPLIT( comm_inter, comm_palm )
727	ELSE
728	CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
729	ENDIF
730	#endif
731
732	CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
733
734	ENDIF
735	#endif
736
737	#endif
738	END SUBROUTINE init_dvrp_logging
739
740
741	SUBROUTINE close_dvrp
742
743	!------------------------------------------------------------------------------!
744	! Description:
745	! ------------
746	! Exit of dvrp software and finish dvrp logging
747	!------------------------------------------------------------------------------!
748	#if defined( __dvrp_graphics )
749
750	USE control_parameters
751	USE dvrp
752	USE dvrp_variables
753
754	INTEGER :: m
755
756	!
757	!-- If required, close dvrp-software and logging of dvrp-calls
758	IF ( dt_dvrp /= 9999999.9 ) THEN
759	m = 1
760	DO WHILE ( mode_dvrp(m) /= ' ' )
761	CALL DVRP_EXIT( m-1 )
762	m = m + 1
763	ENDDO
764	CALL DVRP_LOG_EVENT( -1, 1 ) ! Logging of total cpu-time used by PALM
765	IF ( use_seperate_pe_for_dvrp_output ) THEN
766	CALL DVRP_SPLIT_EXIT( 1 ) ! Argument 0: reduced output
767	ELSE
768	CALL DVRP_LOG_EXIT( 1 ) ! Argument 0: reduced output
769	ENDIF
770	ENDIF
771
772	#endif
773	END SUBROUTINE close_dvrp

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |