Home

Context Navigation

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

Last change on this file since 259 was 254, checked in by heinze, 16 years ago
Output of messages replaced by message handling routine.
Property svn:keywords set to `Id`
File size: 25.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |