Changeset 2609 for palm/trunk/SOURCE

Timestamp:

Nov 14, 2017 2:14:44 PM (7 years ago)

Author:

schwenkel

Message:

Integrated subroutine pack_and_sort into lpm_sort_in_subboxes

File:

• palm/trunk/SOURCE/lpm_pack_arrays.f90 (modified) (4 diffs)

palm/trunk/SOURCE/lpm_pack_arrays.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Integrated subroutine pack_and_sort into lpm_sort_in_subboxes
+! 
+! 2606 2017-11-10 10:36:31Z schwenkel
 ! Changed particle box locations: center of particle box now coincides 
 ! with scalar grid point of same index.
@@ -124 +127 @@
        IMPLICIT NONE
 
+       INTEGER(iwp) ::  i  !<
        INTEGER(iwp) ::  ip !<
+       INTEGER(iwp) ::  is !<
+       INTEGER(iwp) ::  j  !<
        INTEGER(iwp) ::  jp !<
+       INTEGER(iwp) ::  k  !<
        INTEGER(iwp) ::  kp !<
+       INTEGER(iwp) ::  m  !<
+       INTEGER(iwp) ::  n  !<
+       INTEGER(iwp) ::  nn !<
+       INTEGER(iwp) ::  sort_index  !<
+
+       INTEGER(iwp), DIMENSION(0:7) ::  sort_count  !<
+
+       TYPE(particle_type), DIMENSION(:,:), ALLOCATABLE ::  sort_particles  !<
 
        CALL cpu_log( log_point_s(51), 'lpm_sort_in_subboxes', 'start' )
@@ -135 +150 @@
                 IF ( number_of_particles <= 0 )  CYCLE
                 particles => grid_particles(kp,jp,ip)%particles(1:number_of_particles)
+                      
+                nn = 0
+                sort_count = 0
+                ALLOCATE( sort_particles(number_of_particles, 0:7) )
                 
-                CALL lpm_pack_and_sort(ip,jp,kp)
-                
+                DO  n = 1, number_of_particles
+                   sort_index = 0
+
+                   IF ( particles(n)%particle_mask )  THEN
+                      nn = nn + 1
+!
+!--                   Sorting particles with a binary scheme
+!--                   sort_index=111_2=7_10 -> particle at the left,south,bottom subgridbox
+!--                   sort_index=000_2=0_10 -> particle at the right,north,top subgridbox
+!--                   For this the center of the gridbox is calculated 
+                      i = (particles(n)%x + 0.5_wp * dx) * ddx
+                      j = (particles(n)%y + 0.5_wp * dy) * ddy
+                      k = ( particles(n)%z+ 0.5_wp *dz ) / dz+1 + offset_ocean_nzt
+                      
+                      IF ( i == ip )  sort_index = sort_index + 4 
+                      IF ( j == jp )  sort_index = sort_index + 2
+                      IF ( k == kp )  sort_index = sort_index + 1
+                      
+                      sort_count(sort_index) = sort_count(sort_index) + 1
+                      m = sort_count(sort_index)
+                      sort_particles(m,sort_index) = particles(n)
+                      sort_particles(m,sort_index)%block_nr = sort_index
+                   ENDIF
+                ENDDO
+
+                nn = 0
+                DO is = 0,7
+                   grid_particles(kp,jp,ip)%start_index(is) = nn + 1
+                   DO n = 1,sort_count(is)
+                      nn = nn + 1
+                      particles(nn) = sort_particles(n,is)
+                   ENDDO
+                   grid_particles(kp,jp,ip)%end_index(is) = nn
+                ENDDO
+
+                number_of_particles = nn    
                 prt_count(kp,jp,ip) = number_of_particles
+                DEALLOCATE(sort_particles)
              ENDDO
           ENDDO
@@ -190 +244 @@
 
     END SUBROUTINE lpm_pack 
-
-    SUBROUTINE lpm_pack_and_sort (ip,jp,kp)
-
-       USE control_parameters,                                                 &
-           ONLY: dz
-
-       USE kinds
-
-       USE grid_variables,                                                     &
-           ONLY: dx,dy,ddx, ddy
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN) :: ip
-       INTEGER(iwp), INTENT(IN) :: jp
-       INTEGER(iwp), INTENT(IN) :: kp
-
-       INTEGER(iwp)             :: i
-       INTEGER(iwp)             :: is
-       INTEGER(iwp)             :: j
-       INTEGER(iwp)             :: k
-       INTEGER(iwp)             :: n
-       INTEGER(iwp)             :: nn
-       INTEGER(iwp)             :: m
-       INTEGER(iwp)             :: sort_index
-
-       INTEGER(iwp), DIMENSION(0:7) :: sort_count
-
-       TYPE(particle_type), DIMENSION(number_of_particles,0:7) :: sort_particles
-      
-       nn = 0
-       sort_count = 0
-                
-       DO  n = 1, number_of_particles
-          sort_index = 0
-
-          IF ( particles(n)%particle_mask )  THEN
-             nn = nn + 1
-!
-!--          Sorting particles with a binary scheme
-!--          sort_index=111_2=7_10 -> particle at the left,south,bottom subgridbox
-!--          sort_index=000_2=0_10 -> particle at the right,north,top subgridbox
-!--          For this the center of the gridbox is calculated 
-             i = (particles(n)%x + 0.5_wp * dx) * ddx
-             j = (particles(n)%y + 0.5_wp * dy) * ddy
-             k = ( particles(n)%z+ 0.5_wp *dz ) / dz+1 + offset_ocean_nzt
-                      
-             IF ( i == ip )  sort_index = sort_index + 4 
-             IF ( j == jp )  sort_index = sort_index + 2
-             IF ( k == kp )  sort_index = sort_index + 1
-                      
-             sort_count(sort_index) = sort_count(sort_index) + 1
-             m = sort_count(sort_index)
-             sort_particles(m,sort_index) = particles(n)
-             sort_particles(m,sort_index)%block_nr = sort_index
-          ENDIF
-
-       ENDDO
-
-       nn = 0
-
-       DO is = 0,7
-          grid_particles(kp,jp,ip)%start_index(is) = nn + 1
-          DO n = 1,sort_count(is)
-             nn = nn + 1
-             particles(nn) = sort_particles(n,is)
-             ENDDO
-             grid_particles(kp,jp,ip)%end_index(is) = nn
-       ENDDO
-
-       number_of_particles = nn    
-                
-    END SUBROUTINE lpm_pack_and_sort
                 
 !------------------------------------------------------------------------------!