Ignore:
Timestamp:
Feb 23, 2009 1:03:18 PM (13 years ago)
Author:
raasch
Message:

further additions for clipping - still incomplete

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/data_output_dvrp.f90

    r226 r242  
    3333! -----------------
    3434! TEST: different colours for isosurfaces
    35 ! TEST: write statements
    3635!
    3736! Former revisions:
     
    9089    CHARACTER (LEN=2) ::  section_chr
    9190    CHARACTER (LEN=6) ::  output_variable
    92     INTEGER ::  c_mode, c_size_x, c_size_y, c_size_z, gradient_normals, i, j, &
    93                 k, l, m, n, nn, section_mode, tv, vn
     91    INTEGER ::  c_mode, c_size_x, c_size_y, c_size_z, dvrp_nop, dvrp_not,     &
     92                gradient_normals, i, ip, j, jp, k, l, m, n, nn, section_mode, &
     93                tv, vn
    9494    INTEGER, DIMENSION(:), ALLOCATABLE ::  p_c, p_t
     95
     96    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dvrp_mask
     97
    9598    REAL(4) ::  center(3), distance, slicer_position, surface_value,         &
    9699                tmp_alpha, tmp_alpha_w, tmp_b, tmp_c_alpha, tmp_g, tmp_norm, &
     
    101104
    102105
    103     WRITE ( 9, * ) '*** myid=', myid, ' Anfang data_output_dvrp'
    104     CALL local_flush( 9 )
    105106    CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
    106107
     
    117118!--       Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
    118119          lock_steering_update = .TRUE.
    119 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: vor steering_update'
    120 !   CALL local_flush( 9 )
    121120!          CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
    122 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: nach steering_update'
    123 !   CALL local_flush( 9 )
    124121          lock_steering_update = .FALSE.
    125122       ENDIF
     
    155152       IF ( mode_dvrp(m)(1:9) == 'particles'  .AND.  particle_advection  .AND. &
    156153            simulated_time >= particle_advection_start )  THEN
    157 
    158 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang particles'
    159 !   CALL local_flush( 9 )
    160154!
    161155!--       DVRP-Calls for plotting particles:
     
    169163
    170164!
     165!--       If clipping is active and if this subdomain is clipped, find out the
     166!--       number of particles and tails to be plotted; otherwise, all
     167!--       particles/tails are plotted
     168          IF ( .NOT. use_particle_tails )  THEN
     169             ALLOCATE( dvrp_mask(number_of_particles) )
     170          ELSE
     171             ALLOCATE( dvrp_mask(number_of_tails*maximum_number_of_tailpoints) )
     172          ENDIF
     173          dvrp_mask = .TRUE.
     174          IF ( dvrp_total_overlap )  THEN
     175             dvrp_nop = number_of_particles
     176             dvrp_not = number_of_tails
     177          ELSE
     178             dvrp_nop = 0
     179             dvrp_not = 0
     180             IF ( dvrp_overlap )  THEN
     181                IF ( .NOT. use_particle_tails )  THEN
     182                   DO  n = 1, number_of_particles
     183                      ip = particles(n)%x / dx
     184                      jp = particles(n)%y / dy
     185                      IF ( ip >= nxl_dvrp  .AND.  ip <= nxr_dvrp  .AND.  &
     186                           jp >= nys_dvrp  .AND.  jp <= nyn_dvrp )  THEN
     187                         dvrp_nop = dvrp_nop + 1
     188                      ELSE
     189                         dvrp_mask(n) = .FALSE.
     190                      ENDIF
     191                   ENDDO
     192                ELSE
     193                   k = 0
     194                   DO  n = 1, number_of_particles
     195                      IF ( particles(n)%tail_id /= 0 )  THEN
     196                         k = k + 1
     197                         ip = particles(n)%x / dx
     198                         jp = particles(n)%y / dy
     199                         IF ( ip >= nxl_dvrp  .AND.  ip <= nxr_dvrp  .AND.  &
     200                              jp >= nys_dvrp  .AND.  jp <= nyn_dvrp )  THEN
     201                            dvrp_not = dvrp_not + 1
     202                         ELSE
     203                            dvrp_mask(k) = .FALSE.
     204                         ENDIF
     205                      ENDIF
     206                   ENDDO
     207                ENDIF
     208             ENDIF
     209          ENDIF
     210
     211!
    171212!--       Move particle coordinates to one-dimensional arrays
    172213          IF ( .NOT. use_particle_tails )  THEN
    173214!
    174215!--          All particles are output
    175              ALLOCATE( psize(number_of_particles), p_t(number_of_particles), &
    176                        p_c(number_of_particles), p_x(number_of_particles),   &
    177                        p_y(number_of_particles), p_z(number_of_particles) )
     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) )
    178218             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
    179              p_z   = 0.0;
    180              psize = particles(1:number_of_particles)%dvrp_psize
    181              p_x   = particles(1:number_of_particles)%x * superelevation_x
    182              p_y   = particles(1:number_of_particles)%y * superelevation_y
    183              p_z   = particles(1:number_of_particles)%z * superelevation
    184              p_c   = particles(1:number_of_particles)%color
     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
    185231          ELSE
    186232!
    187233!--          Particles have a tail
    188 !            WRITE (9,*) '--- before ALLOCATE  simtime=',simulated_time,' #of_tails=', number_of_tails, &
    189 !                          ' max#of_tp=', maximum_number_of_tailpoints
    190 !   CALL local_flush( 9 )
    191              ALLOCATE( psize(number_of_tails), p_t(number_of_tails),      &
    192                        p_c(number_of_tails*maximum_number_of_tailpoints), &
    193                        p_x(number_of_tails*maximum_number_of_tailpoints), &
    194                        p_y(number_of_tails*maximum_number_of_tailpoints), &
    195                        p_z(number_of_tails*maximum_number_of_tailpoints) )
    196 !            WRITE (9,*) '--- after ALLOCATE'
    197 !   CALL local_flush( 9 )
     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) )
    198239             psize = 0.0;  p_t = 0;  p_c = 0.0;  p_x = 0.0;  p_y = 0.0
    199240             p_z   = 0.0;
     
    202243             DO  n = 1, number_of_particles
    203244                nn = particles(n)%tail_id
    204                 IF ( nn /= 0 )  THEN
     245                IF ( nn /= 0  .AND.  dvrp_mask(n) )  THEN
    205246                   k = k + 1
    206 !                  IF ( simulated_time > 1338.0 )  THEN
    207 !                     WRITE (9,*) '--- particle ',n,' tail_id=',nn,' #of_tp=',particles(n)%tailpoints
    208 !   CALL local_flush( 9 )
    209 !                  ENDIF
    210247                   DO  j = 1, particles(n)%tailpoints
    211248                      i = i + 1
     
    217254                                                                superelevation
    218255                      p_c(i) = particle_tail_coordinates(j,4,nn)
    219 !                     IF ( simulated_time > 1338.0 )  THEN
    220 !                        WRITE (9,*) '--- tp= ',i,' x=',p_x(i),' y=',p_y(i), &
    221 !                                                ' z=',p_z(i),' c=',p_c(i)
    222 !   CALL local_flush( 9 )
    223 !                     ENDIF
    224256                   ENDDO
    225257                   psize(k) = particles(n)%dvrp_psize
    226258                   p_t(k)   = particles(n)%tailpoints - 1
    227 !                  IF ( simulated_time > 1338.0 )  THEN
    228 !                     WRITE (9,*) '--- t= ',k,' psize=',psize(k),' p_t=',p_t(k)
    229 !   CALL local_flush( 9 )
    230 !                  ENDIF
    231259                ENDIF               
    232260             ENDDO
    233 !            WRITE (9,*) '--- after locally storing the particle attributes'
    234 !   CALL local_flush( 9 )
    235261          ENDIF
    236262
     
    252278
    253279             IF ( .NOT. use_particle_tails )  THEN
    254                 CALL DVRP_PARTICLES( m-1, number_of_particles, p_x, p_y, p_z, &
    255                                      3, psize, p_c, p_t )
     280                CALL DVRP_PARTICLES( m-1, dvrp_nop, p_x, p_y, p_z, 3, psize, &
     281                                     p_c, p_t )
    256282             ELSE
    257 !               WRITE (9,*) '--- before DVRP_PARTICLES'
    258 !   CALL local_flush( 9 )
    259                 CALL DVRP_PARTICLES( m-1, number_of_tails, p_x, p_y, p_z, 15, &
    260                                      psize, p_c, p_t )
    261 !               WRITE (9,*) '--- after DVRP_PARTICLES'
    262 !               WRITE (9,*) 'm-1 = ',m-1
    263 !               WRITE (9,*) 'number_of_tails=', number_of_tails
    264 !               WRITE (9,*) 'p_x =', p_x
    265 !               WRITE (9,*) 'p_y =', p_y
    266 !               WRITE (9,*) 'p_z =', p_z
    267 !               WRITE (9,*) 'psize =', psize
    268 !               WRITE (9,*) 'p_c =', p_c
    269 !               WRITE (9,*) 'p_t =', p_t
    270 
    271 !   CALL local_flush( 9 )
     283                CALL DVRP_PARTICLES( m-1, dvrp_not, p_x, p_y, p_z, 15, psize, &
     284                                     p_c, p_t )
    272285             ENDIF
    273286          ENDIF
    274287
    275288          CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
    276 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende particles'
    277 !   CALL local_flush( 9 )
    278 
    279           DEALLOCATE( psize, p_c, p_t, p_x, p_y, p_z )
     289
     290          DEALLOCATE( dvrp_mask, psize, p_c, p_t, p_x, p_y, p_z )
    280291
    281292          CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
     
    436447
    437448          IF ( mode_dvrp(m)(1:10) == 'isosurface' )  THEN
    438 
    439 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang isosurface'
    440 !   CALL local_flush( 9 )
    441449!
    442450!--          DVRP-Calls for plotting isosurfaces:
     
    485493             CALL DVRP_VISUALIZE( m-1, 21, dvrp_filecount )
    486494
    487 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende isosurface'
    488 !   CALL local_flush( 9 )
    489 
    490495             CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
    491496
    492497          ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' )  THEN
    493 
    494 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang slicer'
    495 !   CALL local_flush( 9 )
    496498!
    497499!--          DVRP-Calls for plotting slicers:
     
    532534             CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
    533535
    534 !   WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende slicer'
    535 !   CALL local_flush( 9 )
    536536          ENDIF
    537537
     
    578578
    579579    CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
    580 !   WRITE ( 9, * ) '*** myid=', myid, ' Ende data_output_dvrp'
    581 !   CALL local_flush( 9 )
    582580
    583581#endif
Note: See TracChangeset for help on using the changeset viewer.