Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

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

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

New:
---

Adapted for machine lck
(mrun, mbuild, subjob)

bc_lr/bc_ns in most subroutines replaced by LOGICAL variables bc_lr_cyc,
bc_ns_cyc for speed optimization
(check_parameters, diffusion_u, diffusion_v, diffusion_w, modules)

Additional timestep criterion in case of simulations with plant canopy (timestep)

Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
(check_parameters)

Clipping of dvrp output implemented. Default colourtable for particles
implemented, particle attributes (color, dvrp_size) can be set with new
parameters particle_color, particle_dvrpsize, color_interval,
dvrpsize_interval (init_dvrp, data_output_dvrp, modules, user_data_output_dvrp).
Slicer attributes (dvrp) are set with new routine set_slicer_attributes_dvrp
and are controlled with existing parameters slicer_range_limits.
(set_slicer_attributes_dvrp)

Ocean atmosphere coupling allows to use independent precursor runs in order
to account for different spin-up times. The time when coupling has to be
started is given by new inipar parameter coupling_start_time. The precursor
ocean run has to be started using new mrun option "-y" in order to add
appendix "_O" to all output files.
(check_for_restart, check_parameters, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, header, init_coupling, modules, mrun,
parin, read_var_list, surface_coupler, time_integration, write_var_list)

Polygon reduction for topography and ground plate isosurface. Reduction level
for buildings can be chosen with parameter cluster_size. (init_dvrp)

External pressure gradient (check_parameters, header, init_3d_model, modules,
parin, prognostic_equations, read_var_list, write_var_list)

New topography case 'single_street_canyon' (header, init_grid, modules, parin,
read_var_list, user_check_parameters, user_header, user_init_grid, write_var_list)

Option to predefine a target bulk velocity for conserve_volume_flow
(check_parameters, header, init_3d_model, modules, parin, read_var_list,
write_var_list)

Option for user defined 2D data output in xy cross sections at z=nzb+1
(data_output_2d, user_data_output_2d)

xy cross section output of surface heatfluxes (latent, sensible)
(average_3d_data, check_parameters, data_output_2d, modules, read_3d_binary,
sum_up_3d_data, write_3d_binary)

average_3d_data, check_for_restart, check_parameters, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, init_coupling, init_dvrp, init_grid, init_3d_model, header, mbuild, modules, mrun, package_parin, parin, prognostic_equations, read_3d_binary, read_var_list, subjob, surface_coupler, timestep, time_integration, user_check_parameters, user_data_output_2d, user_data_output_dvrp, user_header, user_init_grid, write_3d_binary, write_var_list

New: set_particle_attributes, set_slicer_attributes_dvrp

Changed:

lcmuk changed to lc to avoid problems with Intel compiler on sgi-ice
(poisfft)

For extended NetCDF files, the updated title attribute includes an update of
time_average_text where appropriate. (netcdf)

In case of restart runs without extension, initial profiles are not written
to NetCDF-file anymore. (data_output_profiles, modules, read_var_list, write_var_list)

Small change in formatting of the message handling routine concering the output in the
job protocoll. (message)

initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
independent of turbulent_inflow (check_parameters, header, init_3d_model)

2 NetCDF error numbers changed. (data_output_3d)

A Link to the website appendix_a.html is printed for further information
about the possible errors. (message)

Temperature gradient criterion for estimating the boundary layer height
replaced by the gradient criterion of Sullivan et al. (1998). (flow_statistics)

NetCDF unit attribute in timeseries output in case of statistic regions added
(netcdf)

Output of NetCDF messages with aid of message handling routine.
(check_open, close_file, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, netcdf, output_particles_netcdf)

Output of messages replaced by message handling routine.
(advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart,
check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp,
data_output_profiles, data_output_spectra, fft_xy, flow_statistics, header,
init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
netcdf, parin, plant_canopy_model, poisfft_hybrid, poismg, read_3d_binary,
read_var_list, surface_coupler, temperton_fft, timestep, user_actions,
user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy,
user_parin, user_read_restart_data, user_spectra )

Maximum number of tails is calculated from maximum number of particles and
skip_particles_for_tail (init_particles)

Value of vertical_particle_advection may differ for each particle group
(advec_particles, header, modules)

First constant in array den also defined as type double. (eqn_state_seawater)

Parameter dvrp_psize moved from particles_par to dvrp_graphics_par. (package_parin)

topography_grid_convention moved from userpar to inipar (check_parameters,
header, parin, read_var_list, user_check_parameters, user_header,
user_init_grid, user_parin, write_var_list)

Default value of grid_matching changed to strict.

Adjustments for runs on lcxt4 (necessary due to an software update on CRAY) and
for coupled runs on ibmy (mrun, subjob)

advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, check_parameters, close_file, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, message, mrun, netcdf, output_particles_netcdf, package_parin, parin, plant_canopy_model, poisfft, poisfft_hybrid, poismg, read_3d_binary, read_var_list, sort_particles, subjob, user_check_parameters, user_header, user_init_grid, user_parin, surface_coupler, temperton_fft, timestep, user_actions, user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy, user_parin, user_read_restart_data, user_spectra, write_var_list

Errors:

Bugfix: Initial hydrostatic pressure profile in case of ocean runs is now
calculated in 5 iteration steps. (init_ocean)

Bugfix: wrong sign in buoyancy production of ocean part in case of not using
the reference density (only in 3D routine production_e) (production_e)

Bugfix: output of averaged 2d/3d quantities requires that an avaraging
interval has been set, respective error message is included (check_parameters)

Bugfix: Output on unit 14 only if requested by write_binary.
(user_last_actions)

Bugfix to avoid zero division by km_neutral (production_e)

Bugfix for extended NetCDF files: In order to avoid 'data mode' errors if
updated attributes are larger than their original size, NF90_PUT_ATT is called
in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
possible performance loss; an alternative strategy would be to ensure equal
attribute size in a job chain. (netcdf)

Bugfix: correction of initial volume flow for non-flat topography (init_3d_model)
Bugfix: zero initialization of arrays within buildings for 'cyclic_fill' (init_3d_model)

Bugfix: to_be_resorted => s_av for time-averaged scalars (data_output_2d, data_output_3d)

Bugfix: error in formatting the output (message)

Bugfix: avoid that ngp_2dh_s_inner becomes zero (init_3_model)

Typographical error: unit of wpt in dots_unit (modules)

Bugfix: error in check, if particles moved further than one subdomain length.
This check must not be applied for newly released particles. (advec_particles)

Bugfix: several tail counters are initialized, particle_tail_coordinates is
only written to file if its third index is > 0, arrays for tails are allocated
with a minimum size of 10 tails if there is no tail initially (init_particles,
advec_particles)

Bugfix: pressure included for profile output (check_parameters)

Bugfix: Type of count and count_rate changed to default INTEGER on NEC machines
(cpu_log)

Bugfix: output if particle time series only if particle advection is switched
on. (time_integration)

Bugfix: qsws was calculated in case of constant heatflux = .FALSE. (prandtl_fluxes)

Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0) (data_output_2d)

Typographical errors (netcdf)

If the inversion height calculated by the prerun is zero, inflow_damping_height
must be explicitly specified (init_3d_model)

Small bugfix concerning 3d 64bit netcdf output format (header)

Bugfix: dt_fixed removed from the restart file, because otherwise, no change
from a fixed to a variable timestep would be possible in restart runs.
(read_var_list, write_var_list)

Bugfix: initial setting of time_coupling in coupled restart runs (time_integration)

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