Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |