source: palm/tags/release-5.0/SOURCE/init_dvrp.f90 @ 4383

Last change on this file since 4383 was 2696, checked in by kanani, 6 years ago

Merge of branch palm4u into trunk

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