Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |