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

Last change on this file since 1323 was 1323, checked in by raasch, 8 years ago

last commit documented

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