Home

Context Navigation

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

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