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

Last change on this file since 284 was 284, checked in by raasch, 12 years ago

further dvr updates

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