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

Last change on this file since 3421 was 3421, checked in by gronemeier, 5 years ago

new surface-data output; renamed output variables (pt to theta, rho_air to rho, rho_ocean to rho_sea_water)

  • Property svn:keywords set to Id
File size: 21.1 KB
RevLine 
[1873]1!> @file data_output_dvrp.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
[1036]9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
[2718]17! Copyright 1997-2018 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[254]20! Current revisions:
[1]21! -----------------
[1354]22!
[2001]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: data_output_dvrp.f90 3421 2018-10-24 18:39:32Z gronemeier $
[3421]27! Renamed output variables
28!
29! 3419 2018-10-24 17:27:31Z gronemeier
[3274]30! Modularization of all bulk cloud physics code components
31!
32! 3045 2018-05-28 07:55:41Z Giersch
[3045]33! Code adjusted according to PALM coding standards
34!
35! 2718 2018-01-02 08:49:38Z maronga
[2716]36! Corrected "Former revisions" section
37!
38! 2696 2017-12-14 17:12:51Z kanani
39! Change in file header (GPL part)
40!
41! 2274 2017-06-09 13:27:48Z Giersch
[2274]42! Changed error messages
43!
44! 2101 2017-01-05 16:42:31Z suehring
[1321]45!
[2001]46! 2000 2016-08-20 18:09:15Z knoop
47! Forced header and separation lines into 80 columns
48!
[1961]49! 1960 2016-07-12 16:34:24Z suehring
50! Separate humidity and passive scalar
51!
[1874]52! 1873 2016-04-18 14:50:06Z maronga
53! Module renamed (removed _mod)
54!
55!
[1851]56! 1850 2016-04-08 13:29:27Z maronga
57! Module renamed
58!
59!
[1823]60! 1822 2016-04-07 07:49:42Z hoffmann
61! Particles and tails removed.
62!
[1683]63! 1682 2015-10-07 23:56:08Z knoop
64! Code annotations made doxygen readable
65!
[1354]66! 1353 2014-04-08 15:21:23Z heinze
67! REAL constants provided with KIND-attribute
68!
[1347]69! 1346 2014-03-27 13:18:20Z heinze
70! Bugfix: REAL constants provided with KIND-attribute especially in call of
71! intrinsic function like MAX, MIN, SIGN
72!
[1321]73! 1320 2014-03-20 08:40:49Z raasch
[1320]74! ONLY-attribute added to USE-statements,
75! kind-parameters added to all INTEGER and REAL declaration statements,
76! kinds are defined in new module kinds,
77! revision history before 2012 removed,
78! comment fields (!:) to be used for variable explanations added to
79! all variable declaration statements
[1]80!
[1319]81! 1318 2014-03-17 13:35:16Z raasch
82! module interfaces removed
83!
[1037]84! 1036 2012-10-22 13:43:42Z raasch
85! code put under GPL (PALM 3.9)
86!
[829]87! 828 2012-02-21 12:00:36Z raasch
88! particle feature color renamed class
89!
[1]90! Revision 1.1  2000/04/27 06:27:17  raasch
91! Initial revision
92!
93!
94! Description:
95! ------------
[1822]96!> Plot of isosurface and slicers with dvrp-software
[1]97!------------------------------------------------------------------------------!
[1682]98 MODULE dvrp_color
99 
[1036]100
101    USE dvrp_variables
[1320]102   
103    USE kinds
[1036]104
105    IMPLICIT NONE
106
107 CONTAINS
108
[1682]109!------------------------------------------------------------------------------!
110! Description:
111! ------------
112!> @todo Missing subroutine description.
113!------------------------------------------------------------------------------!
[1036]114    SUBROUTINE color_dvrp( value, color )
115
[1682]116       REAL(wp), INTENT(IN)  ::  value    !<
117       REAL(wp), INTENT(OUT) ::  color(4) !<
[1036]118
[1682]119       REAL(wp)              ::  scale    !<
[1036]120
[1320]121       scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) /           &
122               ( slicer_range_limits_dvrp(2,islice_dvrp) -                     &
[1036]123                 slicer_range_limits_dvrp(1,islice_dvrp) )
124
[1353]125       scale = MODULO( 180.0_wp + 180.0_wp * scale, 360.0_wp )
[1036]126
[1320]127       color = (/ scale, 0.5_wp, 1.0_wp, 0.0_wp /)
[1036]128
129    END SUBROUTINE color_dvrp
130
131 END MODULE dvrp_color
132
133
134 RECURSIVE SUBROUTINE data_output_dvrp
135
[1]136#if defined( __dvrp_graphics )
137
[1320]138    USE arrays_3d,                                                             &
[3274]139        ONLY:  p, pt, q, ql, s, ts, u, us, v, w, zu, d_exner
140
141    USE basic_constants_and_equations_mod,                                     &
142        ONLY:  pi, lv_d_cp
143
[1320]144    USE control_parameters,                                                    &
[3274]145        ONLY:  cloud_droplets, do2d, do3d, humidity, ibc_uv_b,                 &
[1320]146               message_string, nz_do3d, passive_scalar, simulated_time,        &
147               threshold
148       
149    USE cpulog,                                                                &
150        ONLY:  log_point, log_point_s, cpu_log
151       
[1]152    USE DVRP
[1320]153   
[1]154    USE dvrp_color
[1320]155       
[1]156    USE dvrp_variables
[1320]157       
158    USE grid_variables,                                                        &
159        ONLY:  dx, dy
160       
161    USE indices,                                                               &
162        ONLY:  nxl, nxr, nyn, nys, nzb
163       
164    USE kinds
[1822]165
[3274]166    USE bulk_cloud_model_mod,                                                  &
167        ONLY:  bulk_cloud_model
168
[1]169    USE pegrid
170
171    IMPLICIT NONE
172
[1682]173    CHARACTER (LEN=2) ::  section_chr      !<
174    CHARACTER (LEN=6) ::  output_variable  !<
[1320]175   
[1682]176    INTEGER(iwp) ::  c_mode           !< 
177    INTEGER(iwp) ::  c_size_x         !<
178    INTEGER(iwp) ::  c_size_y         !<
179    INTEGER(iwp) ::  c_size_z         !<
180    INTEGER(iwp) ::  dvrp_nop         !<
181    INTEGER(iwp) ::  dvrp_not         !<
182    INTEGER(iwp) ::  gradient_normals !<
183    INTEGER(iwp) ::  i                !<
184    INTEGER(iwp) ::  ip               !<
185    INTEGER(iwp) ::  j                !<
186    INTEGER(iwp) ::  jp               !<
187    INTEGER(iwp) ::  k                !<
188    INTEGER(iwp) ::  l                !<
189    INTEGER(iwp) ::  m                !<
190    INTEGER(iwp) ::  n                !<
191    INTEGER(iwp) ::  n_isosurface     !<
192    INTEGER(iwp) ::  n_slicer         !<
193    INTEGER(iwp) ::  nn               !<
194    INTEGER(iwp) ::  section_mode     !<
195    INTEGER(iwp) ::  vn               !<
196    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_c  !<
197    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  p_t  !<
[242]198
[1682]199    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask  !<
[242]200
[1682]201    REAL(sp) ::  slicer_position  !<
202    REAL(sp) ::  tmp_alpha        !<
203    REAL(sp) ::  tmp_alpha_w      !<
204    REAL(sp) ::  tmp_b            !<
205    REAL(sp) ::  tmp_c_alpha      !<
206    REAL(sp) ::  tmp_g            !<
207    REAL(sp) ::  tmp_norm         !<
208    REAL(sp) ::  tmp_pos          !<
209    REAL(sp) ::  tmp_r            !<
210    REAL(sp) ::  tmp_t            !<
211    REAL(sp) ::  tmp_th           !<
212    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  psize  !<
213    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_x    !<
214    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_y    !<
215    REAL(sp), DIMENSION(:),     ALLOCATABLE   ::  p_z    !<
216    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE   ::  local_pf  !<
217    REAL(sp), DIMENSION(:,:,:,:), ALLOCATABLE ::  local_pfi !<
[1]218
219
220    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
221
222!
223!-- Loop over all output modes choosed
[284]224    m            = 1
225    n_isosurface = 0  ! isosurface counter (for threshold values and color)
226    n_slicer     = 0  ! slice plane counter (for range of values)
[1]227    DO WHILE ( mode_dvrp(m) /= ' ' )
228!
229!--    Update of the steering variables
230       IF ( .NOT. lock_steering_update )  THEN
231!
232!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
233          lock_steering_update = .TRUE.
[210]234!          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
[1]235          lock_steering_update = .FALSE.
236       ENDIF
237
238!
239!--    Determine the variable which shall be plotted (in case of slicers or
240!--    isosurfaces)
241       IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
[130]242          READ ( mode_dvrp(m), '(10X,I2)' )  vn
[1]243          output_variable = do3d(0,vn)
[284]244          n_isosurface = n_isosurface + 1
[1]245       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
[130]246          READ ( mode_dvrp(m), '(6X,I2)' )  vn
[1]247          output_variable = do2d(0,vn)
248          l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
249          section_chr = do2d(0,vn)(l-1:l)
250          SELECT CASE ( section_chr )
251             CASE ( 'xy' )
252                section_mode = 2
253                slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
254             CASE ( 'xz' )
255                section_mode = 1
256                slicer_position = slicer_position_dvrp(m) * dy
257             CASE ( 'yz' )
258                section_mode = 0
259                slicer_position = slicer_position_dvrp(m) * dx
260          END SELECT
261       ENDIF
262
263!
264!--    Select the plot mode (in case of isosurface or slicer only if user has
265!--    defined a variable which shall be plotted; otherwise do nothing)
[3045]266       IF ( ( mode_dvrp(m)(1:10) == 'isosurface'  .OR.                         &
[1353]267                  mode_dvrp(m)(1:6)  == 'slicer'           )                   &
[1]268                  .AND.  output_variable /= ' ' )  THEN
269
270!
271!--       Create an intermediate array, properly dimensioned for plot-output
[1353]272          ALLOCATE( local_pf(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1,          &
[246]273                             nzb:nz_do3d) )
[1]274
275!
276!--       Move original array to intermediate array
[246]277          IF ( dvrp_overlap )  THEN
[1]278
[246]279             SELECT CASE ( output_variable )
280
281                CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
282                   DO  i = nxl_dvrp, nxr_dvrp+1
283                      DO  j = nys_dvrp, nyn_dvrp+1
284                         DO  k = nzb, nz_do3d
285                            local_pf(i,j,k) = u(k,j,i)
286                         ENDDO
[1]287                      ENDDO
288                   ENDDO
289!
[246]290!--                Replace mirrored values at lower surface by real surface
291!--                values
[1353]292                   IF ( output_variable == 'u_xz'  .OR.                        &
[246]293                        output_variable == 'u_yz' )  THEN
[1353]294                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
[246]295                   ENDIF
[1]296
297
[246]298                CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
299                   DO  i = nxl_dvrp, nxr_dvrp+1
300                      DO  j = nys_dvrp, nyn_dvrp+1
301                         DO  k = nzb, nz_do3d
302                            local_pf(i,j,k) = v(k,j,i)
303                         ENDDO
[1]304                      ENDDO
305                   ENDDO
306!
[246]307!--                Replace mirrored values at lower surface by real surface
308!--                values
[1353]309                   IF ( output_variable == 'v_xz'  .OR.                        &
[246]310                        output_variable == 'v_yz' )  THEN
[1353]311                      IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0_wp
[246]312                   ENDIF
[1]313
[246]314                CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
315                   DO  i = nxl_dvrp, nxr_dvrp+1
316                      DO  j = nys_dvrp, nyn_dvrp+1
317                         DO  k = nzb, nz_do3d
318                            local_pf(i,j,k) = w(k,j,i)
319                         ENDDO
[1]320                      ENDDO
321                   ENDDO
[106]322! Averaging for Langmuir circulation
[246]323!                   DO  k = nzb, nz_do3d
324!                      DO  j = nys_dvrp+1, nyn_dvrp
325!                         DO  i = nxl_dvrp, nxr_dvrp+1
326!                            local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
327!                                              0.50 * local_pf(i,j,k)   + &
328!                                              0.25 * local_pf(i,j+1,k)
329!                         ENDDO
[106]330!                      ENDDO
331!                   ENDDO
[1]332
[246]333                CASE ( 'p', 'p_xy', 'p_xz', 'p_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) = p(k,j,i)
338                         ENDDO
[1]339                      ENDDO
340                   ENDDO
341
[3421]342                CASE ( 'theta', 'theta_xy', 'theta_xz', 'theta_yz' )
[3274]343                   IF ( .NOT. bulk_cloud_model ) THEN
[246]344                      DO  i = nxl_dvrp, nxr_dvrp+1
345                         DO  j = nys_dvrp, nyn_dvrp+1
346                            DO  k = nzb, nz_do3d
347                               local_pf(i,j,k) = pt(k,j,i)
348                            ENDDO
[1]349                         ENDDO
350                      ENDDO
[246]351                   ELSE
352                      DO  i = nxl_dvrp, nxr_dvrp+1
353                         DO  j = nys_dvrp, nyn_dvrp+1
354                            DO  k = nzb, nz_do3d
[3274]355                               local_pf(i,j,k) = pt(k,j,i) + lv_d_cp *         &
356                                                 d_exner(k) * ql(k,j,i)
[246]357                            ENDDO
[1]358                         ENDDO
359                      ENDDO
[246]360                   ENDIF
[1]361
[246]362                CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
[1960]363                   IF ( humidity )  THEN
[246]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) = q(k,j,i)
368                            ENDDO
[1]369                         ENDDO
[246]370                      ENDDO           
[254]371                   ELSE                   
[1960]372                      message_string = 'if humidity = '    //                  & 
[3045]373                            '.FALSE. output of ' // TRIM( output_variable ) // &
[274]374                            'is not provided' 
375                      CALL message( 'data_output_dvrp', 'PA0183',&
376                                                                 0, 0, 0, 6, 0 )
[1]377                   ENDIF
378             
[246]379                CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
[3274]380                   IF ( bulk_cloud_model  .OR.  cloud_droplets )  THEN
[246]381                      DO  i = nxl_dvrp, nxr_dvrp+1
382                         DO  j = nys_dvrp, nyn_dvrp+1
383                            DO  k = nzb, nz_do3d
384                               local_pf(i,j,k) = ql(k,j,i)
385                            ENDDO
[1]386                         ENDDO
387                      ENDDO
[254]388                   ELSE                     
[3274]389                      message_string = 'if bulk_cloud_model = .FALSE. and ' // &
[2274]390                                  'cloud_droplets = .FALSE. '
[1353]391                                  'output of ' // TRIM( output_variable) //    &
[274]392                                  'is not provided' 
393                      CALL message( 'data_output_dvrp', 'PA0184',&
394                                                                 0, 0, 0, 6, 0 )
[1]395                   ENDIF
396
[1960]397                CASE ( 's', 's_xy', 's_xz', 's_yz' )
398                   IF ( passive_scalar )  THEN
399                      DO  i = nxl_dvrp, nxr_dvrp+1
400                         DO  j = nys_dvrp, nyn_dvrp+1
401                            DO  k = nzb, nz_do3d
402                               local_pf(i,j,k) = s(k,j,i)
403                            ENDDO
404                         ENDDO
405                      ENDDO           
406                   ELSE                   
407                      message_string = 'if passive_scalar = '    //            & 
[2274]408                            '.FALSE. output of ' // TRIM( output_variable ) //   &
[1960]409                            'is not provided' 
410                      CALL message( 'data_output_dvrp', 'PA0183',&
411                                                                 0, 0, 0, 6, 0 )
412                   ENDIF
413
[3421]414                CASE ( 'us*_xy' )
[246]415                   DO  i = nxl_dvrp, nxr_dvrp+1
416                      DO  j = nys_dvrp, nyn_dvrp+1
417                         local_pf(i,j,nzb+1) = us(j,i)
418                      ENDDO
[1]419                   ENDDO
[246]420                   slicer_position = zu(nzb+1)
[1]421
[246]422                CASE ( 't*_xy' )
423                   DO  i = nxl_dvrp, nxr_dvrp+1
424                      DO  j = nys_dvrp, nyn_dvrp+1
425                         local_pf(i,j,nzb+1) = ts(j,i)
426                      ENDDO
[1]427                   ENDDO
[246]428                   slicer_position = zu(nzb+1)
[1]429
430
[246]431                CASE DEFAULT
[130]432!
[246]433!--                The DEFAULT case is reached either if output_variable
434!--                contains unsupported variable or if the user has coded a
435!--                special case in the user interface. There, the subroutine
436!--                user_data_output_dvrp checks which of these two conditions
437!--                applies.
438                   CALL user_data_output_dvrp( output_variable, local_pf )
[1]439
[130]440
[246]441             END SELECT
[1]442
[264]443          ELSE
444!
445!--          No overlap of clipping domain with the current subdomain
446             DO  i = nxl_dvrp, nxr_dvrp+1
447                DO  j = nys_dvrp, nyn_dvrp+1
448                   DO  k = nzb, nz_do3d
[1353]449                      local_pf(i,j,k) = 0.0_wp
[264]450                   ENDDO
451                ENDDO
452             ENDDO
453
[246]454          ENDIF
[1]455
456          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
[392]457
[1]458!
459!--          DVRP-Calls for plotting isosurfaces:
460             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
461
462!
[284]463!--          Definition of isosurface color
464             tmp_r = isosurface_color(1,n_isosurface)
465             tmp_g = isosurface_color(2,n_isosurface)
466             tmp_b = isosurface_color(3,n_isosurface)
[1353]467             tmp_t = 0.0_wp
[284]468             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
[1]469
470!
471!--          Compute and plot isosurface in dvr-format
[1353]472             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp,      &
[1]473                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
[210]474
475             c_size_x = vc_size_x;  c_size_y = vc_size_y;  c_size_z = vc_size_z
476             CALL DVRP_CLUSTER_SIZE( m-1, c_size_x, c_size_y, c_size_z )
477
478             c_mode   = vc_mode 
479             CALL DVRP_CLUSTERING_MODE( m-1, c_mode )
480
481             gradient_normals = vc_gradient_normals
482             CALL DVRP_GRADIENTNORMALS( m-1, gradient_normals )
[392]483
[210]484!
485!--          A seperate procedure for setting vc_alpha will be in the next
486!--          version of libDVRP
487             tmp_c_alpha = vc_alpha 
488             CALL DVRP_THRESHOLD( -(m-1)-1, tmp_c_alpha )
489
[246]490             IF ( dvrp_overlap )  THEN
[284]491                tmp_th = threshold(n_isosurface)
[246]492             ELSE
[1353]493                tmp_th = 1.0_wp  ! nothing is plotted because array values are 0
[246]494             ENDIF
495
[210]496             CALL DVRP_THRESHOLD( m-1, tmp_th )
[392]497
[210]498             CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
499
[1]500             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
501
502          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
[392]503
[1]504!
505!--          DVRP-Calls for plotting slicers:
506             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
507
508!
509!--          Material and color definitions
[1353]510             tmp_r = 0.0_wp;  tmp_g = 0.0_wp;  tmp_b = 0.0_wp;  tmp_t = 0.0_wp
[210]511             CALL DVRP_MATERIAL_RGB( m-1, 1, tmp_r, tmp_g, tmp_b, tmp_t )
[1]512
[284]513             n_slicer = n_slicer + 1
514
515!
516!--           Using dolorfunction has not been properly tested
517!             islice_dvrp = n_slicer
518!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                 &
519!                                      slicer_range_limits_dvrp(:,n_slicer), &
[1]520!                                      color_dvrp )
521
[284]522!
523!--          Set interval of values defining the colortable
524             CALL set_slicer_attributes_dvrp( n_slicer )
525
526!
527!--          Create user-defined colortable
[1]528             CALL user_dvrp_coltab( 'slicer', output_variable )
529
[1353]530             CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp,           &
531                                       interval_h_dvrp, interval_l_dvrp,       &
[1]532                                       interval_s_dvrp, interval_a_dvrp )
533
534!
535!--          Compute and plot slicer in dvr-format
[1353]536             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp,      &
[1]537                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
[262]538             tmp_pos = slicer_position
539             CALL DVRP_SLICER( m-1, section_mode, tmp_pos )
[106]540
[1]541             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
542
543             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
544
545          ENDIF
546
547          DEALLOCATE( local_pf )
548
[210]549       ELSEIF ( mode_dvrp(m)(1:9) == 'pathlines' ) THEN
550
551          ALLOCATE( local_pfi(4,nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
552          DO  i = nxl, nxr+1
553             DO  j = nys, nyn+1
554                DO  k = nzb, nz_do3d
555                   local_pfi(1,i,j,k) = u(k,j,i)
556                   local_pfi(2,i,j,k) = v(k,j,i)
557                   local_pfi(3,i,j,k) = w(k,j,i)
[1353]558                   tmp_norm           = SQRT( u(k,j,i) * u(k,j,i) +            &
559                                              v(k,j,i) * v(k,j,i) +            &
[210]560                                              w(k,j,i) * w(k,j,i) )
[1353]561                   tmp_alpha          = ACOS( 0.0_wp * u(k,j,i) / tmp_norm +   &
562                                              0.0_wp * v(k,j,i) / tmp_norm -   &
563                                              1.0_wp * w(k,j,i) / tmp_norm )
564                   tmp_alpha_w        = tmp_alpha / pi * 180.0_wp
[210]565                   local_pfi(4,i,j,k) = tmp_alpha_w
566                ENDDO
567             ENDDO
568          ENDDO
569
570          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'start' )
571
[3045]572          CALL DVRP_DATA( m-1, local_pfi, 4, nx_dvrp, ny_dvrp, nz_dvrp,        &
[210]573                          cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
574          CALL DVRP_VISUALIZE( m-1, 20, dvrp_filecount )
575
576          CALL cpu_log( log_point_s(31), 'dvrp_pathlines', 'stop' )
577
578          DEALLOCATE( local_pfi )
579
[1]580       ENDIF
581
582       m = m + 1
583
584    ENDDO
585
586    dvrp_filecount = dvrp_filecount + 1
587
588    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
589
590#endif
591 END SUBROUTINE data_output_dvrp
Note: See TracBrowser for help on using the repository browser.