Skip to content

Commit

Permalink
style(prt): clean up comments
Browse files Browse the repository at this point in the history
  • Loading branch information
@wpbonelli
wpbonelli committed Feb 3, 2025
1 parent 963cfaa commit a061c4c
Show file tree
Hide file tree
Showing 7 changed files with 216 additions and 225 deletions.
54 changes: 27 additions & 27 deletions src/Model/ParticleTracking/prt-fmi.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,96 +35,96 @@ module PrtFmiModule

!> @brief Create a new PrtFmi object
subroutine fmi_cr(fmiobj, name_model, inunit, iout)
! -- dummy
! dummy
type(PrtFmiType), pointer :: fmiobj
character(len=*), intent(in) :: name_model
integer(I4B), intent(inout) :: inunit
integer(I4B), intent(in) :: iout
!
! -- Create the object
! Create the object
allocate (fmiobj)
!
! -- create name and memory path
! create name and memory path
call fmiobj%set_names(1, name_model, 'FMI', 'FMI')
fmiobj%text = text
!
! -- Allocate scalars
! Allocate scalars
call fmiobj%allocate_scalars()
!
! -- Set variables
! Set variables
fmiobj%inunit = inunit
fmiobj%iout = iout
!
! -- Initialize block parser
! Initialize block parser
call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%iout)
!
! -- Assign dependent variable label
! Assign dependent variable label
fmiobj%depvartype = 'TRACKS '

end subroutine fmi_cr

!> @brief Time step advance
subroutine fmi_ad(this)
! -- modules
! modules
use ConstantsModule, only: DHDRY
! -- dummy
! dummy
class(PrtFmiType) :: this
! -- local
! local
integer(I4B) :: n
character(len=15) :: nodestr
character(len=*), parameter :: fmtdry = &
&"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE')"
character(len=*), parameter :: fmtrewet = &
&"(/1X,'DRY CELL REACTIVATED AT ', a)"
!
! -- Set flag to indicated that flows are being updated. For the case where
! Set flag to indicated that flows are being updated. For the case where
! flows may be reused (only when flows are read from a file) then set
! the flag to zero to indicated that flows were not updated
this%iflowsupdated = 1
!
! -- If reading flows from a budget file, read the next set of records
! If reading flows from a budget file, read the next set of records
if (this%iubud /= 0) then
call this%advance_bfr()
end if
!
! -- If reading heads from a head file, read the next set of records
! If reading heads from a head file, read the next set of records
if (this%iuhds /= 0) then
call this%advance_hfr()
end if
!
! -- If mover flows are being read from file, read the next set of records
! If mover flows are being read from file, read the next set of records
if (this%iumvr /= 0) then
call this%mvrbudobj%bfr_advance(this%dis, this%iout)
end if
!
! -- Accumulate flows
! Accumulate flows
call this%accumulate_flows()
!
! -- if flow cell is dry, then set this%ibound = 0
! if flow cell is dry, then set this%ibound = 0
do n = 1, this%dis%nodes
!
! -- Calculate the ibound-like array that has 0 if saturation
! Calculate the ibound-like array that has 0 if saturation
! is zero and 1 otherwise
if (this%gwfsat(n) > DZERO) then
this%ibdgwfsat0(n) = 1
else
this%ibdgwfsat0(n) = 0
end if
!
! -- Check if active model cell is inactive for flow
! Check if active model cell is inactive for flow
if (this%ibound(n) > 0) then
if (this%gwfhead(n) == DHDRY) then
! -- cell should be made inactive
! cell should be made inactive
this%ibound(n) = 0
call this%dis%noder_to_string(n, nodestr)
write (this%iout, fmtdry) trim(nodestr)
end if
end if
!
! -- Convert dry model cell to active if flow has rewet
! Convert dry model cell to active if flow has rewet
if (this%ibound(n) == 0) then
if (this%gwfhead(n) /= DHDRY) then
! -- cell is now wet
! cell is now wet
this%ibound(n) = 1
call this%dis%noder_to_string(n, nodestr)
write (this%iout, fmtrewet) trim(nodestr)
Expand All @@ -136,17 +136,17 @@ end subroutine fmi_ad

!> @brief Define the flow model interface
subroutine prtfmi_df(this, dis, idryinactive)
! -- modules
! modules
use SimModule, only: store_error
! -- dummy
! dummy
class(PrtFmiType) :: this
class(DisBaseType), pointer, intent(in) :: dis
integer(I4B), intent(in) :: idryinactive
!
! -- Call parent class define
! Call parent class define
call this%FlowModelInterfaceType%fmi_df(dis, idryinactive)
!
! -- Allocate arrays
! Allocate arrays
allocate (this%StorageFlows(this%dis%nodes))
allocate (this%SourceFlows(this%dis%nodes))
allocate (this%SinkFlows(this%dis%nodes))
Expand All @@ -157,9 +157,9 @@ end subroutine prtfmi_df
!> @brief Accumulate flows
subroutine accumulate_flows(this)
implicit none
! -- dummy
! dummy
class(PrtFmiType) :: this
! -- local
! local
integer(I4B) :: j, i, ip, ib
integer(I4B) :: ioffset, iflowface, iauxiflowface
real(DP) :: qbnd
Expand Down
40 changes: 20 additions & 20 deletions src/Model/ParticleTracking/prt-mip.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,35 +31,35 @@ module PrtMipModule

!> @brief Create a model input object
subroutine mip_cr(mip, name_model, input_mempath, inunit, iout, dis)
! -- dummy
! dummy
type(PrtMipType), pointer :: mip
character(len=*), intent(in) :: name_model
character(len=*), intent(in) :: input_mempath
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
class(DisBaseType), pointer, intent(in) :: dis
! -- formats
! formats
character(len=*), parameter :: fmtheader = &
"(1x, /1x, 'MIP -- MODEL INPUT PACKAGE', &
"(1x, /1x, 'MIP MODEL INPUT PACKAGE', &
&' INPUT READ FROM MEMPATH: ', A, /)"
!
! -- Create the object
! Create the object
allocate (mip)
!
! -- Create name and memory path
! Create name and memory path
call mip%set_names(1, name_model, 'MIP', 'MIP', input_mempath)
!
! -- Allocate scalars
! Allocate scalars
call mip%allocate_scalars()
!
! -- Set variables
! Set variables
mip%inunit = inunit
mip%iout = iout
!
! -- Set pointers
! Set pointers
mip%dis => dis
!
! -- Print a message identifying the package if enabled
! Print a message identifying the package if enabled
if (inunit > 0) &
write (iout, fmtheader) input_mempath

Expand All @@ -69,13 +69,13 @@ end subroutine mip_cr
subroutine mip_da(this)
class(PrtMipType) :: this
!
! -- Deallocate input memory
! Deallocate input memory
call memorystore_remove(this%name_model, 'MIP', idm_context)
!
! -- Deallocate parent package
! Deallocate parent package
call this%NumericalPackageType%da()
!
! -- Deallocate arrays
! Deallocate arrays
call mem_deallocate(this%porosity)
call mem_deallocate(this%retfactor)
call mem_deallocate(this%izone)
Expand All @@ -91,10 +91,10 @@ end subroutine allocate_scalars
subroutine allocate_arrays(this, nodes)
class(PrtMipType) :: this
integer(I4B), intent(in) :: nodes
! -- local
! local
integer(I4B) :: i
!
! -- Allocate
! Allocate
call mem_allocate(this%porosity, nodes, 'POROSITY', this%memoryPath)
call mem_allocate(this%retfactor, nodes, 'RETFACTOR', this%memoryPath)
call mem_allocate(this%izone, nodes, 'IZONE', this%memoryPath)
Expand All @@ -109,28 +109,28 @@ end subroutine allocate_arrays

!> @ brief Initialize package inputs
subroutine mip_ar(this)
! -- dummy variables
! dummy variables
class(PrtMipType), intent(inout) :: this !< PrtMipType object
! -- local variables
! local variables
character(len=LINELENGTH) :: errmsg
type(PrtMipParamFoundType) :: found
integer(I4B), dimension(:), pointer, contiguous :: map => null()
!
! -- set map to convert user input data into reduced data
! set map to convert user input data into reduced data
if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser
!
! -- Allocate arrays
! Allocate arrays
call this%allocate_arrays(this%dis%nodes)
!
! -- Source array inputs from IDM
! Source array inputs from IDM
call mem_set_value(this%porosity, 'POROSITY', this%input_mempath, &
map, found%porosity)
call mem_set_value(this%retfactor, 'RETFACTOR', this%input_mempath, &
map, found%retfactor)
call mem_set_value(this%izone, 'IZONE', this%input_mempath, map, &
found%izone)
!
! -- Ensure POROSITY was found
! Ensure POROSITY was found
if (.not. found%porosity) then
write (errmsg, '(a)') 'Error in GRIDDATA block: POROSITY not found'
call store_error(errmsg)
Expand Down
38 changes: 19 additions & 19 deletions src/Solution/ParticleTracker/CellRectQuad.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,9 +75,9 @@ end subroutine init_from
!! vertices and face flows of a rectangular-quad cell.
!<
subroutine load_rect_verts_flows(this)
! -- dummy
! dummy
class(CellRectQuadType), intent(inout) :: this
! -- local
! local
integer(I4B) :: n, m

n = 0
Expand Down Expand Up @@ -107,21 +107,21 @@ end subroutine load_rect_verts_flows
!! rectangle vertex of a rectangular-quad cell
!<
function get_rect_ivert_sw(this) result(irv1)
! -- dummy
! dummy
class(CellRectQuadType), intent(inout) :: this
integer(I4B) :: irv1
! -- local
! local
integer(I4B) :: irv, irv2, irv4, ipv1, ipv2, ipv4
integer(I4B), dimension(4) :: irvnxt = (/2, 3, 4, 1/)
real(DP) :: x1, y1, x2, y2, x4, y4

! -- Find the "southwest" rectangle vertex by finding the vertex formed
! -- either by (1) a rectangle edge over which x decreases (going
! -- clockwise) followed by an edge over which x does not increase, or by
! -- (2) a rectangle edge over which y does not decrease (again going
! -- clockwise) followed by a rectangle edge over which y increases. In
! -- the end, ipv1 is the index (1, 2, 3, or 4) of the southwest
! -- rectangle vertex.
! Find the "southwest" rectangle vertex by finding the vertex formed
! either by (1) a rectangle edge over which x decreases (going
! clockwise) followed by an edge over which x does not increase, or by
! (2) a rectangle edge over which y does not decrease (again going
! clockwise) followed by a rectangle edge over which y increases. In
! the end, ipv1 is the index (1, 2, 3, or 4) of the southwest
! rectangle vertex.
do irv = 1, 4
irv4 = irv
irv1 = irvnxt(irv4)
Expand Down Expand Up @@ -152,18 +152,18 @@ end function get_rect_ivert_sw
!! as the origin
!<
subroutine get_rect_dim_rot(this)
! -- dummy
! dummy
class(CellRectQuadType), intent(inout) :: this
! -- local
! local
integer(I4B) :: irv2, irv4, ipv1, ipv2, ipv4
integer(I4B), dimension(4) :: irvnxt = (/2, 3, 4, 1/)
real(DP) :: x1, y1, x2, y2, x4, y4, dx2, dy2, dx4, dy4

! -- Get rectangle vertex neighbors irv2 and irv4
! Get rectangle vertex neighbors irv2 and irv4
irv2 = irvnxt(this%irvOrigin)
irv4 = irvnxt(irvnxt(irv2))

! -- Get model coordinates at irv1, irv2, and irv4
! Get model coordinates at irv1, irv2, and irv4
ipv1 = this%irectvert(this%irvOrigin)
x1 = this%defn%polyvert(1, ipv1)
y1 = this%defn%polyvert(2, ipv1)
Expand All @@ -174,7 +174,7 @@ subroutine get_rect_dim_rot(this)
x4 = this%defn%polyvert(1, ipv4)
y4 = this%defn%polyvert(2, ipv4)

! -- Compute rectangle dimensions
! Compute rectangle dimensions
this%xOrigin = x1
this%yOrigin = y1
this%zOrigin = this%defn%bot
Expand All @@ -186,8 +186,8 @@ subroutine get_rect_dim_rot(this)
this%dy = dsqrt(dx2 * dx2 + dy2 * dy2)
this%dz = this%defn%top - this%zOrigin

! -- Compute sine and cosine of rotation angle (angle between "southern"
! -- rectangle side irv1-irv4 and the model x axis)
! Compute sine and cosine of rotation angle (angle between "southern"
! rectangle side irv1-irv4 and the model x axis)
this%sinrot = dy4 / this%dx
this%cosrot = dx4 / this%dx
end subroutine get_rect_dim_rot
Expand All @@ -202,7 +202,7 @@ end function get_rect_flow

!> @brief Return whether a rectangle face is refined
function face_is_refined(this, i) result(is_refined)
! -- dummy
! dummy
class(CellRectQuadType), intent(inout) :: this
integer(I4B) :: i !< face index
logical(LGP) :: is_refined
Expand Down
Loading

0 comments on commit a061c4c

Please sign in to comment.