source: palm/tags/release-3.2/SOURCE/data_output_dvrp.f90 @ 336

Last change on this file since 336 was 77, checked in by raasch, 17 years ago

New:
---

particle reflection from vertical walls implemented, particle SGS model adjusted to walls

Wall functions for vertical walls now include diabatic conditions. New subroutines wall_fluxes, wall_fluxes_e. New 4D-array rif_wall.

new d3par-parameter netcdf_64bit_3d to switch on 64bit offset only for 3D files

new d3par-parameter dt_max to define the maximum value for the allowed timestep

new inipar-parameter loop_optimization to control the loop optimization method

new inipar-parameter pt_refrence. If given, this value is used as the reference that in buoyancy terms (otherwise, the instantaneous horizontally averaged temperature is used).

new user interface user_advec_particles

new initializing action "by_user" calls user_init_3d_model and allows the initial setting of all 3d arrays

topography height informations are stored on arrays zu_s_inner and zw_w_inner and output to the 2d/3d NetCDF files

samples added to the user interface which show how to add user-define time series quantities.

calculation/output of precipitation amount, precipitation rate and z0 (by setting "pra*", "prr*", "z0*" with data_output). The time interval on which the precipitation amount is defined is set by new d3par-parameter precipitation_amount_interval

unit 9 opened for debug output (file DEBUG_<pe#>)

Makefile, advec_particles, average_3d_data, buoyancy, calc_precipitation, check_open, check_parameters, data_output_2d, diffusion_e, diffusion_u, diffusion_v, diffusion_w, diffusivities, header, impact_of_latent_heat, init_particles, init_3d_model, modules, netcdf, parin, production_e, read_var_list, read_3d_binary, sum_up_3d_data, user_interface, write_var_list, write_3d_binary

New: wall_fluxes

Changed:


General revision of non-cyclic horizontal boundary conditions: radiation boundary conditions are now used instead of Neumann conditions at the outflow (calculation needs velocity values for t-dt, which are stored on new arrays u_m_l, u_m_r, etc.), calculation of mean outflow is not needed any more, volume flow control is added for the outflow boundary (currently only for the north boundary!!), additional gridpoints along x and y (uxrp, vynp) are not needed any more, routine "boundary_conds" now operates on timelevel t+dt and is not split in two parts (main, uvw_outflow) any more, Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary conditions for all 2d-arrays that are handled by exchange_horiz_2d

The FFT-method for solving the Poisson-equation is now working with Neumann boundary conditions both at the bottom and the top. This requires adjustments of the tridiagonal coefficients and subtracting the horizontally averaged mean from the vertical velocity field.

+age_m in particle_type

Particles-package is now part of the default code ("-p particles" is not needed any more).

Move call of user_actions( 'after_integration' ) below increment of times
and counters. user_actions is now called for each statistic region and has as an argument the number of the respective region (sr)

d3par-parameter data_output_ts removed. Timeseries output for "profil" removed. Timeseries are now switched on by dt_dots. Timeseries data is collected in flow_statistics.

Initial velocities at nzb+1 are regarded for volume flow control in case they have been set zero before (to avoid small timesteps); see new internal parameters u/v_nzb_p1_for_vfc.

q is not allowed to become negative (prognostic_equations).

poisfft_init is only called if fft-solver is switched on (init_pegrid).

d3par-parameter moisture renamed to humidity.

Subversion global revision number is read from mrun and added to the run description header and to the run control (_rc) file.

vtk directives removed from main program.

The uitility routine interpret_config reads PALM environment variables from NAMELIST instead using the system call GETENV.

advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, asselin_filter, check_parameters, coriolis, data_output_dvrp, data_output_ptseries, data_output_ts, data_output_2d, data_output_3d, diffusion_u, diffusion_v, exchange_horiz, exchange_horiz_2d, flow_statistics, header, init_grid, init_particles, init_pegrid, init_rankine, init_pt_anomaly, init_1d_model, init_3d_model, modules, palm, package_parin, parin, poisfft, poismg, prandtl_fluxes, pres, production_e, prognostic_equations, read_var_list, read_3d_binary, sor, swap_timelevel, time_integration, write_var_list, write_3d_binary

Errors:


Bugfix: preset of tendencies te_em, te_um, te_vm in init_1d_model

Bugfix in sample for reading user defined data from restart file (user_init)

Bugfix in setting diffusivities for cases with the outflow damping layer extending over more than one subdomain (init_3d_model)

Check for possible negative humidities in the initial humidity profile.

in Makefile, default suffixes removed from the suffix list to avoid calling of m2c in
# case of .mod files

Makefile
check_parameters, init_1d_model, init_3d_model, user_interface

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