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

Last change on this file since 1279 was 1037, checked in by raasch, 12 years ago

last commit documented

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