Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |