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

Last change on this file since 287 was 287, checked in by raasch, 15 years ago

bugfix concerning dvr

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