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

Last change on this file since 1961 was 1961, checked in by suehring, 5 years ago

last commit documented

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