Home

Context Navigation

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

Last change on this file since 1502 was 1354, checked in by heinze, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 29.1 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |