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

Last change on this file since 268 was 264, checked in by raasch, 16 years ago

new dvrp features added

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