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

Last change on this file since 275 was 274, checked in by heinze, 16 years ago

Indentation of the message calls corrected

  • Property svn:keywords set to Id
File size: 27.0 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 274 2009-03-26 15:11:21Z 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#ifndef __nec
225             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
226                                    dvrp_password_c, dvrp_directory_c, &
227                                    dvrp_file_c )
228#endif
229
230          ELSEIF ( dvrp_output == 'ftp' )  THEN
231
232             dvrp_file   = prefix_chr // TRIM( mode_dvrp(m) ) // '.camera.dvr'
233             dvrp_file_c = dvrp_file
234!             CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
235!                                   dvrp_password_c, dvrp_directory_c,    &
236!                                   dvrp_file_c )
237
238          ELSE
239
240             IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
241                dvrp_file_local   = prefix_chr // TRIM( mode_dvrp(m) )  &
242                     // '.camera.dvr'
243                dvrp_file_local_c = dvrp_file_local
244             ELSE
245                dvrp_file_local_c = dvrp_file_c
246             ENDIF
247             CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
248
249          ENDIF
250
251          CALL DVRP_CAMERA( m-1, center, distance )
252
253!
254!--       Define bounding box material and create a bounding box
255          tmp_r = 0.5;  tmp_g = 0.5;  tmp_b = 0.5;  tmp_t = 0.0
256          CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
257
258          tmp_1 = 0.01;
259          tmp_2 = clip_dvrp_l * superelevation_x
260          tmp_3 = clip_dvrp_s * superelevation_y
261          tmp_4 = 0.0
262          tmp_5 = (clip_dvrp_r+dx) * superelevation_x
263          tmp_6 = (clip_dvrp_n+dy) * superelevation_y
264          tmp_7 = zu(nz_do3d) * superelevation
265          CALL DVRP_BOUNDINGBOX( m-1, 1, tmp_1, tmp_2, tmp_3, tmp_4, tmp_5, &
266                                 tmp_6, tmp_7 )
267
268          CALL DVRP_VISUALIZE( m-1, 0, 0 )
269          CALL DVRP_EXIT( m-1 )
270
271!
272!--       Write topography isosurface on file
273          IF ( TRIM( topography ) /= 'flat' )  THEN
274
275             CALL DVRP_INIT( m-1, 0 )
276
277!
278!--          Create filename for topography
279             IF ( dvrp_output == 'rtsp' )  THEN
280
281                dvrp_file   = prefix_chr // TRIM( mode_dvrp(m) )  &
282                              // '/topography.dvr'
283                dvrp_file_c = dvrp_file
284#ifndef __nec
285                CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
286                                       dvrp_password_c, dvrp_directory_c, &
287                                       dvrp_file_c )
288#endif
289
290             ELSEIF ( dvrp_output == 'ftp' )  THEN
291
292                dvrp_file   = prefix_chr // TRIM( mode_dvrp(m) )  &
293                              // '.topography.dvr'
294                dvrp_file_c = dvrp_file
295!                CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
296!                                      dvrp_password_c, dvrp_directory_c,    &
297!                                      dvrp_file_c )
298
299             ELSE
300
301                IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
302                   dvrp_file_local   = prefix_chr // TRIM( mode_dvrp(m) )  &
303                                       // '.topography.dvr'
304                   dvrp_file_local_c = dvrp_file_local
305                ELSE
306                   dvrp_file_local_c = dvrp_file_c
307                ENDIF
308                CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
309
310             ENDIF
311
312!
313!--          Determine local gridpoint coordinates
314             IF ( .NOT. allocated )  THEN
315                ALLOCATE( xcoor_dvrp(nxl_dvrp:nxr_dvrp+1), &
316                          ycoor_dvrp(nys_dvrp:nyn_dvrp+1), &
317                          zcoor_dvrp(nzb:nz_do3d) )
318                allocated = .TRUE.
319
320                DO  i = nxl_dvrp, nxr_dvrp+1
321                   xcoor_dvrp(i) = i * dx * superelevation_x
322                ENDDO
323                DO  j = nys_dvrp, nyn_dvrp+1
324                   ycoor_dvrp(j) = j * dy * superelevation_y
325                ENDDO
326                zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
327                nx_dvrp    = nxr_dvrp+1 - nxl_dvrp + 1
328                ny_dvrp    = nyn_dvrp+1 - nys_dvrp + 1
329                nz_dvrp    = nz_do3d - nzb + 1
330             ENDIF
331
332!
333!--          Define the grid used by dvrp
334             CALL DVRP_NO_GLOBAL_GRID( m-1, 1 )
335             CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
336                             ycoor_dvrp, zcoor_dvrp )
337
338             tmp_r = 0.8;  tmp_g = 0.7;  tmp_b = 0.6;  tmp_t = 0.0
339             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
340
341!
342!--          Compute and plot isosurface in dvr-format
343             ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
344                                nzb:nz_do3d) )
345             local_pf = 0.0
346             IF ( dvrp_overlap )  THEN
347                DO  i = nxl_dvrp, nxr_dvrp+1
348                   DO  j = nys_dvrp, nyn_dvrp+1
349                      IF ( nzb_s_inner(j,i) > 0 )  THEN
350                         local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0
351                      ENDIF
352                   ENDDO
353                ENDDO
354             ENDIF
355
356             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
357                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
358
359             tmp_th = 1.0
360             CALL DVRP_THRESHOLD( m-1, tmp_th )
361
362!
363!--          Reduce the number of polygones, if required
364             IF ( cluster_size > 1 )  THEN
365
366                cluster_size_x = cluster_size
367                cluster_size_y = cluster_size
368                cluster_size_z = cluster_size
369                cluster_mode     = 4    ! vertex clustering mode
370                gradient_normals = 0    ! use flat-shading
371
372                CALL DVRP_CLUSTER_SIZE( m-1, cluster_size_x, cluster_size_y, &
373                                        cluster_size_z )
374                CALL DVRP_CLUSTERING_MODE( m-1, cluster_mode )
375                CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
376!
377!--             Set parameter for vertex clustering mode 4.
378!--             ATTENTION: A seperate procedure for setting cluster_alpha will
379!--                        be in the next version of libDVRP (Feb 09)
380                cluster_alpha = 38.0
381                CALL DVRP_THRESHOLD( -(m-1)-1, cluster_alpha )
382
383                CALL DVRP_VISUALIZE( m-1, 21, 0 )
384
385             ELSE
386!
387!--             No polygon reduction
388                CALL DVRP_VISUALIZE( m-1, 1, 0 )
389
390             ENDIF
391
392             DEALLOCATE( local_pf )
393
394             CALL DVRP_EXIT( m-1 )
395
396          ENDIF
397
398!
399!--       Write the ground plate (z=0) isosurface on file
400          CALL DVRP_INIT( m-1, 0 )
401
402!
403!--       Create filename for surface
404          IF ( dvrp_output == 'rtsp' )  THEN
405
406             dvrp_file   = prefix_chr // TRIM( mode_dvrp(m) ) // &
407                           '/groundplate.dvr'
408             dvrp_file_c = dvrp_file
409#ifndef __nec
410             CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
411                                    dvrp_password_c, dvrp_directory_c, &
412                                    dvrp_file_c )
413#endif
414
415          ELSEIF ( dvrp_output == 'ftp' )  THEN
416
417             dvrp_file   = prefix_chr // TRIM( mode_dvrp(m) ) // &
418                           '.groundplate.dvr'
419             dvrp_file_c = dvrp_file
420!             CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
421!                                   dvrp_password_c, dvrp_directory_c,    &
422!                                   dvrp_file_c )
423
424          ELSE
425
426             IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
427                dvrp_file_local   = prefix_chr // TRIM( mode_dvrp(m) )  &
428                     // '.groundplate.dvr'
429                dvrp_file_local_c = dvrp_file_local
430             ELSE
431                dvrp_file_local_c = dvrp_file_c
432             ENDIF
433             CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
434
435          ENDIF
436
437!
438!--       Determine local gridpoint coordinates
439          IF ( .NOT. allocated )  THEN
440             ALLOCATE( xcoor_dvrp(nxl_dvrp:nxr_dvrp+1), &
441                       ycoor_dvrp(nys_dvrp:nyn_dvrp+1), &
442                       zcoor_dvrp(nzb:nz_do3d) )
443             allocated = .TRUE.
444
445             DO  i = nxl_dvrp, nxr_dvrp+1
446                xcoor_dvrp(i) = i * dx * superelevation_x
447             ENDDO
448             DO  j = nys_dvrp, nyn_dvrp+1
449                ycoor_dvrp(j) = j * dy * superelevation_y
450             ENDDO
451             zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
452             nx_dvrp    = nxr_dvrp+1 - nxl_dvrp + 1
453             ny_dvrp    = nyn_dvrp+1 - nys_dvrp + 1
454             nz_dvrp    = nz_do3d - nzb + 1
455          ENDIF
456
457!
458!--       Define the grid used by dvrp
459          CALL DVRP_NO_GLOBAL_GRID( m-1, 1 )
460          CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
461                          ycoor_dvrp, zcoor_dvrp )
462
463          tmp_r = 0.0;  tmp_g = 0.6;  tmp_b = 0.0;  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#ifndef __nec
542                CALL DVRP_STEERING_INIT( m-1, name_c, steering_dvrp(pn)%min, &
543                                         steering_dvrp(pn)%max, tmp_thr )
544#endif
545
546             ELSEIF ( mode_dvrp(pn)(1:6) == 'slicer' )  THEN
547
548                READ ( mode_dvrp(pn), '(6X,I2)' )  vn
549                steering_dvrp(pn)%name = do2d(0,vn)
550                name_c = TRIM( do2d(0,vn) )
551
552                l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
553                section_chr = do2d(0,vn)(l-1:l)
554                SELECT CASE ( section_chr )
555                   CASE ( 'xy' )
556                      steering_dvrp(pn)%imin   = 0
557                      steering_dvrp(pn)%imax   = nz_do3d
558                      slicer_position_dvrp(pn) = section(1,1)
559#ifndef __nec
560                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
561                                               steering_dvrp(pn)%imin, &
562                                               steering_dvrp(pn)%imax, &
563                                               slicer_position_dvrp(pn) )
564#endif
565                   CASE ( 'xz' )
566                      steering_dvrp(pn)%imin   = 0
567                      steering_dvrp(pn)%imax   = ny
568                      slicer_position_dvrp(pn) = section(1,2)
569#ifndef __nec
570                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
571                                               steering_dvrp(pn)%imin, &
572                                               steering_dvrp(pn)%imax, &
573                                               slicer_position_dvrp(pn) )
574#endif
575                   CASE ( 'yz' )
576                      steering_dvrp(pn)%imin = 0
577                      steering_dvrp(pn)%imax = nx
578                      slicer_position_dvrp(pn) = section(1,3)
579#ifndef __nec
580                      CALL DVRP_STEERING_INIT( m-1, name_c,            &
581                                               steering_dvrp(pn)%imin, &
582                                               steering_dvrp(pn)%imax, &
583                                               slicer_position_dvrp(pn) )
584#endif
585                END SELECT
586
587             ENDIF
588
589             pn = pn + 1
590
591          ENDDO
592
593          dvrp_file = prefix_chr // TRIM( mode_dvrp(m) ) // '/*****.dvr'
594          dvrp_file_c = dvrp_file
595#ifndef __nec
596          CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
597                                 dvrp_password_c, dvrp_directory_c, &
598                                 dvrp_file_c )
599#endif
600
601       ELSEIF ( dvrp_output == 'ftp' )  THEN
602
603          dvrp_file   = prefix_chr // TRIM( mode_dvrp(m) ) // '.%05d.dvr'
604          dvrp_file_c = dvrp_file
605!          CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
606!                                dvrp_password_c, dvrp_directory_c, dvrp_file_c )
607
608       ELSE
609
610          IF ( dvrp_file(1:9) /= '/dev/null' )  THEN
611             dvrp_file_local   = prefix_chr // TRIM( mode_dvrp(m) )  &
612                  // '_%05d.dvr'
613             dvrp_file_local_c = dvrp_file_local
614          ELSE
615             dvrp_file_local_c = dvrp_file_c
616          ENDIF
617          CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
618
619       ENDIF
620
621!
622!--    Determine local gridpoint coordinates
623       IF ( .NOT. allocated )  THEN
624          ALLOCATE( xcoor_dvrp(nxl_dvrp:nxr_dvrp+1), &
625                    ycoor_dvrp(nys_dvrp:nyn_dvrp+1), &
626                    zcoor_dvrp(nzb:nz_do3d) )
627          allocated = .TRUE.
628
629          DO  i = nxl_dvrp, nxr_dvrp+1
630             xcoor_dvrp(i) = i * dx * superelevation_x
631          ENDDO
632          DO  j = nys_dvrp, nyn_dvrp+1
633             ycoor_dvrp(j) = j * dy * superelevation_y
634          ENDDO
635          zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
636          nx_dvrp    = nxr_dvrp+1 - nxl_dvrp + 1
637          ny_dvrp    = nyn_dvrp+1 - nys_dvrp + 1
638          nz_dvrp    = nz_do3d - nzb + 1
639       ENDIF
640
641!
642!--    Define the grid used by dvrp
643       IF ( mode_dvrp(m) /= 'pathlines' )  THEN
644          CALL DVRP_NO_GLOBAL_GRID( m-1, 1 )
645       ENDIF
646       CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, ycoor_dvrp, &
647                       zcoor_dvrp )
648
649       IF ( mode_dvrp(m) == 'pathlines' )  THEN
650
651          tmp_x1 = 0.0;  tmp_y1 = 0.0;  tmp_z1 = 0.0
652          tmp_x2 = 1.0;  tmp_y2 = 1.0;  tmp_z2 = 0.3
653          CALL DVRP_CUBIC_SEEDING( m-1, tmp_x1, tmp_y1, tmp_z1, tmp_x2, tmp_y2,&
654                                   tmp_z2, pathlines_linecount, 2, 0 )
655!
656!--       Set wavecount and wavetime
657          CALL DVRP_PATHLINES_BEHAVIOUR_WAVE( m-1, pathlines_wavecount, &
658                                              pathlines_wavetime,       &
659                                              pathlines_fadeintime,     &
660                                              pathlines_fadeouttime )
661!
662!--       Set pathline length
663          CALL DVRP_PATHLINES_SETMAXHISTORY( m-1, pathlines_maxhistory )
664          CALL DVRP_PATHLINES_SETFADING( m-1, 1, 0.0 )
665
666          CALL DVRP_INIT_PATHLINES( m-1, 0 )
667
668       ENDIF
669
670       IF ( mode_dvrp(m)(1:9) == 'particles' )  THEN
671!
672!--       Define a default colourtable for particles
673          DO  i = 1, 11
674             interval_values_dvrp_prt(1,i) = i - 1.0
675             interval_values_dvrp_prt(2,i) = REAL( i )
676             interval_h_dvrp_prt(:,i) = 270.0 - ( i - 1.0 ) * 9.0
677          ENDDO
678
679          DO  i = 12, 22
680             interval_values_dvrp_prt(1,i) = i - 1.0
681             interval_values_dvrp_prt(2,i) = REAL( i )
682             interval_h_dvrp_prt(:,i) = 70.0 - ( i - 12.0 ) * 9.5
683          ENDDO
684
685          dvrp_colortable_entries_prt = 22
686
687       ENDIF
688
689       m = m + 1
690
691    ENDDO
692
693#endif
694 END SUBROUTINE init_dvrp
695
696 
697 SUBROUTINE init_dvrp_logging
698
699!------------------------------------------------------------------------------!
700! Description:
701! ------------
702! Initializes logging events for time measurement with dvrp software
703! and splits one PE from the global communicator in case that dvrp output
704! shall be done by one single PE.
705!------------------------------------------------------------------------------!
706#if defined( __dvrp_graphics )
707
708    USE control_parameters
709    USE dvrp_variables
710    USE pegrid
711
712    IMPLICIT NONE
713
714    CHARACTER (LEN=4) ::  chr
715    INTEGER           ::  idummy
716
717!
718!-- Initialize logging of calls by DVRP graphic software
719    CALL DVRP_LOG_INIT( 'DVRP_LOG' // CHAR( 0 ), 0 )
720
721!
722!-- User-defined logging events: #1 (total time needed by PALM)
723    CALL DVRP_LOG_SYMBOL( 1, 'PALM_total' // CHAR( 0 ) )
724    CALL DVRP_LOG_SYMBOL( 2, 'PALM_timestep' // CHAR( 0 ) )
725    CALL DVRP_LOG_EVENT( 1, 1 )
726
727#if defined( __parallel )
728!
729!-- Find out, if dvrp output shall be done by a dedicated PE
730    CALL local_getenv( 'use_seperate_pe_for_dvrp_output', 31, chr, idummy )
731    IF ( chr == 'true' )  THEN
732
733       use_seperate_pe_for_dvrp_output = .TRUE.
734
735!
736!--    Adjustment for new MPI-1 coupling. This might be unnecessary.
737#if defined( __mpi2 )
738#ifndef __nec
739       CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
740#endif
741#else
742       IF ( coupling_mode /= 'uncoupled' ) THEN
743          message_string = 'split of communicator not realized with' // &
744                          ' MPI1 coupling atmosphere-ocean'
745          CALL message( 'init_dvrp_logging', 'PA0199', 1, 2, 0, 6, 0 )
746 
747#ifndef __nec
748          CALL DVRP_SPLIT( comm_inter, comm_palm )
749#endif
750       ELSE
751#ifndef __nec
752          CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
753#endif
754       ENDIF
755#endif
756
757       CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
758
759    ENDIF
760#endif
761
762#endif
763 END SUBROUTINE init_dvrp_logging
764
765
766 SUBROUTINE close_dvrp
767
768!------------------------------------------------------------------------------!
769! Description:
770! ------------
771! Exit of dvrp software and finish dvrp logging
772!------------------------------------------------------------------------------!
773#if defined( __dvrp_graphics )
774
775    USE control_parameters
776    USE dvrp
777    USE dvrp_variables
778
779    INTEGER ::  m
780
781!
782!-- If required, close dvrp-software and logging of dvrp-calls
783    IF ( dt_dvrp /= 9999999.9 )  THEN
784       m = 1
785       DO WHILE ( mode_dvrp(m) /= ' ' )
786          CALL DVRP_EXIT( m-1 )
787          m = m + 1
788       ENDDO
789       CALL DVRP_LOG_EVENT( -1, 1 )   ! Logging of total cpu-time used by PALM
790       IF ( use_seperate_pe_for_dvrp_output )  THEN
791#ifndef __nec
792          CALL DVRP_SPLIT_EXIT( 1 )      ! Argument 0: reduced output
793#endif
794       ELSE
795          CALL DVRP_LOG_EXIT( 1 )        ! Argument 0: reduced output
796       ENDIF
797    ENDIF
798
799#endif
800 END SUBROUTINE close_dvrp
Note: See TracBrowser for help on using the repository browser.