Home

Context Navigation

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

Last change on this file since 3318 was 2718, checked in by maronga, 7 years ago
deleting of deprecated files; headers updated where needed
Property svn:keywords set to `Id`
File size: 29.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |