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

Last change on this file since 1808 was 1808, checked in by raasch, 9 years ago

preprocessor directives using machine dependent flags (lc, ibm, etc.) mostly removed from the code

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