refactor(prt): introduce enum for tracking level (#2456)

Use an enum for tracking level, where levels correspond to (sub)method delegation for model, feature, subfeature etc

Author: wpbonelli

src/Model/ParticleTracking/prt-prp.f90

@@ -23,6 +23,7 @@ module PrtPrpModule
   use DisvModule, only: DisvType
   use ErrorUtilModule, only: pstop
   use MathUtilModule, only: arange, is_close
+  use MethodModule, only: LEVEL_MODEL, LEVEL_FEATURE, LEVEL_SUBFEATURE
 
   implicit none
 
@@ -535,12 +536,12 @@ subroutine initialize_particle(this, particle, ip, trelease)
     end if
 
     particle%ttrack = particle%trelease
-    particle%itrdomain(1) = 0
-    particle%iboundary(1) = 0
-    particle%itrdomain(2) = ic
-    particle%iboundary(2) = 0
-    particle%itrdomain(3) = 0
-    particle%iboundary(3) = 0
+    particle%itrdomain(LEVEL_MODEL) = 0
+    particle%iboundary(LEVEL_MODEL) = 0
+    particle%itrdomain(LEVEL_FEATURE) = ic
+    particle%iboundary(LEVEL_FEATURE) = 0
+    particle%itrdomain(LEVEL_SUBFEATURE) = 0
+    particle%iboundary(LEVEL_SUBFEATURE) = 0
     particle%ifrctrn = this%ifrctrn
     particle%iexmeth = this%iexmeth
     particle%iextend = this%iextend

src/Model/ParticleTracking/prt.f90

@@ -18,14 +18,14 @@ module PrtModule
   use PrtOcModule, only: PrtOcType
   use BudgetModule, only: BudgetType
   use ListModule, only: ListType
-  use ParticleModule, only: ParticleType, create_particle
+  use ParticleModule, only: ParticleType, create_particle, TERM_UNRELEASED
   use ParticleEventsModule, only: ParticleEventDispatcherType, &
                                   ParticleEventConsumerType
   use ParticleTracksModule, only: ParticleTracksType, &
                                   ParticleTrackFileType
   use SimModule, only: count_errors, store_error, store_error_filename
   use MemoryManagerModule, only: mem_allocate
-  use MethodModule, only: MethodType
+  use MethodModule, only: MethodType, LEVEL_FEATURE
 
   implicit none
 
@@ -463,8 +463,8 @@ subroutine prt_cq_sto(this)
         do np = 1, packobj%nparticles
           istatus = packobj%particles%istatus(np)
           ! this may need to change if istatus flags change
-          if ((istatus > 0) .and. (istatus /= 8)) then
-            n = packobj%particles%itrdomain(np, 2)
+          if ((istatus > 0) .and. (istatus /= TERM_UNRELEASED)) then
+            n = packobj%particles%itrdomain(np, LEVEL_FEATURE)
             ! Each particle currently assigned unit mass
             this%masssto(n) = this%masssto(n) + DONE
           end if

src/Solution/ParticleTracker/Method/Method.f90

@@ -22,6 +22,22 @@ module MethodModule
   use MathUtilModule, only: is_close
   implicit none
 
+  public :: LEVEL_MODEL, LEVEL_FEATURE, LEVEL_SUBFEATURE
+
+  !> @brief Tracking method level enumeration.
+  !!
+  !> Tracking levels: 1: model, 2: grid feature, 3: grid subfeature.
+  !! A tracking level identifies the domain through which a tracking
+  !! method is responsible for moving a particle. Methods operate on
+  !! a particular level and delegate to submethods for levels higher
+  !! than (i.e. below the scope of) their own.
+  !<
+  enum, bind(C)
+    enumerator :: LEVEL_MODEL = 1
+    enumerator :: LEVEL_FEATURE = 2
+    enumerator :: LEVEL_SUBFEATURE = 3
+  end enum
+
   private
   public :: MethodType
 
@@ -55,6 +71,7 @@ module MethodModule
     ! Overridden in subtypes that delegate
     procedure :: pass !< pass the particle to the next subdomain
     procedure :: load !< load the subdomain tracking method
+    procedure :: get_level !< get the tracking method level
     ! Implemented here
     procedure :: init
     procedure :: track
@@ -131,7 +148,6 @@ recursive subroutine track(this, particle, level, tmax)
     integer(I4B) :: nextlevel
     class(methodType), pointer :: submethod
 
-    ! Advance the particle over subdomains
     advancing = .true.
     nextlevel = level + 1
     do while (advancing)
@@ -148,16 +164,17 @@ subroutine try_pass(this, particle, nextlevel, advancing)
     integer(I4B) :: nextlevel
     logical(LGP) :: advancing
 
-    ! if the particle is done advancing, reset the domain boundary flag.
-    if (.not. particle%advancing) then
-      particle%iboundary = 0
-      advancing = .false.
-    else
-      ! otherwise pass the particle to the next subdomain.
-      ! if that leaves it on a boundary, stop advancing.
+    if (particle%advancing) then
+      ! if still advancing, pass to the next subdomain.
+      ! if that puts us on a boundary, then we're done.
       call this%pass(particle)
       if (particle%iboundary(nextlevel - 1) .ne. 0) &
         advancing = .false.
+    else
+      ! otherwise we're already done so
+      ! reset the domain boundary value.
+      advancing = .false.
+      particle%iboundary = 0
     end if
   end subroutine try_pass
 
@@ -170,6 +187,14 @@ subroutine load(this, particle, next_level, submethod)
     call pstop(1, "load must be overridden")
   end subroutine load
 
+  !> @brief Get the tracking method's level.
+  function get_level(this) result(level)
+    class(MethodType), intent(in) :: this
+    integer(I4B) :: level
+    level = -1 ! suppress compiler warning
+    call pstop(1, "get_level must be overridden")
+  end function get_level
+
   !> @brief Pass the particle to the next subdomain.
   subroutine pass(this, particle)
     class(MethodType), intent(inout) :: this
@@ -182,7 +207,6 @@ subroutine release(this, particle)
     class(MethodType), intent(inout) :: this
     type(ParticleType), pointer, intent(inout) :: particle
     class(ParticleEventType), pointer :: event
-
     allocate (ReleaseEventType :: event)
     call this%events%dispatch(particle, event)
     deallocate (event)
@@ -194,7 +218,6 @@ subroutine terminate(this, particle, status)
     type(ParticleType), pointer, intent(inout) :: particle
     integer(I4B), intent(in), optional :: status
     class(ParticleEventType), pointer :: event
-
     particle%advancing = .false.
     if (present(status)) particle%istatus = status
     allocate (TerminationEventType :: event)
@@ -207,7 +230,6 @@ subroutine timestep(this, particle)
     class(MethodType), intent(inout) :: this
     type(ParticleType), pointer, intent(inout) :: particle
     class(ParticleEventType), pointer :: event
-
     allocate (TimeStepEventType :: event)
     call this%events%dispatch(particle, event)
     deallocate (event)
@@ -218,7 +240,6 @@ subroutine weaksink(this, particle)
     class(MethodType), intent(inout) :: this
     type(ParticleType), pointer, intent(inout) :: particle
     class(ParticleEventType), pointer :: event
-
     allocate (WeakSinkEventType :: event)
     call this%events%dispatch(particle, event)
     deallocate (event)
@@ -229,7 +250,6 @@ subroutine usertime(this, particle)
     class(MethodType), intent(inout) :: this
     type(ParticleType), pointer, intent(inout) :: particle
     class(ParticleEventType), pointer :: event
-
     allocate (UserTimeEventType :: event)
     call this%events%dispatch(particle, event)
     deallocate (event)

src/Solution/ParticleTracker/Method/MethodCell.f90

@@ -3,7 +3,7 @@ module MethodCellModule
   use KindModule, only: DP, I4B, LGP
   use ErrorUtilModule, only: pstop
   use ConstantsModule, only: DONE, DZERO
-  use MethodModule, only: MethodType
+  use MethodModule, only: MethodType, LEVEL_FEATURE
   use ParticleModule, only: ParticleType, TERM_NO_EXITS, TERM_BOUNDARY
   use ParticleEventModule, only: ParticleEventType
   use CellExitEventModule, only: CellExitEventType
@@ -20,6 +20,7 @@ module MethodCellModule
     procedure, public :: cellexit
     procedure, public :: forms_cycle
     procedure, public :: store_event
+    procedure, public :: get_level
   end type MethodCellType
 
 contains
@@ -182,7 +183,7 @@ subroutine cellexit(this, particle)
     allocate (CellExitEventType :: event)
     select type (event)
     type is (CellExitEventType)
-      event%exit_face = particle%iboundary(2)
+      event%exit_face = particle%iboundary(LEVEL_FEATURE)
     end select
     call this%events%dispatch(particle, event)
     if (particle%icycwin == 0) then
@@ -258,4 +259,11 @@ subroutine store_event(this, particle, event)
     end select
   end subroutine store_event
 
+  !> @brief Get the cell method's level.
+  function get_level(this) result(level)
+    class(MethodCellType), intent(in) :: this
+    integer(I4B) :: level
+    level = LEVEL_FEATURE
+  end function get_level
+
 end module MethodCellModule

src/Solution/ParticleTracker/Method/MethodCellPassToBot.f90

@@ -1,6 +1,7 @@
 module MethodCellPassToBotModule
 
   use KindModule, only: DP, I4B
+  use MethodModule, only: LEVEL_FEATURE
   use MethodCellModule, only: MethodCellType
   use CellDefnModule, only: CellDefnType, create_defn
   use PrtFmiModule, only: PrtFmiType
@@ -55,7 +56,7 @@ subroutine apply_ptb(this, particle, tmax)
 
     ! Pass to bottom face
     particle%z = this%cell%defn%bot
-    particle%iboundary(2) = this%cell%defn%npolyverts + 2
+    particle%iboundary(LEVEL_FEATURE) = this%cell%defn%npolyverts + 2
 
     ! Terminate if in bottom layer
     select type (dis => this%fmi%dis)

src/Solution/ParticleTracker/Method/MethodCellPollock.f90

@@ -2,7 +2,7 @@ module MethodCellPollockModule
 
   use KindModule, only: DP, I4B
   use ConstantsModule, only: DONE, DZERO
-  use MethodModule, only: MethodType
+  use MethodModule, only: MethodType, LEVEL_FEATURE, LEVEL_SUBFEATURE
   use MethodCellModule, only: MethodCellType
   use MethodSubcellPoolModule, only: method_subcell_plck, &
                                      method_subcell_tern
@@ -82,7 +82,7 @@ subroutine pass_mcp(this, particle)
     integer(I4B) :: exitface
     integer(I4B) :: entryface
 
-    exitface = particle%iboundary(3)
+    exitface = particle%iboundary(LEVEL_SUBFEATURE)
     ! Map subcell exit face to cell face
     select case (exitface) ! note: exitFace uses Dave's iface convention
     case (0)
@@ -101,7 +101,7 @@ subroutine pass_mcp(this, particle)
       entryface = 7
     end select
     if (entryface .eq. -1) then
-      particle%iboundary(2) = 0
+      particle%iboundary(LEVEL_FEATURE) = 0
     else
       if ((entryface .ge. 1) .and. (entryface .le. 4)) then
         ! Account for local cell rotation
@@ -111,7 +111,7 @@ subroutine pass_mcp(this, particle)
         end select
         if (entryface .gt. 4) entryface = entryface - 4
       end if
-      particle%iboundary(2) = entryface
+      particle%iboundary(LEVEL_FEATURE) = entryface
     end if
   end subroutine pass_mcp
 
@@ -152,7 +152,7 @@ subroutine apply_mcp(this, particle, tmax)
       call particle%reset_transform()
     end select
 
-    if (particle%iboundary(2) > 0) call this%cellexit(particle)
+    if (particle%iboundary(LEVEL_FEATURE) > 0) call this%cellexit(particle)
   end subroutine apply_mcp
 
   !> @brief Loads the lone rectangular subcell from the rectangular cell