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

Last change on this file since 1873 was 1873, checked in by maronga, 8 years ago

revised renaming of modules

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