Skip to content

Commit

Permalink
cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
@wpbonelli
wpbonelli committed Dec 7, 2023
1 parent ec87791 commit d0cd9ec
Show file tree
Hide file tree
Showing 3 changed files with 28 additions and 93 deletions.
14 changes: 7 additions & 7 deletions src/Solution/ParticleTracker/MethodDis.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -433,7 +433,7 @@ subroutine load_cellDefn_flows(this, defn)

! -- Add up net distributed flow
defn%distflow = this%fmi%SourceFlows(ic) + this%fmi%SinkFlows(ic) + &
this%fmi%StorageFlows(ic)
this%fmi%StorageFlows(ic)

! -- Set weak sink flag
if (this%fmi%SinkFlows(ic) .ne. 0d0) then
Expand All @@ -458,18 +458,18 @@ subroutine addBoundaryFlows_cellRect(this, defn)

ioffset = (ic - 1) * 10
defn%faceflow(1) = defn%faceflow(1) + &
this%fmi%BoundaryFlows(ioffset + 1) ! kluge note: should these be additive (seems so)???
this%fmi%BoundaryFlows(ioffset + 1) ! kluge note: should these be additive (seems so)???
defn%faceflow(2) = defn%faceflow(2) + &
this%fmi%BoundaryFlows(ioffset + 2)
this%fmi%BoundaryFlows(ioffset + 2)
defn%faceflow(3) = defn%faceflow(3) + &
this%fmi%BoundaryFlows(ioffset + 3)
this%fmi%BoundaryFlows(ioffset + 3)
defn%faceflow(4) = defn%faceflow(4) + &
this%fmi%BoundaryFlows(ioffset + 4)
this%fmi%BoundaryFlows(ioffset + 4)
defn%faceflow(5) = defn%faceflow(1)
defn%faceflow(6) = defn%faceflow(6) + &
this%fmi%BoundaryFlows(ioffset + 9)
this%fmi%BoundaryFlows(ioffset + 9)
defn%faceflow(7) = defn%faceflow(7) + &
this%fmi%BoundaryFlows(ioffset + 10)
this%fmi%BoundaryFlows(ioffset + 10)

end subroutine addBoundaryFlows_cellRect

Expand Down
40 changes: 21 additions & 19 deletions src/Solution/ParticleTracker/MethodDisv.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ module MethodDisvModule
use CellPolyModule
use ParticleModule
use PrtFmiModule, only: PrtFmiType
use UtilMiscModule, only: allocate_as_needed
use ArrayHandlersModule, only: ExpandArray
use TrackModule, only: TrackControlType
use GeomUtilModule, only: get_jk
implicit none
Expand Down Expand Up @@ -403,10 +403,10 @@ subroutine load_cellDefn_facenbr(this, defn)
ic = defn%icell
npolyverts = defn%npolyverts

! -- Load face neighbors. Note that the facenbr array
! -- does not get reallocated if it is already allocated
! -- to a size greater than or equal to npolyverts+3.
call allocate_as_needed(defn%facenbr, npolyverts + 3)
! -- allocate facenbr array
call ExpandArray(defn%facenbr, npolyverts + 3)

! -- Load face neighbors.
select type (dis => this%fmi%dis) ! kluge type guard
type is (GwfDisvType) ! kluge
defn%facenbr = 0
Expand Down Expand Up @@ -499,10 +499,12 @@ subroutine load_cellDefn_flows(this, defn)
ic = defn%icell
npolyverts = defn%npolyverts

! -- allocate faceflow array
call ExpandArray(defn%faceflow, npolyverts + 3)

! -- Load face flows. Note that the faceflow array
! -- does not get reallocated if it is already allocated
! -- to a size greater than or equal to npolyverts+3.
call allocate_as_needed(defn%faceflow, npolyverts + 3)
defn%faceflow = 0d0

! -- As with polygon nbrs, polygon face flows wrap around for
Expand All @@ -522,7 +524,7 @@ subroutine load_cellDefn_flows(this, defn)

! -- Add up net distributed flow
defn%distflow = this%fmi%SourceFlows(ic) + this%fmi%SinkFlows(ic) + &
this%fmi%StorageFlows(ic)
this%fmi%StorageFlows(ic)

! -- Set weak sink flag
if (this%fmi%SinkFlows(ic) .ne. 0d0) then
Expand Down Expand Up @@ -552,18 +554,18 @@ subroutine addBoundaryFlows_cellRect(this, defn)
ioffset = (ic - 1) * 10
! kluge note: should these be additive (seems so)???
defn%faceflow(1) = defn%faceflow(1) + &
this%fmi%BoundaryFlows(ioffset + 4)
this%fmi%BoundaryFlows(ioffset + 4)
defn%faceflow(2) = defn%faceflow(2) + &
this%fmi%BoundaryFlows(ioffset + 2)
this%fmi%BoundaryFlows(ioffset + 2)
defn%faceflow(3) = defn%faceflow(3) + &
this%fmi%BoundaryFlows(ioffset + 3)
this%fmi%BoundaryFlows(ioffset + 3)
defn%faceflow(4) = defn%faceflow(4) + &
this%fmi%BoundaryFlows(ioffset + 1)
this%fmi%BoundaryFlows(ioffset + 1)
defn%faceflow(5) = defn%faceflow(1)
defn%faceflow(6) = defn%faceflow(6) + &
this%fmi%BoundaryFlows(ioffset + 9)
this%fmi%BoundaryFlows(ioffset + 9)
defn%faceflow(7) = defn%faceflow(7) + &
this%fmi%BoundaryFlows(ioffset + 10)
this%fmi%BoundaryFlows(ioffset + 10)

end subroutine addBoundaryFlows_cellRect

Expand Down Expand Up @@ -624,11 +626,11 @@ subroutine addBoundaryFlows_cellRectQuad(this, defn)
! -- Bottom in position npolyverts+2
m = m + 1
defn%faceflow(m) = defn%faceflow(m) + &
this%fmi%BoundaryFlows(ioffset + 9)
this%fmi%BoundaryFlows(ioffset + 9)
! -- Top in position npolyverts+3
m = m + 1
defn%faceflow(m) = defn%faceflow(m) + &
this%fmi%BoundaryFlows(ioffset + 10)
this%fmi%BoundaryFlows(ioffset + 10)

end subroutine addBoundaryFlows_cellRectQuad

Expand Down Expand Up @@ -681,11 +683,11 @@ subroutine load_cellDefn_ispv180(this, defn) ! kluge note: rename???
ic = defn%icell
npolyverts = defn%npolyverts

! -- Load 180-degree indicator. Note that the ispv180 array
! -- does not get reallocated if it is already allocated
! -- to a size greater than or equal to npolyverts+1.
! -- allocate ispv180 array
call ExpandArray(defn%ispv180, npolyverts + 1)

! -- Load 180-degree indicator.
! -- Also, set flags that indicate how cell can be represented.
call allocate_as_needed(defn%ispv180, npolyverts + 1)
defn%ispv180(1:npolyverts + 1) = .false.
defn%canBeCellRect = .false.
defn%canBeCellRectQuad = .false.
Expand Down
67 changes: 0 additions & 67 deletions src/Solution/ParticleTracker/UtilMisc.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,63 +2,8 @@ module UtilMiscModule
use KindModule, only: DP, I4B, LGP
use ConstantsModule, only: DZERO, DONE
implicit none

interface allocate_as_needed
module procedure allocate_as_needed_int1, allocate_as_needed_dble, &
allocate_as_needed_logical
end interface

contains

!> @brief Allocates or reallocates/resizes an integer(kind=1)
!! array to meet or exceed a specified minimum dimension.
!! kluge note: is there a better way than these new "allocate_as_needed" subroutines???
subroutine allocate_as_needed_int1(i1array, mindim)
! -- dummy
integer(I4B), allocatable, intent(inout) :: i1array(:)
integer(I4B), intent(in) :: mindim

if (.not. ALLOCATED(i1array)) then
allocate (i1array(mindim))
else if (SIZE(i1array) .lt. mindim) then
deallocate (i1array)
allocate (i1array(mindim))
end if

end subroutine allocate_as_needed_int1

!> @brief Allocates or reallocates/resizes a double-precision
!! array to meet or exceed a specified minimum dimension
subroutine allocate_as_needed_dble(darray, mindim)
! -- dummy
real(DP), allocatable, intent(inout) :: darray(:)
integer(I4B), intent(in) :: mindim

if (.not. ALLOCATED(darray)) then
allocate (darray(mindim))
else if (SIZE(darray) .lt. mindim) then
deallocate (darray)
allocate (darray(mindim))
end if

end subroutine allocate_as_needed_dble

!> @brief Allocates or reallocates/resizes a logical
!! array to meet or exceed a specified minimum dimension
subroutine allocate_as_needed_logical(larray, mindim)
! -- dummy
logical(LGP), allocatable, intent(inout) :: larray(:)
integer(I4B), intent(in) :: mindim

if (.not. ALLOCATED(larray)) then
allocate (larray(mindim))
else if (SIZE(larray) .lt. mindim) then
deallocate (larray)
allocate (larray(mindim))
end if

end subroutine allocate_as_needed_logical

!> @brief 3D translation and 2D rotation of coordinates
!! with option to invert transformation
subroutine transform_coords(xin, yin, zin, xout, yout, zout, &
Expand Down Expand Up @@ -115,7 +60,6 @@ subroutine transform_coords(xin, yin, zin, xout, yout, zout, &
zout = zin + zOrigin_add
end if
end if

end subroutine transform_coords

!> @brief Modify transformation by applying an additional
Expand Down Expand Up @@ -191,7 +135,6 @@ subroutine modify_transf(xOrigin, yOrigin, zOrigin, sinrot, cosrot, &
cosrot = cosrot_add * c0 + sinrot_add * s0
end if
end if

end subroutine modify_transf

!> @brief Process option arguments and set defaults and flags
Expand All @@ -208,7 +151,6 @@ subroutine transf_opt_args_prep(xOrigin_add, yOrigin_add, zOrigin_add, &
double precision, optional :: xOrigin_opt, yOrigin_opt, zOrigin_opt
double precision, optional :: sinrot_opt, cosrot_opt
logical, optional :: invert_opt
! -- local

isTranslation_add = .false.
xOrigin_add = DZERO
Expand Down Expand Up @@ -248,12 +190,10 @@ subroutine transf_opt_args_prep(xOrigin_add, yOrigin_add, zOrigin_add, &
end if
invert_add = .false.
if (present(invert_opt)) invert_add = invert_opt

end subroutine transf_opt_args_prep

!> @brief Adds a specified amount to an index and "wraps" the result if needed
function add_wrap(istart, iadd, ilimit) result(iwrapped)
! -- dummy
integer :: istart, iadd, ilimit, iwrapped

! -- Add iadd to istart. If the result exceeds ilimit, wrap around
Expand All @@ -264,13 +204,11 @@ function add_wrap(istart, iadd, ilimit) result(iwrapped)
! -- no greater than ilimit.
iwrapped = istart + iadd
if (iwrapped .gt. ilimit) iwrapped = iwrapped - ilimit

end function add_wrap

!> @brief Subtracts a specified amount from an index and "wraps" the
!! result if necessary
function subtr_wrap(istart, isubtr, ilimit) result(iwrapped)
! -- dummy
integer :: istart, isubtr, ilimit, iwrapped

! -- Subtract isubtr from istart. If the result is less than 1, wrap
Expand All @@ -281,12 +219,10 @@ function subtr_wrap(istart, isubtr, ilimit) result(iwrapped)
! -- no greater than ilimit.
iwrapped = istart - isubtr
if (iwrapped .lt. 1) iwrapped = iwrapped + ilimit

end function subtr_wrap

!> @brief Increments an index, "wrapping" the result if necessary
function incr_wrap(istart, ilimit) result(iwrapped)
! -- dummy
integer :: istart, ilimit, iwrapped

! -- Increment istart. If istart is at ilimit, wrap around to 1. It is
Expand All @@ -296,12 +232,10 @@ function incr_wrap(istart, ilimit) result(iwrapped)
else
iwrapped = 1
end if

end function incr_wrap

!> @brief Decrements an index, "wrapping" the result if necessary
function decr_wrap(istart, ilimit) result(iwrapped)
! -- dummy
integer :: istart, ilimit, iwrapped

! -- Decrement istart. If istart is 1, wrap around to ilimit. It is
Expand All @@ -311,7 +245,6 @@ function decr_wrap(istart, ilimit) result(iwrapped)
else
iwrapped = ilimit
end if

end function decr_wrap

end module UtilMiscModule

0 comments on commit d0cd9ec

Please sign in to comment.