Home

Context Navigation

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

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