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

Last change on this file since 2000 was 2000, checked in by knoop, 5 years ago

Forced header and separation lines into 80 columns

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