Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |