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

Last change on this file since 1353 was 1353, checked in by heinze, 7 years ago

REAL constants provided with KIND-attribute

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