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

Last change on this file since 83 was 83, checked in by raasch, 14 years ago

New:
---

Changed:


PALM can be generally installed on any kind of Linux-, IBM-AIX-, or NEC-SX-system by adding appropriate settings to the configuration file.

Scripts are also running under the public domain ksh.

All system relevant compile and link options as well as the host identifier (local_host) are specified in the configuration file.

Filetransfer by ftp removed (options -f removed from mrun and mbuild).

Call of (system-)FLUSH routine moved to new routine local_flush.

return_addres and return_username are read from ENVPAR-NAMELIST-file instead of using local_getenv.

Preprocessor strings for different linux clusters changed to "lc", some preprocessor directives renamed (new: intel_openmp_bug), preprocessor directives for old systems removed

advec_particles, check_open, cpu_log, cpu_statistics, data_output_dvrp, flow_statistics, header, init_dvrp, init_particles, init_1d_model, init_dvrp, init_pegrid, local_getenv, local_system, local_tremain, local_tremain_ini, modules, palm, parin, run_control

new:
local_flush

mbuild, mrun

Errors:


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