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

Last change on this file since 1834 was 1818, checked in by maronga, 5 years ago

last commit documented / copyright update

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