Home

Context Navigation

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

Last change on this file since 251 was 242, checked in by raasch, 16 years ago
further additions for clipping - still incomplete
Property svn:keywords set to `Id`
File size: 25.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |