source: palm/trunk/SOURCE/data_output_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: 24.9 KB
Line 
1 MODULE dvrp_color
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: data_output_dvrp.f90 1320 2014-03-20 08:40:49Z raasch $
33!
34! 1318 2014-03-17 13:35:16Z raasch
35! module interfaces removed
36!
37! 1036 2012-10-22 13:43:42Z raasch
38! code put under GPL (PALM 3.9)
39!
40! 828 2012-02-21 12:00:36Z raasch
41! particle feature color renamed class
42!
43! Revision 1.1  2000/04/27 06:27:17  raasch
44! Initial revision
45!
46!
47! Description:
48! ------------
49! Plot of isosurface, particles and slicers with dvrp-software
50!------------------------------------------------------------------------------!
51
52    USE dvrp_variables
53   
54    USE kinds
55
56    IMPLICIT NONE
57
58 CONTAINS
59
60    SUBROUTINE color_dvrp( value, color )
61
62       REAL(wp), INTENT(IN)  ::  value    !:
63       REAL(wp), INTENT(OUT) ::  color(4) !:
64
65       REAL(wp)              ::  scale    !:
66
67       scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) /           &
68               ( slicer_range_limits_dvrp(2,islice_dvrp) -                     &
69                 slicer_range_limits_dvrp(1,islice_dvrp) )
70
71       scale = MODULO( 180.0 + 180.0 * scale, 360.0 )
72
73       color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /)
74
75    END SUBROUTINE color_dvrp
76
77 END MODULE dvrp_color
78
79
80 RECURSIVE SUBROUTINE data_output_dvrp
81
82#if defined( __dvrp_graphics )
83
84    USE arrays_3d,                                                             &
85        ONLY:  p, pt, q, ql, ts, u, us, v, w, zu
86       
87    USE cloud_parameters,                                                      &
88        ONLY:  l_d_cp, pt_d_t
89       
90    USE constants,                                                             &
91        ONLY:  pi
92       
93    USE control_parameters,                                                    &
94        ONLY:  cloud_droplets, cloud_physics, do2d, do3d, humidity, ibc_uv_b,  &
95               message_string, nz_do3d, passive_scalar, simulated_time,        &
96               threshold
97       
98    USE cpulog,                                                                &
99        ONLY:  log_point, log_point_s, cpu_log
100       
101    USE DVRP
102   
103    USE dvrp_color
104       
105    USE dvrp_variables
106       
107    USE grid_variables,                                                        &
108        ONLY:  dx, dy
109       
110    USE indices,                                                               &
111        ONLY:  nxl, nxr, nyn, nys, nzb
112       
113    USE kinds
114   
115    USE particle_attributes,                                                   &
116        ONLY:  maximum_number_of_tailpoints, number_of_particles,              &
117               number_of_tails, particle_advection, particle_advection_start,  &
118               particle_tail_coordinates, particles, uniform_particles,        &
119               use_particle_tails
120       
121    USE pegrid
122
123    IMPLICIT NONE
124
125    CHARACTER (LEN=2) ::  section_chr      !:
126    CHARACTER (LEN=6) ::  output_variable  !:
127   
128    INTEGER(iwp) ::  c_mode           !: 
129    INTEGER(iwp) ::  c_size_x         !:
130    INTEGER(iwp) ::  c_size_y         !:
131    INTEGER(iwp) ::  c_size_z         !:
132    INTEGER(iwp) ::  dvrp_nop         !:
133    INTEGER(iwp) ::  dvrp_not         !:
134    INTEGER(iwp) ::  gradient_normals !:
135    INTEGER(iwp) ::  i                !:
136    INTEGER(iwp) ::  ip               !:
137    INTEGER(iwp) ::  j                !:
138    INTEGER(iwp) ::  jp               !:
139    INTEGER(iwp) ::  k                !:
140    INTEGER(iwp) ::  l                !:
141    INTEGER(iwp) ::  m                !:
142    INTEGER(iwp) ::  n                !:
143    INTEGER(iwp) ::  n_isosurface     !:
144    INTEGER(iwp) ::  n_slicer         !:
145    INTEGER(iwp) ::  nn               !:
146    INTEGER(iwp) ::  section_mode     !:
147    INTEGER(iwp) ::  vn               !:
148    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_c  !:
149    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_t  !:
150
151    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask  !:
152
153    REAL(sp) ::  slicer_position  !:
154    REAL(sp) ::  tmp_alpha        !:
155    REAL(sp) ::  tmp_alpha_w      !:
156    REAL(sp) ::  tmp_b            !:
157    REAL(sp) ::  tmp_c_alpha      !:
158    REAL(sp) ::  tmp_g            !:
159    REAL(sp) ::  tmp_norm         !:
160    REAL(sp) ::  tmp_pos          !:
161    REAL(sp) ::  tmp_r            !:
162    REAL(sp) ::  tmp_t            !:
163    REAL(sp) ::  tmp_th           !:
164    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  psize  !:
165    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_x    !:
166    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_y    !:
167    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_z    !:
168    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf  !:
169    REAL(sp), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi !:
170
171
172    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
173
174!
175!-- Loop over all output modes choosed
176    m            = 1
177    n_isosurface = 0  ! isosurface counter (for threshold values and color)
178    n_slicer     = 0  ! slice plane counter (for range of values)
179    DO WHILE ( mode_dvrp(m) /= ' ' )
180!
181!--    Update of the steering variables
182       IF ( .NOT. lock_steering_update )  THEN
183!
184!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
185          lock_steering_update = .TRUE.
186!          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
187          lock_steering_update = .FALSE.
188       ENDIF
189
190!
191!--    Determine the variable which shall be plotted (in case of slicers or
192!--    isosurfaces)
193       IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
194          READ ( mode_dvrp(m), '(10X,I2)' )  vn
195          output_variable = do3d(0,vn)
196          n_isosurface = n_isosurface + 1
197       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
198          READ ( mode_dvrp(m), '(6X,I2)' )  vn
199          output_variable = do2d(0,vn)
200          l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
201          section_chr = do2d(0,vn)(l-1:l)
202          SELECT CASE ( section_chr )
203             CASE ( 'xy' )
204                section_mode = 2
205                slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
206             CASE ( 'xz' )
207                section_mode = 1
208                slicer_position = slicer_position_dvrp(m) * dy
209             CASE ( 'yz' )
210                section_mode = 0
211                slicer_position = slicer_position_dvrp(m) * dx
212          END SELECT
213       ENDIF
214
215!
216!--    Select the plot mode (in case of isosurface or slicer only if user has
217!--    defined a variable which shall be plotted; otherwise do nothing)
218       IF ( mode_dvrp(m)(1:9) == 'particles'  .AND.  particle_advection  .AND. &
219            simulated_time >= particle_advection_start )  THEN
220!
221!--       DVRP-Calls for plotting particles:
222          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
223
224!
225!--       Definition of characteristics of particle material
226!          tmp_r = 0.1;  tmp_g = 0.7;  tmp_b = 0.1;  tmp_t = 0.0
227          tmp_r = 0.0;  tmp_g = 0.0;  tmp_b = 0.0;  tmp_t = 0.0
228          CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
229
230!
231!--       If clipping is active and if this subdomain is clipped, find out the
232!--       number of particles and tails to be plotted; otherwise, all
233!--       particles/tails are plotted. dvrp_mask is used to mark the partikles.
234          ALLOCATE( dvrp_mask(number_of_particles) )
235
236          IF ( dvrp_total_overlap )  THEN
237             dvrp_mask = .TRUE.
238             dvrp_nop  = number_of_particles
239             dvrp_not  = number_of_tails
240          ELSE
241             dvrp_mask = .FALSE.
242             dvrp_nop  = 0
243             dvrp_not  = 0
244             IF ( dvrp_overlap )  THEN
245                IF ( .NOT. use_particle_tails )  THEN
246                   DO  n = 1, number_of_particles
247                      ip = particles(n)%x / dx
248                      jp = particles(n)%y / dy
249                      IF ( ip >= nxl_dvrp  .AND.  ip <= nxr_dvrp  .AND.  &
250                           jp >= nys_dvrp  .AND.  jp <= nyn_dvrp )  THEN
251                         dvrp_nop = dvrp_nop + 1
252                         dvrp_mask(n) = .TRUE.
253                      ENDIF
254                   ENDDO
255                ELSE
256                   k = 0
257                   DO  n = 1, number_of_particles
258                      IF ( particles(n)%tail_id /= 0 )  THEN
259                         k = k + 1
260                         ip = particles(n)%x / dx
261                         jp = particles(n)%y / dy
262                         IF ( ip >= nxl_dvrp  .AND.  ip <= nxr_dvrp  .AND.  &
263                              jp >= nys_dvrp  .AND.  jp <= nyn_dvrp )  THEN
264                            dvrp_not = dvrp_not + 1
265                            dvrp_mask(n) = .TRUE.
266                         ENDIF
267                      ENDIF
268                   ENDDO
269                ENDIF
270             ENDIF
271          ENDIF
272
273!
274!--       Move particle coordinates to one-dimensional arrays
275          IF ( .NOT. use_particle_tails )  THEN
276!
277!--          All particles are output
278             ALLOCATE( psize(dvrp_nop), p_t(dvrp_nop), p_c(dvrp_nop), &
279                       p_x(dvrp_nop), p_y(dvrp_nop), p_z(dvrp_nop) )
280             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
281             p_z   = 0.0
282             k = 0
283             DO  n = 1, number_of_particles
284                IF ( dvrp_mask(n) )  THEN
285                   k = k + 1
286                   psize(k) = particles(n)%dvrp_psize
287                   p_x(k)   = particles(n)%x * superelevation_x
288                   p_y(k)   = particles(n)%y * superelevation_y
289                   p_z(k)   = particles(n)%z * superelevation
290                   p_c(k)   = particles(n)%class
291                ENDIF
292             ENDDO
293          ELSE
294!
295!--          Particles have a tail
296             ALLOCATE( psize(dvrp_not), p_t(dvrp_not),             &
297                       p_c(dvrp_not*maximum_number_of_tailpoints), &
298                       p_x(dvrp_not*maximum_number_of_tailpoints), &
299                       p_y(dvrp_not*maximum_number_of_tailpoints), &
300                       p_z(dvrp_not*maximum_number_of_tailpoints) )
301             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
302             p_z   = 0.0;
303             i = 0
304             k = 0
305
306             DO  n = 1, number_of_particles
307                nn = particles(n)%tail_id
308                IF ( nn /= 0  .AND.  dvrp_mask(n) )  THEN
309                   k = k + 1
310                   DO  j = 1, particles(n)%tailpoints
311                      i = i + 1
312                      p_x(i) = particle_tail_coordinates(j,1,nn) * &
313                                                                superelevation_x
314                      p_y(i) = particle_tail_coordinates(j,2,nn) * &
315                                                                superelevation_y
316                      p_z(i) = particle_tail_coordinates(j,3,nn) * &
317                                                                superelevation
318                      p_c(i) = particle_tail_coordinates(j,4,nn)
319                   ENDDO
320                   psize(k) = particles(n)%dvrp_psize
321                   p_t(k)   = particles(n)%tailpoints - 1
322                ENDIF               
323             ENDDO
324          ENDIF
325
326!
327!--       Compute and plot particles in dvr-format
328          IF ( uniform_particles  .AND.  .NOT. use_particle_tails )  THEN
329!
330!--          All particles have the same color. Use simple routine to set
331!--          the particle attributes (produces less output data)
332             CALL DVRP_PARTICLES( m-1, p_x, p_y, p_z, psize )
333          ELSE
334!
335!--          Set color definitions
336             CALL user_dvrp_coltab( 'particles', 'none' )
337
338             CALL DVRP_COLORTABLE_HLS( m-1, 0, interval_values_dvrp_prt, &
339                                       interval_h_dvrp_prt,              &
340                                       interval_l_dvrp_prt,              &
341                                       interval_s_dvrp_prt,              &
342                                       interval_a_dvrp_prt )
343
344             IF ( .NOT. use_particle_tails )  THEN
345                CALL DVRP_PARTICLES( m-1, dvrp_nop, p_x, p_y, p_z, 3, psize, &
346                                     p_c, p_t )
347             ELSE
348                CALL DVRP_PARTICLES( m-1, dvrp_not, p_x, p_y, p_z, 15, psize, &
349                                     p_c, p_t )
350             ENDIF
351          ENDIF
352
353          CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
354
355          DEALLOCATE( dvrp_mask, psize, p_c, p_t, p_x, p_y, p_z )
356
357          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
358
359
360       ELSEIF ( ( mode_dvrp(m)(1:10) == 'isosurface'  .OR.   &
361                  mode_dvrp(m)(1:6)  == 'slicer'           ) &
362                  .AND.  output_variable /= ' ' )  THEN
363
364!
365!--       Create an intermediate array, properly dimensioned for plot-output
366          ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
367                             nzb:nz_do3d) )
368
369!
370!--       Move original array to intermediate array
371          IF ( dvrp_overlap )  THEN
372
373             SELECT CASE ( output_variable )
374
375                CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
376                   DO  i = nxl_dvrp, nxr_dvrp+1
377                      DO  j = nys_dvrp, nyn_dvrp+1
378                         DO  k = nzb, nz_do3d
379                            local_pf(i,j,k) = u(k,j,i)
380                         ENDDO
381                      ENDDO
382                   ENDDO
383!
384!--                Replace mirrored values at lower surface by real surface
385!--                values
386                   IF ( output_variable == 'u_xz'  .OR. &
387                        output_variable == 'u_yz' )  THEN
388                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
389                   ENDIF
390
391
392                CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
393                   DO  i = nxl_dvrp, nxr_dvrp+1
394                      DO  j = nys_dvrp, nyn_dvrp+1
395                         DO  k = nzb, nz_do3d
396                            local_pf(i,j,k) = v(k,j,i)
397                         ENDDO
398                      ENDDO
399                   ENDDO
400!
401!--                Replace mirrored values at lower surface by real surface
402!--                values
403                   IF ( output_variable == 'v_xz'  .OR. &
404                        output_variable == 'v_yz' )  THEN
405                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
406                   ENDIF
407
408                CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
409                   DO  i = nxl_dvrp, nxr_dvrp+1
410                      DO  j = nys_dvrp, nyn_dvrp+1
411                         DO  k = nzb, nz_do3d
412                            local_pf(i,j,k) = w(k,j,i)
413                         ENDDO
414                      ENDDO
415                   ENDDO
416! Averaging for Langmuir circulation
417!                   DO  k = nzb, nz_do3d
418!                      DO  j = nys_dvrp+1, nyn_dvrp
419!                         DO  i = nxl_dvrp, nxr_dvrp+1
420!                            local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
421!                                              0.50 * local_pf(i,j,k)   + &
422!                                              0.25 * local_pf(i,j+1,k)
423!                         ENDDO
424!                      ENDDO
425!                   ENDDO
426
427                CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
428                   DO  i = nxl_dvrp, nxr_dvrp+1
429                      DO  j = nys_dvrp, nyn_dvrp+1
430                         DO  k = nzb, nz_do3d
431                            local_pf(i,j,k) = p(k,j,i)
432                         ENDDO
433                      ENDDO
434                   ENDDO
435
436                CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
437                   IF ( .NOT. cloud_physics ) THEN
438                      DO  i = nxl_dvrp, nxr_dvrp+1
439                         DO  j = nys_dvrp, nyn_dvrp+1
440                            DO  k = nzb, nz_do3d
441                               local_pf(i,j,k) = pt(k,j,i)
442                            ENDDO
443                         ENDDO
444                      ENDDO
445                   ELSE
446                      DO  i = nxl_dvrp, nxr_dvrp+1
447                         DO  j = nys_dvrp, nyn_dvrp+1
448                            DO  k = nzb, nz_do3d
449                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
450                                                 pt_d_t(k) * ql(k,j,i)
451                            ENDDO
452                         ENDDO
453                      ENDDO
454                   ENDIF
455
456                CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
457                   IF ( humidity  .OR.  passive_scalar )  THEN
458                      DO  i = nxl_dvrp, nxr_dvrp+1
459                         DO  j = nys_dvrp, nyn_dvrp+1
460                            DO  k = nzb, nz_do3d
461                               local_pf(i,j,k) = q(k,j,i)
462                            ENDDO
463                         ENDDO
464                      ENDDO           
465                   ELSE                   
466                      message_string = 'if humidity/passive_scalar = '    // & 
467                            'FALSE output of ' // TRIM( output_variable ) // &
468                            'is not provided' 
469                      CALL message( 'data_output_dvrp', 'PA0183',&
470                                                                 0, 0, 0, 6, 0 )
471                   ENDIF
472             
473                CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
474                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
475                      DO  i = nxl_dvrp, nxr_dvrp+1
476                         DO  j = nys_dvrp, nyn_dvrp+1
477                            DO  k = nzb, nz_do3d
478                               local_pf(i,j,k) = ql(k,j,i)
479                            ENDDO
480                         ENDDO
481                      ENDDO
482                   ELSE                     
483                      message_string = 'if cloud_physics = FALSE '       // & 
484                                  'output of ' // TRIM( output_variable) // &
485                                  'is not provided' 
486                      CALL message( 'data_output_dvrp', 'PA0184',&
487                                                                 0, 0, 0, 6, 0 )
488                   ENDIF
489
490                CASE ( 'u*_xy' )
491                   DO  i = nxl_dvrp, nxr_dvrp+1
492                      DO  j = nys_dvrp, nyn_dvrp+1
493                         local_pf(i,j,nzb+1) = us(j,i)
494                      ENDDO
495                   ENDDO
496                   slicer_position = zu(nzb+1)
497
498                CASE ( 't*_xy' )
499                   DO  i = nxl_dvrp, nxr_dvrp+1
500                      DO  j = nys_dvrp, nyn_dvrp+1
501                         local_pf(i,j,nzb+1) = ts(j,i)
502                      ENDDO
503                   ENDDO
504                   slicer_position = zu(nzb+1)
505
506
507                CASE DEFAULT
508!
509!--                The DEFAULT case is reached either if output_variable
510!--                contains unsupported variable or if the user has coded a
511!--                special case in the user interface. There, the subroutine
512!--                user_data_output_dvrp checks which of these two conditions
513!--                applies.
514                   CALL user_data_output_dvrp( output_variable, local_pf )
515
516
517             END SELECT
518
519          ELSE
520!
521!--          No overlap of clipping domain with the current subdomain
522             DO  i = nxl_dvrp, nxr_dvrp+1
523                DO  j = nys_dvrp, nyn_dvrp+1
524                   DO  k = nzb, nz_do3d
525                      local_pf(i,j,k) = 0.0
526                   ENDDO
527                ENDDO
528             ENDDO
529
530          ENDIF
531
532          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
533
534!
535!--          DVRP-Calls for plotting isosurfaces:
536             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
537
538!
539!--          Definition of isosurface color
540             tmp_r = isosurface_color(1,n_isosurface)
541             tmp_g = isosurface_color(2,n_isosurface)
542             tmp_b = isosurface_color(3,n_isosurface)
543             tmp_t = 0.0
544             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
545
546!
547!--          Compute and plot isosurface in dvr-format
548             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
549                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
550
551             c_size_x = vc_size_x;  c_size_y = vc_size_y;  c_size_z = vc_size_z
552             CALL DVRP_CLUSTER_SIZE( m-1, c_size_x, c_size_y, c_size_z )
553
554             c_mode   = vc_mode
555             CALL DVRP_CLUSTERING_MODE( m-1, c_mode )
556
557             gradient_normals = vc_gradient_normals
558             CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
559
560!
561!--          A seperate procedure for setting vc_alpha will be in the next
562!--          version of libDVRP
563             tmp_c_alpha = vc_alpha
564             CALL DVRP_THRESHOLD( -(m-1)-1, tmp_c_alpha )
565
566             IF ( dvrp_overlap )  THEN
567                tmp_th = threshold(n_isosurface)
568             ELSE
569                tmp_th = 1.0   ! nothing is plotted because array values are 0
570             ENDIF
571
572             CALL DVRP_THRESHOLD( m-1, tmp_th )
573
574             CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
575
576             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
577
578          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
579
580!
581!--          DVRP-Calls for plotting slicers:
582             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
583
584!
585!--          Material and color definitions
586             tmp_r = 0.0;  tmp_g = 0.0;  tmp_b = 0.0;  tmp_t = 0.0
587             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
588
589             n_slicer = n_slicer + 1
590
591!
592!--           Using dolorfunction has not been properly tested
593!             islice_dvrp = n_slicer
594!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                 &
595!                                      slicer_range_limits_dvrp(:,n_slicer), &
596!                                      color_dvrp )
597
598!
599!--          Set interval of values defining the colortable
600             CALL set_slicer_attributes_dvrp( n_slicer )
601
602!
603!--          Create user-defined colortable
604             CALL user_dvrp_coltab( 'slicer', output_variable )
605
606             CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp,     &
607                                       interval_h_dvrp, interval_l_dvrp, &
608                                       interval_s_dvrp, interval_a_dvrp )
609
610!
611!--          Compute and plot slicer in dvr-format
612             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
613                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
614             tmp_pos = slicer_position
615             CALL DVRP_SLICER( m-1, section_mode, tmp_pos )
616
617             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
618
619             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
620
621          ENDIF
622
623          DEALLOCATE( local_pf )
624
625       ELSEIF ( mode_dvrp(m)(1:9) == 'pathlines' ) THEN
626
627          ALLOCATE( local_pfi(4,nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
628          DO  i = nxl, nxr+1
629             DO  j = nys, nyn+1
630                DO  k = nzb, nz_do3d
631                   local_pfi(1,i,j,k) = u(k,j,i)
632                   local_pfi(2,i,j,k) = v(k,j,i)
633                   local_pfi(3,i,j,k) = w(k,j,i)
634                   tmp_norm           = SQRT( u(k,j,i) * u(k,j,i) + &
635                                              v(k,j,i) * v(k,j,i) + &
636                                              w(k,j,i) * w(k,j,i) )
637                   tmp_alpha          = ACOS( 0.0 * u(k,j,i) / tmp_norm + &
638                                              0.0 * v(k,j,i) / tmp_norm - &
639                                              1.0 * w(k,j,i) / tmp_norm )
640                   tmp_alpha_w        = tmp_alpha / pi * 180.0
641                   local_pfi(4,i,j,k) = tmp_alpha_w
642                ENDDO
643             ENDDO
644          ENDDO
645
646          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'start' )
647
648          CALL DVRP_DATA( m-1, local_pfi, 4, nx_dvrp, ny_dvrp, nz_dvrp, &
649                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
650          CALL DVRP_VISUALIZE( m-1, 20, dvrp_filecount )
651
652          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'stop' )
653
654          DEALLOCATE( local_pfi )
655
656       ENDIF
657
658       m = m + 1
659
660    ENDDO
661
662    dvrp_filecount = dvrp_filecount + 1
663
664    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
665
666#endif
667 END SUBROUTINE data_output_dvrp
Note: See TracBrowser for help on using the repository browser.