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

Last change on this file since 1574 was 1354, checked in by heinze, 11 years ago

last commit documented

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