source: palm/tags/release-3.1b/SOURCE/data_output_dvrp.f90 @ 3806

Last change on this file since 3806 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

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