Ignore:
Timestamp:
Apr 11, 2014 5:15:14 PM (7 years ago)
Author:
hoffmann
Message:

new Lagrangian particle structure integrated

File:
1 edited

Legend:

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

    r1321 r1359  
    1  SUBROUTINE lpm_pack_arrays
     1 MODULE lpm_pack_arrays_mod
    22
    33!--------------------------------------------------------------------------------!
     
    2020! Current revisions:
    2121! ------------------
    22 !
     22! New particle structure integrated.
     23! Kind definition added to all floating point numbers.
    2324!
    2425! Former revisions:
     
    4748!------------------------------------------------------------------------------!
    4849
    49     USE kinds
    50 
    5150    USE particle_attributes,                                                   &
    52         ONLY:  deleted_particles, deleted_tails, new_tail_id,                  &
    53                number_of_particles, number_of_tails, particles, particle_mask, &
     51        ONLY:  deleted_tails, grid_particles, new_tail_id,                     &
     52               number_of_particles, number_of_tails, offset_ocean_nzt,         &
     53               offset_ocean_nzt_m1, particles, particle_type, prt_count,       &
    5454               particle_tail_coordinates, tail_mask, use_particle_tails
    5555
    56 
    57     IMPLICIT NONE
    58 
    59     INTEGER(iwp) ::  n       !:
    60     INTEGER(iwp) ::  nd      !:
    61     INTEGER(iwp) ::  nn      !:
    62 !
    63 !-- Find out elements marked for deletion and move data with higher index
    64 !-- values to these free indices
    65     nn = 0
    66     nd = 0
    67 
    68     DO  n = 1, number_of_particles
    69 
    70        IF ( particle_mask(n) )  THEN
    71           nn = nn + 1
    72           particles(nn) = particles(n)
    73        ELSE
    74           nd = nd + 1
     56    PRIVATE
     57    PUBLIC lpm_pack_all_arrays, lpm_pack_arrays
     58
     59    INTERFACE lpm_pack_all_arrays
     60       MODULE PROCEDURE lpm_pack_all_arrays
     61    END INTERFACE lpm_pack_all_arrays
     62
     63    INTERFACE lpm_pack_arrays
     64       MODULE PROCEDURE lpm_pack_arrays
     65    END INTERFACE lpm_pack_arrays
     66
     67CONTAINS
     68
     69    SUBROUTINE lpm_pack_all_arrays
     70
     71       USE cpulog,                                                             &
     72           ONLY:  cpu_log, log_point_s
     73
     74       USE indices,                                                            &
     75           ONLY:  nxl, nxr, nys, nyn, nzb, nzt
     76
     77       USE kinds
     78
     79       IMPLICIT NONE
     80
     81       INTEGER(iwp) ::  i !:
     82       INTEGER(iwp) ::  j !:
     83       INTEGER(iwp) ::  k !:
     84
     85       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'start' )
     86       DO  i = nxl, nxr
     87          DO  j = nys, nyn
     88             DO  k = nzb+1, nzt
     89                number_of_particles = prt_count(k,j,i)
     90                IF ( number_of_particles <= 0 )  CYCLE
     91                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
     92                CALL lpm_pack_and_sort(i,j,k)
     93                prt_count(k,j,i) = number_of_particles
     94             ENDDO
     95          ENDDO
     96       ENDDO
     97       CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'stop' )
     98       RETURN
     99
     100    END SUBROUTINE lpm_pack_all_arrays
     101
     102    SUBROUTINE lpm_pack_arrays
     103
     104       USE kinds
     105
     106       IMPLICIT NONE
     107
     108       INTEGER(iwp) ::  n       !:
     109       INTEGER(iwp) ::  nd      !:
     110       INTEGER(iwp) ::  nn      !:
     111!
     112!--    Find out elements marked for deletion and move data from highest index
     113!--    values to these free indices
     114       nn = number_of_particles
     115
     116       DO WHILE ( .NOT. particles(nn)%particle_mask )
     117          nn = nn-1
     118          IF ( nn == 0 )  EXIT
     119       ENDDO
     120
     121       IF ( nn > 0 )  THEN
     122          DO  n = 1, number_of_particles
     123             IF ( .NOT. particles(n)%particle_mask )  THEN
     124                particles(n) = particles(nn)
     125                nn = nn - 1
     126                DO WHILE ( .NOT. particles(nn)%particle_mask )
     127                   nn = nn-1
     128                   IF ( n == nn )  EXIT
     129                ENDDO
     130             ENDIF
     131             IF ( n == nn )  EXIT
     132          ENDDO
    75133       ENDIF
    76134
    77     ENDDO
    78 !
    79 !-- The number of deleted particles has been determined in routines
    80 !-- lpm_boundary_conds, lpm_droplet_collision, and lpm_exchange_horiz
    81     number_of_particles = number_of_particles - deleted_particles
    82 
     135!
     136!--    The number of deleted particles has been determined in routines
     137!--    lpm_boundary_conds, lpm_droplet_collision, and lpm_exchange_horiz
     138       number_of_particles = nn
     139
     140!
     141!-- particle tails are currently not available
    83142!
    84143!-- Handle tail array in the same way, store the new tail ids and re-assign it
    85144!-- to the respective particles
    86     IF ( use_particle_tails )  THEN
    87 
    88        nn = 0
    89        nd = 0
    90 
    91        DO  n = 1, number_of_tails
    92 
    93           IF ( tail_mask(n) )  THEN
    94              nn = nn + 1
    95              particle_tail_coordinates(:,:,nn) = &
    96                                                 particle_tail_coordinates(:,:,n)
    97              new_tail_id(n) = nn
    98           ELSE
    99              nd = nd + 1
    100           ENDIF
    101 
    102        ENDDO
    103 
    104        DO  n = 1, number_of_particles
    105           IF ( particles(n)%tail_id /= 0 )  THEN
    106              particles(n)%tail_id = new_tail_id(particles(n)%tail_id)
    107           ENDIF
    108        ENDDO
    109 
    110     ENDIF
     145!    IF ( use_particle_tails )  THEN
     146!
     147!       nn = 0
     148!       nd = 0
     149!
     150!       DO  n = 1, number_of_tails
     151!
     152!          IF ( tail_mask(n) )  THEN
     153!             nn = nn + 1
     154!             particle_tail_coordinates(:,:,nn) = &
     155!                                                particle_tail_coordinates(:,:,n)
     156!             new_tail_id(n) = nn
     157!          ELSE
     158!             nd = nd + 1
     159!          ENDIF
     160!
     161!       ENDDO
     162!
     163!       DO  n = 1, number_of_particles
     164!          IF ( particles(n)%tail_id /= 0 )  THEN
     165!             particles(n)%tail_id = new_tail_id(particles(n)%tail_id)
     166!          ENDIF
     167!       ENDDO
     168!
     169!    ENDIF
    111170
    112171!
    113172!-- The number of deleted tails has been determined in routines
    114173!-- lpm_boundary_conds and lpm_exchange_horiz
    115     number_of_tails = number_of_tails - deleted_tails
    116 
    117 
    118  END SUBROUTINE lpm_pack_arrays
     174!   number_of_tails = number_of_tails - deleted_tails
     175
     176
     177    END SUBROUTINE lpm_pack_arrays
     178
     179    SUBROUTINE lpm_pack_and_sort (ip,jp,kp)
     180
     181      USE control_parameters,                                                  &
     182          ONLY: dz,  atmos_ocean_sign
     183
     184      USE indices,                                                             &
     185          ONLY: nxl, nxr, nys, nyn, nzb, nzt
     186
     187      USE kinds
     188
     189      USE grid_variables,                                                      &
     190          ONLY: ddx, ddy
     191
     192      IMPLICIT NONE
     193
     194      INTEGER(iwp), INTENT(IN)    :: ip
     195      INTEGER(iwp), INTENT(IN)    :: jp
     196      INTEGER(iwp), INTENT(IN)    :: kp
     197
     198      INTEGER(iwp)                :: i
     199      INTEGER(iwp)                :: j
     200      INTEGER(iwp)                :: k
     201      INTEGER(iwp)                :: n
     202      INTEGER(iwp)                :: nn
     203      INTEGER(iwp)                :: m
     204      INTEGER(iwp)                :: sort_index
     205      INTEGER(iwp)                :: is
     206      INTEGER(iwp)                :: kk
     207
     208      INTEGER(iwp),DIMENSION(0:7) :: sort_count
     209
     210      TYPE(particle_type), DIMENSION(number_of_particles,0:7) :: sort_particles
     211
     212       nn = 0
     213       sort_count = 0
     214
     215       DO  n = 1, number_of_particles
     216          sort_index = 0
     217
     218          IF ( particles(n)%particle_mask )  THEN
     219             nn = nn + 1
     220             i = particles(n)%x * ddx
     221             j = particles(n)%y * ddy
     222             k = ( particles(n)%z + 0.5_wp * dz * atmos_ocean_sign ) / dz +    &
     223                 offset_ocean_nzt
     224             kk= particles(n)%z / dz + 1 + offset_ocean_nzt_m1
     225             IF ( i == ip )  sort_index = sort_index+4
     226             IF ( j == jp )  sort_index = sort_index+2
     227             IF ( k == kp )  sort_index = sort_index+1
     228             sort_count(sort_index) = sort_count(sort_index)+1
     229             m = sort_count(sort_index)
     230             sort_particles(m,sort_index) = particles(n)
     231             sort_particles(m,sort_index)%block_nr = sort_index
     232          ENDIF
     233
     234       ENDDO
     235
     236       nn = 0
     237
     238       DO is = 0,7
     239          grid_particles(kp,jp,ip)%start_index(is) = nn + 1
     240          DO n = 1,sort_count(is)
     241             nn = nn+1
     242             particles(nn) = sort_particles(n,is)
     243          ENDDO
     244          grid_particles(kp,jp,ip)%end_index(is) = nn
     245       ENDDO
     246
     247       number_of_particles = nn
     248       RETURN
     249
     250    END SUBROUTINE lpm_pack_and_sort
     251
     252
     253 END module lpm_pack_arrays_mod
Note: See TracChangeset for help on using the changeset viewer.