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

Last change on this file since 2000 was 2000, checked in by knoop, 8 years ago

Forced header and separation lines into 80 columns

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