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

Last change on this file since 1036 was 1036, checked in by raasch, 9 years ago

code has been put under the GNU General Public License (v3)

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