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

Last change on this file since 130 was 130, checked in by letzel, 17 years ago

DVRP output modifications:

  • The user can now visualize user-defined quantities using dvrp.

data_output_dvrp calls the new user_interface subroutine
user_data_output_dvrp in case of unknown variables (CASE DEFAULT).

  • Two instead of one digit are allowed to specify isosurface and slicer

variables with the parameter mode_dvrp.

  • Property svn:keywords set to Id
File size: 18.8 KB
Line 
1 MODULE dvrp_color
2
3    USE dvrp_variables
4
5    IMPLICIT NONE
6
7 CONTAINS
8
9    SUBROUTINE color_dvrp( value, color )
10
11       REAL, INTENT(IN)  ::  value
12       REAL, INTENT(OUT) ::  color(4)
13
14       REAL              ::  scale
15
16       scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) / &
17               ( slicer_range_limits_dvrp(2,islice_dvrp) -           &
18                 slicer_range_limits_dvrp(1,islice_dvrp) )
19
20       scale = MODULO( 180.0 + 180.0 * scale, 360.0 )
21
22       color = (/ scale, 0.5, 1.0, 0.0 /)
23
24    END SUBROUTINE color_dvrp
25
26 END MODULE dvrp_color
27
28
29 RECURSIVE SUBROUTINE data_output_dvrp
30
31!------------------------------------------------------------------------------!
32! Actual revisions:
33! -----------------
34! allow two instead of one digit to specify isosurface and slicer variables
35! for unknown variables (CASE DEFAULT) call new subroutine
36! user_data_output_dvrp
37! TEST: different colours for isosurfaces
38! TEST: write statements
39!
40! Former revisions:
41! -----------------
42! $Id: data_output_dvrp.f90 130 2007-11-13 14:08:40Z letzel $
43!
44! 82 2007-04-16 15:40:52Z raasch
45! Preprocessor strings for different linux clusters changed to "lc",
46! routine local_flush is used for buffer flushing
47!
48! 75 2007-03-22 09:54:05Z raasch
49! Particles-package is now part of the default code,
50! moisture renamed humidity
51!
52! RCS Log replace by Id keyword, revision history cleaned up
53!
54! Revision 1.13  2006/02/23 10:25:12  raasch
55! Former routine plot_dvrp renamed data_output_dvrp,
56! Only a fraction of the particles may have a tail,
57! pl.. replaced by do.., %size renamed %dvrp_psize
58!
59! Revision 1.1  2000/04/27 06:27:17  raasch
60! Initial revision
61!
62!
63! Description:
64! ------------
65! Plot of isosurface, particles and slicers with dvrp-software
66!------------------------------------------------------------------------------!
67#if defined( __dvrp_graphics )
68
69    USE arrays_3d
70    USE cloud_parameters
71    USE cpulog
72    USE DVRP
73    USE dvrp_color
74    USE dvrp_variables
75    USE grid_variables
76    USE indices
77    USE interfaces
78    USE particle_attributes
79    USE pegrid
80    USE control_parameters
81
82    IMPLICIT NONE
83
84    CHARACTER (LEN=2) ::  section_chr
85    CHARACTER (LEN=6) ::  output_variable
86    INTEGER ::  i, j, k, l, m, n, nn, section_mode, tv, vn
87    INTEGER, DIMENSION(:), ALLOCATABLE ::  p_c, p_t
88    REAL    ::  center(3), distance, slicer_position, surface_value
89    REAL, DIMENSION(:),     ALLOCATABLE ::  psize, p_x, p_y, p_z
90    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
91
92
93    WRITE ( 9, * ) '*** myid=', myid, ' Anfang data_output_dvrp'
94    CALL local_flush( 9 )
95    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
96
97!
98!-- Loop over all output modes choosed
99    m           = 1
100    tv          = 0  ! threshold counter
101    islice_dvrp = 0  ! slice plane counter
102    DO WHILE ( mode_dvrp(m) /= ' ' )
103!
104!--    Update of the steering variables
105       IF ( .NOT. lock_steering_update )  THEN
106!
107!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
108          lock_steering_update = .TRUE.
109!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: vor steering_update'
110!   CALL local_flush( 9 )
111          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
112!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: nach steering_update'
113!   CALL local_flush( 9 )
114          lock_steering_update = .FALSE.
115       ENDIF
116
117!
118!--    Determine the variable which shall be plotted (in case of slicers or
119!--    isosurfaces)
120       IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
121          READ ( mode_dvrp(m), '(10X,I2)' )  vn
122          output_variable = do3d(0,vn)
123          tv = tv + 1
124       ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
125          READ ( mode_dvrp(m), '(6X,I2)' )  vn
126          output_variable = do2d(0,vn)
127          l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
128          section_chr = do2d(0,vn)(l-1:l)
129          SELECT CASE ( section_chr )
130             CASE ( 'xy' )
131                section_mode = 2
132                slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
133             CASE ( 'xz' )
134                section_mode = 1
135                slicer_position = slicer_position_dvrp(m) * dy
136             CASE ( 'yz' )
137                section_mode = 0
138                slicer_position = slicer_position_dvrp(m) * dx
139          END SELECT
140       ENDIF
141
142!
143!--    Select the plot mode (in case of isosurface or slicer only if user has
144!--    defined a variable which shall be plotted; otherwise do nothing)
145       IF ( mode_dvrp(m)(1:9) == 'particles'  .AND.  particle_advection  .AND. &
146            simulated_time >= particle_advection_start )  THEN
147
148!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang particles'
149!   CALL local_flush( 9 )
150!
151!--       DVRP-Calls for plotting particles:
152          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
153
154!
155!--       Definition of characteristics of particle material
156!          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.1, 0.7, 0.1, 0.0 )
157          CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.0, 0.0, 0.0 )
158
159!
160!--       Move particle coordinates to one-dimensional arrays
161          IF ( .NOT. use_particle_tails )  THEN
162!
163!--          All particles are output
164             ALLOCATE( psize(number_of_particles), p_t(number_of_particles), &
165                       p_c(number_of_particles), p_x(number_of_particles),   &
166                       p_y(number_of_particles), p_z(number_of_particles) )
167             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
168             p_z   = 0.0;
169             psize = particles(1:number_of_particles)%dvrp_psize
170             p_x   = particles(1:number_of_particles)%x * superelevation_x
171             p_y   = particles(1:number_of_particles)%y * superelevation_y
172             p_z   = particles(1:number_of_particles)%z * superelevation
173             p_c   = particles(1:number_of_particles)%color
174          ELSE
175!
176!--          Particles have a tail
177!            WRITE (9,*) '--- before ALLOCATE  simtime=',simulated_time,' #of_tails=', number_of_tails, &
178!                          ' max#of_tp=', maximum_number_of_tailpoints
179!   CALL local_flush( 9 )
180             ALLOCATE( psize(number_of_tails), p_t(number_of_tails),      &
181                       p_c(number_of_tails*maximum_number_of_tailpoints), &
182                       p_x(number_of_tails*maximum_number_of_tailpoints), &
183                       p_y(number_of_tails*maximum_number_of_tailpoints), &
184                       p_z(number_of_tails*maximum_number_of_tailpoints) )
185!            WRITE (9,*) '--- after ALLOCATE'
186!   CALL local_flush( 9 )
187             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
188             p_z   = 0.0;
189             i = 0
190             k = 0
191             DO  n = 1, number_of_particles
192                nn = particles(n)%tail_id
193                IF ( nn /= 0 )  THEN
194                   k = k + 1
195!                  IF ( simulated_time > 1338.0 )  THEN
196!                     WRITE (9,*) '--- particle ',n,' tail_id=',nn,' #of_tp=',particles(n)%tailpoints
197!   CALL local_flush( 9 )
198!                  ENDIF
199                   DO  j = 1, particles(n)%tailpoints
200                      i = i + 1
201                      p_x(i) = particle_tail_coordinates(j,1,nn) * &
202                                                                superelevation_x
203                      p_y(i) = particle_tail_coordinates(j,2,nn) * &
204                                                                superelevation_y
205                      p_z(i) = particle_tail_coordinates(j,3,nn) * &
206                                                                superelevation
207                      p_c(i) = particle_tail_coordinates(j,4,nn)
208!                     IF ( simulated_time > 1338.0 )  THEN
209!                        WRITE (9,*) '--- tp= ',i,' x=',p_x(i),' y=',p_y(i), &
210!                                                ' z=',p_z(i),' c=',p_c(i)
211!   CALL local_flush( 9 )
212!                     ENDIF
213                   ENDDO
214                   psize(k) = particles(n)%dvrp_psize
215                   p_t(k)   = particles(n)%tailpoints - 1
216!                  IF ( simulated_time > 1338.0 )  THEN
217!                     WRITE (9,*) '--- t= ',k,' psize=',psize(k),' p_t=',p_t(k)
218!   CALL local_flush( 9 )
219!                  ENDIF
220                ENDIF               
221             ENDDO
222!            WRITE (9,*) '--- after locally storing the particle attributes'
223!   CALL local_flush( 9 )
224          ENDIF
225
226!
227!--       Compute and plot particles in dvr-format
228          IF ( uniform_particles  .AND.  .NOT. use_particle_tails )  THEN
229!
230!--          All particles have the same color. Use simple routine to set
231!--          the particle attributes (produces less output data)
232             CALL DVRP_PARTICLES( m-1, p_x, p_y, p_z, psize )
233          ELSE
234!
235!--          Set color definitions
236             CALL user_dvrp_coltab( 'particles', 'none' )
237
238             CALL DVRP_COLORTABLE_HLS( m-1, 0, interval_values_dvrp,     &
239                                       interval_h_dvrp, interval_l_dvrp, &
240                                       interval_s_dvrp, interval_a_dvrp )
241
242             IF ( .NOT. use_particle_tails )  THEN
243                CALL DVRP_PARTICLES( m-1, number_of_particles, p_x, p_y, p_z, &
244                                     3, psize, p_c, p_t )
245             ELSE
246!               WRITE (9,*) '--- before DVRP_PARTICLES'
247!   CALL local_flush( 9 )
248                CALL DVRP_PARTICLES( m-1, number_of_tails, p_x, p_y, p_z, 15, &
249                                     psize, p_c, p_t )
250!               WRITE (9,*) '--- after DVRP_PARTICLES'
251!               WRITE (9,*) 'm-1 = ',m-1
252!               WRITE (9,*) 'number_of_tails=', number_of_tails
253!               WRITE (9,*) 'p_x =', p_x
254!               WRITE (9,*) 'p_y =', p_y
255!               WRITE (9,*) 'p_z =', p_z
256!               WRITE (9,*) 'psize =', psize
257!               WRITE (9,*) 'p_c =', p_c
258!               WRITE (9,*) 'p_t =', p_t
259
260!   CALL local_flush( 9 )
261             ENDIF
262          ENDIF
263
264          CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
265!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende particles'
266!   CALL local_flush( 9 )
267
268          DEALLOCATE( psize, p_c, p_t, p_x, p_y, p_z )
269
270          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
271
272
273       ELSEIF ( ( mode_dvrp(m)(1:10) == 'isosurface'  .OR.   &
274                  mode_dvrp(m)(1:6)  == 'slicer'           ) &
275                  .AND.  output_variable /= ' ' )  THEN
276
277!
278!--       Create an intermediate array, properly dimensioned for plot-output
279          ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
280
281!
282!--       Move original array to intermediate array
283          SELECT CASE ( output_variable )
284
285             CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
286                DO  i = nxl, nxr+1
287                   DO  j = nys, nyn+1
288                      DO  k = nzb, nz_do3d
289                         local_pf(i,j,k) = u(k,j,i)
290                      ENDDO
291                   ENDDO
292                ENDDO
293!
294!--             Replace mirrored values at lower surface by real surface values
295                IF ( output_variable == 'u_xz'  .OR. &
296                     output_variable == 'u_yz' )  THEN
297                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
298                ENDIF
299
300
301             CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
302                DO  i = nxl, nxr+1
303                   DO  j = nys, nyn+1
304                      DO  k = nzb, nz_do3d
305                         local_pf(i,j,k) = v(k,j,i)
306                      ENDDO
307                   ENDDO
308                ENDDO
309!
310!--             Replace mirrored values at lower surface by real surface values
311                IF ( output_variable == 'v_xz'  .OR. &
312                     output_variable == 'v_yz' )  THEN
313                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
314                ENDIF
315
316             CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
317                DO  i = nxl, nxr+1
318                   DO  j = nys, nyn+1
319                      DO  k = nzb, nz_do3d
320                         local_pf(i,j,k) = w(k,j,i)
321                      ENDDO
322                   ENDDO
323                ENDDO
324! Averaging for Langmuir circulation
325!                DO  k = nzb, nz_do3d
326!                   DO  j = nys+1, nyn
327!                      DO  i = nxl, nxr+1
328!                         local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
329!                                           0.50 * local_pf(i,j,k)   + &
330!                                           0.25 * local_pf(i,j+1,k)
331!                      ENDDO
332!                   ENDDO
333!                ENDDO
334
335             CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
336                DO  i = nxl, nxr+1
337                   DO  j = nys, nyn+1
338                      DO  k = nzb, nz_do3d
339                         local_pf(i,j,k) = p(k,j,i)
340                      ENDDO
341                   ENDDO
342                ENDDO
343
344             CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
345                IF ( .NOT. cloud_physics ) THEN
346                   DO  i = nxl, nxr+1
347                      DO  j = nys, nyn+1
348                         DO  k = nzb, nz_do3d
349                            local_pf(i,j,k) = pt(k,j,i)
350                         ENDDO
351                      ENDDO
352                   ENDDO
353                ELSE
354                   DO  i = nxl, nxr+1
355                      DO  j = nys, nyn+1
356                         DO  k = nzb, nz_do3d
357                            local_pf(i,j,k) = pt(k,j,i) + l_d_cp * pt_d_t(k) * &
358                                                          ql(k,j,i)
359                         ENDDO
360                      ENDDO
361                   ENDDO
362                ENDIF
363
364             CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
365                IF ( humidity  .OR.  passive_scalar )  THEN
366                   DO  i = nxl, nxr+1
367                      DO  j = nys, nyn+1
368                         DO  k = nzb, nz_do3d
369                            local_pf(i,j,k) = q(k,j,i)
370                         ENDDO
371                      ENDDO
372                   ENDDO           
373                ELSE
374                   IF ( myid == 0 )  THEN
375                      PRINT*, '+++ data_output_dvrp: if humidity/passive_scalar = ', & 
376                              'FALSE output of ', output_variable,            &
377                              'is not provided' 
378                   ENDIF
379                ENDIF
380             
381             CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
382                IF ( cloud_physics  .OR.  cloud_droplets )  THEN
383                   DO  i = nxl, nxr+1
384                      DO  j = nys, nyn+1
385                         DO  k = nzb, nz_do3d
386                            local_pf(i,j,k) = ql(k,j,i)
387                         ENDDO
388                      ENDDO
389                   ENDDO
390                ELSE
391                   IF ( myid == 0 ) THEN
392                      PRINT*, '+++ data_output_dvrp: if cloud_physics = FALSE ', & 
393                              'output of ', output_variable, 'is not provided' 
394                   ENDIF
395                ENDIF
396
397             CASE ( 'u*_xy' )
398                DO  i = nxl, nxr+1
399                   DO  j = nys, nyn+1
400                      local_pf(i,j,nzb+1) = us(j,i)
401                   ENDDO
402                ENDDO
403                slicer_position = zu(nzb+1)
404
405             CASE ( 't*_xy' )
406                DO  i = nxl, nxr+1
407                   DO  j = nys, nyn+1
408                      local_pf(i,j,nzb+1) = ts(j,i)
409                   ENDDO
410                ENDDO
411                slicer_position = zu(nzb+1)
412
413
414             CASE DEFAULT
415!
416!--             The DEFAULT case is reached either if output_variable contains
417!--             unsupported variable or if the user has coded a special case in
418!--             the user interface. There, the subroutine user_data_output_dvrp
419!--             checks which of these two conditions applies.
420                CALL user_data_output_dvrp( output_variable, local_pf )
421
422
423          END SELECT
424
425
426          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
427
428!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang isosurface'
429!   CALL local_flush( 9 )
430!
431!--          DVRP-Calls for plotting isosurfaces:
432             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
433
434!
435!--          Definition of characteristics of isosurface material
436!--          Preliminary settings for w!
437             IF ( output_variable == 'w' )  THEN
438                IF ( tv == 1 )  THEN
439                   CALL DVRP_MATERIAL_RGB( m-1, 1, 0.8, 0.1, 0.1, 0.0 )
440                ELSE
441                   CALL DVRP_MATERIAL_RGB( m-1, 1, 0.1, 0.1, 0.8, 0.0 )
442                ENDIF
443             ELSE
444                CALL DVRP_MATERIAL_RGB( m-1, 1, 0.9, 0.9, 0.9, 0.0 )
445             ENDIF
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             CALL DVRP_THRESHOLD( m-1, threshold(tv) )
452             CALL DVRP_VISUALIZE( m-1, 1, dvrp_filecount )
453!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende isosurface'
454!   CALL local_flush( 9 )
455
456             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
457
458          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
459
460!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang slicer'
461!   CALL local_flush( 9 )
462!
463!--          DVRP-Calls for plotting slicers:
464             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
465
466!
467!--          Material and color definitions
468             CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.0, 0.0, 0.0 )
469
470             islice_dvrp = islice_dvrp + 1
471!             CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25,                    &
472!                                      slicer_range_limits_dvrp(:,islice_dvrp), &
473!                                      color_dvrp )
474
475             CALL user_dvrp_coltab( 'slicer', output_variable )
476
477             CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp,     &
478                                       interval_h_dvrp, interval_l_dvrp, &
479                                       interval_s_dvrp, interval_a_dvrp )
480
481!
482!--          Compute and plot slicer in dvr-format
483             CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
484                             cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
485!             CALL DVRP_SLICER( m-1, section_mode, slicer_position )
486             CALL DVRP_SLICER( m-1, 2, 1.0 )
487             WRITE (9,*) 'nx_dvrp=', nx_dvrp
488             WRITE (9,*) 'ny_dvrp=', ny_dvrp
489             WRITE (9,*) 'nz_dvrp=', nz_dvrp
490             WRITE (9,*) 'section_mode=', section_mode
491             WRITE (9,*) 'slicer_position=', slicer_position
492             CALL local_flush( 9 )
493
494             CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
495
496             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
497
498!   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende slicer'
499!   CALL local_flush( 9 )
500          ENDIF
501
502          DEALLOCATE( local_pf )
503
504       ENDIF
505
506       m = m + 1
507
508    ENDDO
509
510    dvrp_filecount = dvrp_filecount + 1
511
512    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
513!   WRITE ( 9, * ) '*** myid=', myid, ' Ende data_output_dvrp'
514!   CALL local_flush( 9 )
515
516#endif
517 END SUBROUTINE data_output_dvrp
Note: See TracBrowser for help on using the repository browser.