Home

Context Navigation

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

Last change on this file since 2563 was 2516, checked in by suehring, 7 years ago
document changes
Property svn:keywords set to `Id`
File size: 29.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |