Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |