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

Last change on this file since 3016 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

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