Home

Context Navigation

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

Last change on this file since 255 was 254, checked in by heinze, 16 years ago
Output of messages replaced by message handling routine.
Property svn:keywords set to `Id`
File size: 25.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |