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

Last change on this file since 1099 was 1037, checked in by raasch, 12 years ago

last commit documented

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