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

Last change on this file since 237 was 226, checked in by raasch, 16 years ago

preparations for the next release

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