Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |