Home

Context Navigation

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

Last change on this file since 1353 was 1353, checked in by heinze, 10 years ago
REAL constants provided with KIND-attribute
Property svn:keywords set to `Id`
File size: 29.1 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |