Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |