source: palm/tags/release-3.1c/SOURCE/data_output_dvrp.f90 @ 3452

Last change on this file since 3452 was 13, checked in by raasch, 17 years ago

flush calls adjusted

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