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

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

REAL functions and a lot of REAL constants provided with KIND-attribute,
some small bugfixes

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