Home

Context Navigation

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

Last change on this file since 240 was 237, checked in by raasch, 16 years ago
polygon reduction for topography and ground plate isosurface (dvr)
Property svn:keywords set to `Id`
File size: 23.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |