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

Last change on this file since 254 was 254, checked in by heinze, 13 years ago

Output of messages replaced by message handling routine.

  • Property svn:keywords set to Id
File size: 22.3 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! Output of messages replaced by message handling routine.
35! TEST: different colours for isosurfaces
36!
37! Former revisions:
38! -----------------
39! $Id: data_output_dvrp.f90 254 2009-03-05 15:33:42Z heinze $
40!
41! 210 2008-11-06 08:54:02Z raasch
42! DVRP arguments changed to single precision, mode pathlines added
43!
44! 130 2007-11-13 14:08:40Z letzel
45! allow two instead of one digit to specify isosurface and slicer variables
46! for unknown variables (CASE DEFAULT) call new subroutine
47! user_data_output_dvrp
48!
49! 82 2007-04-16 15:40:52Z raasch
50! Preprocessor strings for different linux clusters changed to "lc",
51! routine local_flush is used for buffer flushing
52!
53! 75 2007-03-22 09:54:05Z raasch
54! Particles-package is now part of the default code,
55! moisture renamed humidity
56!
57! RCS Log replace by Id keyword, revision history cleaned up
58!
59! Revision 1.13  2006/02/23 10:25:12  raasch
60! Former routine plot_dvrp renamed data_output_dvrp,
61! Only a fraction of the particles may have a tail,
62! pl.. replaced by do.., %size renamed %dvrp_psize
63!
64! Revision 1.1  2000/04/27 06:27:17  raasch
65! Initial revision
66!
67!
68! Description:
69! ------------
70! Plot of isosurface, particles and slicers with dvrp-software
71!------------------------------------------------------------------------------!
72#if defined( __dvrp_graphics )
73
74    USE arrays_3d
75    USE cloud_parameters
76    USE constants
77    USE control_parameters
78    USE cpulog
79    USE DVRP
80    USE dvrp_color
81    USE dvrp_variables
82    USE grid_variables
83    USE indices
84    USE interfaces
85    USE particle_attributes
86    USE pegrid
87
88    IMPLICIT NONE
89
90    CHARACTER (LEN=2) ::  section_chr
91    CHARACTER (LEN=6) ::  output_variable
92    INTEGER ::  c_mode, c_size_x, c_size_y, c_size_z, dvrp_nop, dvrp_not,     &
93                gradient_normals, i, ip, j, jp, k, l, m, n, nn, section_mode, &
94                tv, vn
95    INTEGER, DIMENSION(:), ALLOCATABLE ::  p_c, p_t
96
97    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask
98
99    REAL(4) ::  center(3), distance, slicer_position, surface_value,         &
100                tmp_alpha, tmp_alpha_w, tmp_b, tmp_c_alpha, tmp_g, tmp_norm, &
101                tmp_pos, tmp_r, tmp_t, tmp_th
102    REAL(4), DIMENSION(:),     ALLOCATABLE   ::  psize, p_x, p_y, p_z
103    REAL(4), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf
104    REAL(4), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi
105
106
107    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
108
109!
110!-- Loop over all output modes choosed
111    m           = 1
112    tv          = 0  ! threshold counter
113    islice_dvrp = 0  ! slice plane counter
114    DO WHILE ( mode_dvrp(m) /= ' ' )
115!
116!--    Update of the steering variables
117       IF ( .NOT. lock_steering_update )  THEN
118!
119!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
120          lock_steering_update = .TRUE.
121!          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
122          lock_steering_update = .FALSE.
123       ENDIF
124
125!
126!--    Determine the variable which shall be plotted (in case of slicers or
127!--    isosurfaces)
128       IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
129          READ ( mode_dvrp(m), '(10X,I2)' )  vn
130          output_variable = do3d(0,vn)
131          tv = tv + 1
132       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
133          READ ( mode_dvrp(m), '(6X,I2)' )  vn
134          output_variable = do2d(0,vn)
135          l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
136          section_chr = do2d(0,vn)(l-1:l)
137          SELECT CASE ( section_chr )
138             CASE ( 'xy' )
139                section_mode = 2
140                slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
141             CASE ( 'xz' )
142                section_mode = 1
143                slicer_position = slicer_position_dvrp(m) * dy
144             CASE ( 'yz' )
145                section_mode = 0
146                slicer_position = slicer_position_dvrp(m) * dx
147          END SELECT
148       ENDIF
149
150!
151!--    Select the plot mode (in case of isosurface or slicer only if user has
152!--    defined a variable which shall be plotted; otherwise do nothing)
153       IF ( mode_dvrp(m)(1:9) == 'particles'  .AND.  particle_advection  .AND. &
154            simulated_time >= particle_advection_start )  THEN
155!
156!--       DVRP-Calls for plotting particles:
157          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
158
159!
160!--       Definition of characteristics of particle material
161!          tmp_r = 0.1;  tmp_g = 0.7;  tmp_b = 0.1;  tmp_t = 0.0
162          tmp_r = 0.0;  tmp_g = 0.0;  tmp_b = 0.0;  tmp_t = 0.0
163          CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
164
165!
166!--       If clipping is active and if this subdomain is clipped, find out the
167!--       number of particles and tails to be plotted; otherwise, all
168!--       particles/tails are plotted. dvrp_mask is used to mark the partikles.
169          IF ( .NOT. use_particle_tails )  THEN
170             ALLOCATE( dvrp_mask(number_of_particles) )
171          ELSE
172             ALLOCATE( dvrp_mask(number_of_tails*maximum_number_of_tailpoints) )
173          ENDIF
174          dvrp_mask = .TRUE.
175          IF ( dvrp_total_overlap )  THEN
176             dvrp_nop = number_of_particles
177             dvrp_not = number_of_tails
178          ELSE
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                      ELSE
190                         dvrp_mask(n) = .FALSE.
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                         ELSE
204                            dvrp_mask(k) = .FALSE.
205                         ENDIF
206                      ENDIF
207                   ENDDO
208                ENDIF
209             ENDIF
210          ENDIF
211
212!
213!--       Move particle coordinates to one-dimensional arrays
214          IF ( .NOT. use_particle_tails )  THEN
215!
216!--          All particles are output
217             ALLOCATE( psize(dvrp_nop), p_t(dvrp_nop), p_c(dvrp_nop), &
218                       p_x(dvrp_nop), p_y(dvrp_nop), p_z(dvrp_nop) )
219             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
220             p_z   = 0.0
221             k = 0
222             DO  n = 1, number_of_particles
223                IF ( dvrp_mask(n) )  THEN
224                   k = k + 1
225                   psize(k) = particles(n)%dvrp_psize
226                   p_x(k)   = particles(n)%x * superelevation_x
227                   p_y(k)   = particles(n)%y * superelevation_y
228                   p_z(k)   = particles(n)%z * superelevation
229                   p_c(k)   = particles(n)%color
230                ENDIF
231             ENDDO
232          ELSE
233!
234!--          Particles have a tail
235             ALLOCATE( psize(dvrp_not), p_t(dvrp_not),             &
236                       p_c(dvrp_not*maximum_number_of_tailpoints), &
237                       p_x(dvrp_not*maximum_number_of_tailpoints), &
238                       p_y(dvrp_not*maximum_number_of_tailpoints), &
239                       p_z(dvrp_not*maximum_number_of_tailpoints) )
240             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
241             p_z   = 0.0;
242             i = 0
243             k = 0
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,     &
277                                       interval_h_dvrp, interval_l_dvrp, &
278                                       interval_s_dvrp, interval_a_dvrp )
279
280             IF ( .NOT. use_particle_tails )  THEN
281                CALL DVRP_PARTICLES( m-1, dvrp_nop, p_x, p_y, p_z, 3, psize, &
282                                     p_c, p_t )
283             ELSE
284                CALL DVRP_PARTICLES( m-1, dvrp_not, p_x, p_y, p_z, 15, psize, &
285                                     p_c, p_t )
286             ENDIF
287          ENDIF
288
289          CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
290
291          DEALLOCATE( dvrp_mask, psize, p_c, p_t, p_x, p_y, p_z )
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
302          ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1, &
303                             nzb:nz_do3d) )
304
305!
306!--       Move original array to intermediate array
307          IF ( dvrp_overlap )  THEN
308
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
317                      ENDDO
318                   ENDDO
319!
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
326
327
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
334                      ENDDO
335                   ENDDO
336!
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
343
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
350                      ENDDO
351                   ENDDO
352! Averaging for Langmuir circulation
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
360!                      ENDDO
361!                   ENDDO
362
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
369                      ENDDO
370                   ENDDO
371
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
379                         ENDDO
380                      ENDDO
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
388                         ENDDO
389                      ENDDO
390                   ENDIF
391
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
399                         ENDDO
400                      ENDDO           
401                   ELSE                   
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', 0, 0, 0, 6, 0 )
406                   ENDIF
407             
408                CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
409                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
410                      DO  i = nxl_dvrp, nxr_dvrp+1
411                         DO  j = nys_dvrp, nyn_dvrp+1
412                            DO  k = nzb, nz_do3d
413                               local_pf(i,j,k) = ql(k,j,i)
414                            ENDDO
415                         ENDDO
416                      ENDDO
417                   ELSE                     
418                         message_string = 'if cloud_physics = FALSE ' // & 
419                                          'output of ' // TRIM( output_variable) // &
420                                          'is not provided' 
421                         CALL message( 'data_output_dvrp', 'PA0184', 0, 0, 0, 6, 0 )
422                   ENDIF
423
424                CASE ( 'u*_xy' )
425                   DO  i = nxl_dvrp, nxr_dvrp+1
426                      DO  j = nys_dvrp, nyn_dvrp+1
427                         local_pf(i,j,nzb+1) = us(j,i)
428                      ENDDO
429                   ENDDO
430                   slicer_position = zu(nzb+1)
431
432                CASE ( 't*_xy' )
433                   DO  i = nxl_dvrp, nxr_dvrp+1
434                      DO  j = nys_dvrp, nyn_dvrp+1
435                         local_pf(i,j,nzb+1) = ts(j,i)
436                      ENDDO
437                   ENDDO
438                   slicer_position = zu(nzb+1)
439
440
441                CASE DEFAULT
442!
443!--                The DEFAULT case is reached either if output_variable
444!--                contains unsupported variable or if the user has coded a
445!--                special case in the user interface. There, the subroutine
446!--                user_data_output_dvrp checks which of these two conditions
447!--                applies.
448                   CALL user_data_output_dvrp( output_variable, local_pf )
449
450
451             END SELECT
452
453          ENDIF
454
455          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
456!
457!--          DVRP-Calls for plotting isosurfaces:
458             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
459
460!
461!--          Definition of characteristics of isosurface material
462!--          Preliminary settings for w and pt!
463             IF ( output_variable == 'w' )  THEN
464                IF ( tv == 1 )  THEN
465                   tmp_r = 0.8;  tmp_g = 0.1;  tmp_b = 0.1;  tmp_t = 0.0
466                   CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
467                ELSE
468                   tmp_r = 0.1;  tmp_g = 0.1;  tmp_b = 0.8;  tmp_t = 0.0
469                   CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
470                ENDIF
471             ELSEIF ( output_variable == 'pt' )  THEN
472                tmp_r = 0.8;  tmp_g = 0.1;  tmp_b = 0.1;  tmp_t = 0.0
473                CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
474             ELSE
475                tmp_r = 0.9;  tmp_g = 0.9;  tmp_b = 0.9;  tmp_t = 0.0
476                CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
477             ENDIF
478
479!
480!--          Compute and plot isosurface in dvr-format
481             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
482                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
483
484             c_size_x = vc_size_x;  c_size_y = vc_size_y;  c_size_z = vc_size_z
485             CALL DVRP_CLUSTER_SIZE( m-1, c_size_x, c_size_y, c_size_z )
486
487             c_mode   = vc_mode
488             CALL DVRP_CLUSTERING_MODE( m-1, c_mode )
489
490             gradient_normals = vc_gradient_normals
491             CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
492!
493!--          A seperate procedure for setting vc_alpha will be in the next
494!--          version of libDVRP
495             tmp_c_alpha = vc_alpha
496             CALL DVRP_THRESHOLD( -(m-1)-1, tmp_c_alpha )
497
498             IF ( dvrp_overlap )  THEN
499                tmp_th = threshold(tv)
500             ELSE
501                tmp_th = 1.0   ! nothing is plotted because array values are 0
502             ENDIF
503
504             CALL DVRP_THRESHOLD( m-1, tmp_th )
505             CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
506
507             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
508
509          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
510!
511!--          DVRP-Calls for plotting slicers:
512             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
513
514!
515!--          Material and color definitions
516             tmp_r = 0.0;  tmp_g = 0.0;  tmp_b = 0.0;  tmp_t = 0.0
517             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
518
519             islice_dvrp = islice_dvrp + 1
520!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                    &
521!                                      slicer_range_limits_dvrp(:,islice_dvrp), &
522!                                      color_dvrp )
523
524             CALL user_dvrp_coltab( 'slicer', output_variable )
525
526             CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp,     &
527                                       interval_h_dvrp, interval_l_dvrp, &
528                                       interval_s_dvrp, interval_a_dvrp )
529
530!
531!--          Compute and plot slicer in dvr-format
532             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
533                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
534!             CALL DVRP_SLICER( m-1, section_mode, slicer_position )
535             tmp_pos = 1.0
536             CALL DVRP_SLICER( m-1, 2, tmp_pos )
537             WRITE (9,*) 'nx_dvrp=', nx_dvrp
538             WRITE (9,*) 'ny_dvrp=', ny_dvrp
539             WRITE (9,*) 'nz_dvrp=', nz_dvrp
540             WRITE (9,*) 'section_mode=', section_mode
541             WRITE (9,*) 'slicer_position=', slicer_position
542             CALL local_flush( 9 )
543
544             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
545
546             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
547
548          ENDIF
549
550          DEALLOCATE( local_pf )
551
552       ELSEIF ( mode_dvrp(m)(1:9) == 'pathlines' ) THEN
553
554          ALLOCATE( local_pfi(4,nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
555          DO  i = nxl, nxr+1
556             DO  j = nys, nyn+1
557                DO  k = nzb, nz_do3d
558                   local_pfi(1,i,j,k) = u(k,j,i)
559                   local_pfi(2,i,j,k) = v(k,j,i)
560                   local_pfi(3,i,j,k) = w(k,j,i)
561                   tmp_norm           = SQRT( u(k,j,i) * u(k,j,i) + &
562                                              v(k,j,i) * v(k,j,i) + &
563                                              w(k,j,i) * w(k,j,i) )
564                   tmp_alpha          = ACOS( 0.0 * u(k,j,i) / tmp_norm + &
565                                              0.0 * v(k,j,i) / tmp_norm - &
566                                              1.0 * w(k,j,i) / tmp_norm )
567                   tmp_alpha_w        = tmp_alpha / pi * 180.0
568                   local_pfi(4,i,j,k) = tmp_alpha_w
569                ENDDO
570             ENDDO
571          ENDDO
572
573          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'start' )
574
575          CALL DVRP_DATA( m-1, local_pfi, 4, nx_dvrp, ny_dvrp, nz_dvrp, &
576                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
577          CALL DVRP_VISUALIZE( m-1, 20, dvrp_filecount )
578
579          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'stop' )
580
581          DEALLOCATE( local_pfi )
582
583       ENDIF
584
585       m = m + 1
586
587    ENDDO
588
589    dvrp_filecount = dvrp_filecount + 1
590
591    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
592
593#endif
594 END SUBROUTINE data_output_dvrp
Note: See TracBrowser for help on using the repository browser.