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

Last change on this file since 1 was 1, checked in by raasch, 15 years ago

Initial repository layout and content

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