Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |