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

Last change on this file since 1360 was 1354, checked in by heinze, 10 years ago

last commit documented

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