source: palm/trunk/SOURCE/data_output_dvrp.f90 @ 1818

Last change on this file since 1818 was 1818, checked in by maronga, 6 years ago

last commit documented / copyright update

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