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

Last change on this file since 1904 was 1874, checked in by maronga, 9 years ago

last commit documented

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