Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |