Home

Context Navigation

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

Last change on this file since 1695 was 1683, checked in by knoop, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 29.3 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |