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

Last change on this file since 271 was 271, checked in by raasch, 15 years ago

some bugfixes for the previous revison

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