Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |