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

Last change on this file since 3768 was 3655, checked in by knoop, 3 years ago

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

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