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

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

code has been put under the GNU General Public License (v3)

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