Home

Context Navigation

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

Last change on this file since 1322 was 1322, checked in by raasch, 10 years ago
REAL functions and a lot of REAL constants provided with KIND-attribute, some small bugfixes
Property svn:keywords set to `Id`
File size: 28.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |