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

Last change on this file since 258 was 254, checked in by heinze, 15 years ago

Output of messages replaced by message handling routine.

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