Home

Context Navigation

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

Last change on this file since 2605 was 2516, checked in by suehring, 7 years ago
document changes
Property svn:keywords set to `Id`
File size: 29.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |