Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |