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

Last change on this file since 1320 was 1320, checked in by raasch, 7 years ago

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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