Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |