Changeset 1936 for palm/trunk/SOURCE/lpm_exchange_horiz.f90

Timestamp:

Jun 13, 2016 1:37:44 PM (8 years ago)

Author:

suehring

Message:

deallocation of unused particle memory, formatting adjustments

File:

• palm/trunk/SOURCE/lpm_exchange_horiz.f90 (modified) (5 diffs)

palm/trunk/SOURCE/lpm_exchange_horiz.f90

@@ -19 +19 @@
 ! Current revisions:
 ! ------------------
-! 
+! Deallocation of unused memory
 ! 
 ! Former revisions:
@@ -138 +138 @@
 
     PRIVATE
-    PUBLIC lpm_exchange_horiz, lpm_move_particle, realloc_particles_array
+    PUBLIC lpm_exchange_horiz, lpm_move_particle, realloc_particles_array,     &
+           dealloc_particles_array
 
     INTERFACE lpm_exchange_horiz
@@ -152 +153 @@
     END INTERFACE realloc_particles_array
 
+    INTERFACE dealloc_particles_array
+       MODULE PROCEDURE dealloc_particles_array
+    END INTERFACE dealloc_particles_array
 CONTAINS
 
@@ -1057 +1061 @@
     TYPE(particle_type), DIMENSION(500)            :: tmp_particles_s !<
 
-
     old_size = SIZE(grid_particles(k,j,i)%particles)
 
@@ -1097 +1100 @@
  END SUBROUTINE realloc_particles_array
 
+
+
+
+
+ SUBROUTINE dealloc_particles_array
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i
+    INTEGER(iwp) ::  j
+    INTEGER(iwp) ::  k
+    INTEGER(iwp) :: old_size        !<
+    INTEGER(iwp) :: new_size        !<
+
+    LOGICAL                                        :: dealloc  
+
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles_d !<
+    TYPE(particle_type), DIMENSION(500)            :: tmp_particles_s !<
+
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+!
+!--          Determine number of active particles
+             number_of_particles = prt_count(k,j,i)
+!
+!--          Determine allocated memory size
+             old_size = SIZE( grid_particles(k,j,i)%particles )
+!
+!--          Check for large unused memory
+             dealloc = ( ( number_of_particles < min_nr_particle .AND.         &
+                           old_size            > min_nr_particle )  .OR.       &
+                         ( number_of_particles > min_nr_particle .AND.         &
+                           old_size - number_of_particles *                    &
+                              ( 1.0_wp + 0.01_wp * alloc_factor ) > 0.0_wp ) )
+                         
+
+             IF ( dealloc )  THEN
+                IF ( number_of_particles < min_nr_particle )  THEN
+                   new_size = min_nr_particle
+                ELSE 
+                   new_size = INT( number_of_particles * ( 1.0_wp + 0.01_wp * alloc_factor ) )
+                ENDIF
+
+                IF ( number_of_particles <= 500 )  THEN
+
+                   tmp_particles_s(1:number_of_particles) = grid_particles(k,j,i)%particles(1:number_of_particles)
+
+                   DEALLOCATE(grid_particles(k,j,i)%particles)
+                   ALLOCATE(grid_particles(k,j,i)%particles(new_size))
+
+                   grid_particles(k,j,i)%particles(1:number_of_particles)          = tmp_particles_s(1:number_of_particles)
+                   grid_particles(k,j,i)%particles(number_of_particles+1:new_size) = zero_particle
+
+                ELSE
+
+                   ALLOCATE(tmp_particles_d(number_of_particles))
+                   tmp_particles_d(1:number_of_particles) = grid_particles(k,j,i)%particles(1:number_of_particles)
+
+                   DEALLOCATE(grid_particles(k,j,i)%particles)
+                   ALLOCATE(grid_particles(k,j,i)%particles(new_size))
+
+                   grid_particles(k,j,i)%particles(1:number_of_particles)          = tmp_particles_d(1:number_of_particles)
+                   grid_particles(k,j,i)%particles(number_of_particles+1:new_size) = zero_particle
+
+                   DEALLOCATE(tmp_particles_d)
+
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+
+ END SUBROUTINE dealloc_particles_array
+
+
 END MODULE lpm_exchange_horiz_mod