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

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

preliminary update for changes concerning non-cyclic boundary conditions

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