Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |