Home

Context Navigation

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

Last change on this file since 251 was 242, checked in by raasch, 16 years ago
further additions for clipping - still incomplete
Property svn:keywords set to `Id`
File size: 25.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |