Home

Context Navigation

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

Last change on this file since 260 was 260, checked in by raasch, 16 years ago
automatic generation of dvrs/html file for combined dvr streams; automatic call of streaming server
Property svn:keywords set to `Id`
File size: 25.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |