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

Last change on this file since 263 was 260, checked in by raasch, 16 years ago

automatic generation of dvrs/html file for combined dvr streams; automatic call of streaming server

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