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

Last change on this file since 82 was 82, checked in by raasch, 14 years ago

vorlaeufige Standalone-Version fuer Linux-Cluster

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