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

Last change on this file since 1823 was 1823, checked in by hoffmann, 5 years ago

last commit documented

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