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

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

updates in dvr routines for new dvr version

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