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

Last change on this file since 1346 was 1346, checked in by heinze, 8 years ago

Bugfix: REAL constants provided with KIND-attribute especially in call of intrinsic function like MAX, MIN, SIGN

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