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

Last change on this file since 242 was 242, checked in by raasch, 14 years ago

further additions for clipping - still incomplete

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