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

Last change on this file since 828 was 828, checked in by raasch, 13 years ago

New:
---

Changed:


Optimization of collision kernels. Collision tables can be calculated once at
simulation start for defined radius (and dissipation) classes instead of
re-calculating them at every timestep and for the particle ensemble in
every gridbox.
For this purpose the particle feature color is renamed class.
New parpar parameters radius_classes and dissipation_classes.
(Makefile, advec_particles, check_parameters, data_output_dvrp, header, init_particles, lpm_collision_kernels, modules, package_parin, set_particle_attributes)

Lower limit for droplet radius changed from 1E-7 to 1E-8.
(advec_particles)

Complete re-formatting of collision code (including changes in names of
variables, modules and subroutines).
(advec_particles, lpm_collision_kernels)

Errors:


Bugfix: transformation factor for dissipation changed from 1E5 to 1E4
(advec_particles, lpm_collision_kernels)

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