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

Last change on this file since 2053 was 2001, checked in by knoop, 8 years ago

last commit documented

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