Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |