Home

Context Navigation

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

Last change on this file since 3819 was 3655, checked in by knoop, 6 years ago
Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update
Property svn:keywords set to `Id`
File size: 29.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |