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

Timestamp:

Nov 20, 2017 12:40:38 PM (6 years ago)

Author:

schwenkel

Message:

enable particle advection with grid stretching and some formatation changes in lpm

File:

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

palm/trunk/SOURCE/lpm_exchange_horiz.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Enabled particle advection with grid stretching. Furthermore, the CFL-
+! criterion is checked for every particle at every time step.
+! 
+! 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 +128 @@
  
     USE, INTRINSIC ::  ISO_C_BINDING
-
+    
+    USE arrays_3d,                                                             &
+       ONLY:  zw
+    
     USE control_parameters,                                                    &
         ONLY:  dz, message_string, simulated_time
@@ -887 +894 @@
        jp = particle_array(n)%y * ddy
        kp = particle_array(n)%z / dz + 1 + offset_ocean_nzt
+!
+!--    In case of grid stretching a particle might be above or below the  
+!--    previously calculated particle grid box (indices).     
+       DO WHILE( zw(kp) < particle_array(n)%z )
+          kp = kp + 1
+       ENDDO
+
+       DO WHILE( zw(kp-1) > particle_array(n)%z )
+          kp = kp - 1
+       ENDDO
 
        IF ( ip >= nxl  .AND.  ip <= nxr  .AND.  jp >= nys  .AND.  jp <= nyn    &
@@ -1022 +1039 @@
 !------------------------------------------------------------------------------!
  SUBROUTINE lpm_move_particle
-
+ 
     IMPLICIT NONE
 
@@ -1038 +1055 @@
 
     CALL cpu_log( log_point_s(41), 'lpm_move_particle', 'start' )
-
+    CALL lpm_check_cfl
     DO  ip = nxl, nxr
        DO  jp = nys, nyn
@@ -1050 +1067 @@
                 i = particles_before_move(n)%x * ddx
                 j = particles_before_move(n)%y * ddy
-                k = particles_before_move(n)%z / dz + 1 + offset_ocean_nzt
-
+                k = kp
+!
+!--             Find correct vertical particle grid box (necessary in case of grid stretching)
+!--             Due to the CFL limitations only the neighbouring grid boxes are considered. 
+                IF( zw(k)   < particles_before_move(n)%z ) k = k + 1
+                IF( zw(k-1) > particles_before_move(n)%z ) k = k - 1 
+                
 !--             For lpm_exchange_horiz to work properly particles need to be moved to the outermost gridboxes
 !--             of the respective processor. If the particle index is inside the processor the following lines
@@ -1059 +1081 @@
                 j = MIN ( j , nyn )
                 j = MAX ( j , nys )
+                
                 k = MIN ( k , nzt )
                 k = MAX ( k , nzb+1 )
+                
 !
 !--             Check, if particle has moved to another grid cell.
@@ -1092 +1116 @@
 
  END SUBROUTINE lpm_move_particle
-
+ 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check CFL-criterion for each particle. If one particle violated the 
+!> criterion the particle will be deleted and a warning message is given.
+!------------------------------------------------------------------------------!
+ SUBROUTINE lpm_check_cfl  
+       
+    IMPLICIT NONE
+    
+    INTEGER(iwp)  ::  i
+    INTEGER(iwp)  ::  j
+    INTEGER(iwp)  ::  k
+    INTEGER(iwp)  ::  n
+    
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+             number_of_particles = prt_count(k,j,i)
+             IF ( number_of_particles <= 0 )  CYCLE
+             particles => grid_particles(k,j,i)%particles(1:number_of_particles)         
+             DO n = 1, number_of_particles
+   
+                IF(ABS(particles(n)%speed_x) >                                 &
+                   (dx/(particles(n)%age-particles(n)%age_m))  .OR.            &
+                   ABS(particles(n)%speed_y) >                                 & 
+                   (dx/(particles(n)%age-particles(n)%age_m))  .OR.            &
+                   ABS(particles(n)%speed_z) >                                 &
+                   ((zw(k)-zw(k-1))/(particles(n)%age-particles(n)%age_m))) THEN
+                   WRITE( message_string, * ) 'PARTICLE VIOLATED CFL CRITERION'&
+                   ': particle with id ',particles(n)%id,' will be deleted!'   
+                   CALL message( 'lpm_check_cfl', 'PA0500', 0, 1, 0, 6, 0 )
+                   particles(n)%particle_mask= .FALSE.
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO   
+
+ END SUBROUTINE lpm_check_cfl
+ 
 !------------------------------------------------------------------------------!
 ! Description: