From ae9e0e1f6e5fc7498a6931bcebb45f48248f4c95 Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Wed, 6 Dec 2023 21:44:58 -0500 Subject: [PATCH] refactor(ListModule): trim dependencies, add defaults, add docstrings (#1484) * add/format docstrings for ListType type-bound procedures * add default equality predicate associated(x, y) for ListType%ContainsObject * just print programmer errors instead of using sim_message() in ArrayHandlersModule * move/refactor stop_with_error() -> ErrorUtilModule pstop()... avoid sim-related dependencies --- make/makefile | 59 ++++---- msvs/mf6core.vfproj | 1 + msvs/mf6lib.vfproj | 1 + src/Model/Connection/ConnectionBuilder.f90 | 2 +- src/Model/Connection/GridConnection.f90 | 6 +- src/Solution/NumericalSolution.f90 | 5 +- src/Utilities/ArrayHandlers.f90 | 63 ++------- src/Utilities/DevFeature.f90 | 8 +- src/Utilities/ErrorUtil.f90 | 26 ++++ src/Utilities/List.f90 | 155 ++++++--------------- src/Utilities/Sim.f90 | 9 +- src/Utilities/genericutils.f90 | 24 ---- src/meson.build | 1 + utils/mf5to6/make/makefile | 9 +- utils/mf5to6/msvs/mf5to6.vfproj | 1 + utils/mf5to6/pymake/extrafiles.txt | 1 + utils/zonebudget/make/makefile | 1 + utils/zonebudget/msvs/zonebudget.vfproj | 1 + utils/zonebudget/pymake/extrafiles.txt | 1 + 19 files changed, 137 insertions(+), 237 deletions(-) create mode 100644 src/Utilities/ErrorUtil.f90 diff --git a/make/makefile b/make/makefile index 721c8571989..8d594705129 100644 --- a/make/makefile +++ b/make/makefile @@ -6,35 +6,35 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src SOURCEDIR2=../src/Exchange -SOURCEDIR3=../src/Model -SOURCEDIR4=../src/Model/Geometry -SOURCEDIR5=../src/Model/TransportModel -SOURCEDIR6=../src/Model/ModelUtilities -SOURCEDIR7=../src/Model/Connection -SOURCEDIR8=../src/Model/GroundWaterTransport -SOURCEDIR9=../src/Model/GroundWaterFlow -SOURCEDIR10=../src/Distributed -SOURCEDIR11=../src/Solution -SOURCEDIR12=../src/Solution/PETSc -SOURCEDIR13=../src/Solution/LinearMethods -SOURCEDIR14=../src/Timing -SOURCEDIR15=../src/Utilities -SOURCEDIR16=../src/Utilities/TimeSeries -SOURCEDIR17=../src/Utilities/Libraries -SOURCEDIR18=../src/Utilities/Libraries/rcm -SOURCEDIR19=../src/Utilities/Libraries/sparsekit -SOURCEDIR20=../src/Utilities/Libraries/sparskit2 -SOURCEDIR21=../src/Utilities/Libraries/blas -SOURCEDIR22=../src/Utilities/Libraries/daglib -SOURCEDIR23=../src/Utilities/Idm -SOURCEDIR24=../src/Utilities/Idm/selector -SOURCEDIR25=../src/Utilities/Idm/mf6blockfile -SOURCEDIR26=../src/Utilities/Matrix -SOURCEDIR27=../src/Utilities/Vector -SOURCEDIR28=../src/Utilities/Observation -SOURCEDIR29=../src/Utilities/OutputControl -SOURCEDIR30=../src/Utilities/Memory -SOURCEDIR31=../src/Utilities/ArrayRead +SOURCEDIR3=../src/Distributed +SOURCEDIR4=../src/Solution +SOURCEDIR5=../src/Solution/LinearMethods +SOURCEDIR6=../src/Solution/PETSc +SOURCEDIR7=../src/Timing +SOURCEDIR8=../src/Utilities +SOURCEDIR9=../src/Utilities/Idm +SOURCEDIR10=../src/Utilities/Idm/selector +SOURCEDIR11=../src/Utilities/Idm/mf6blockfile +SOURCEDIR12=../src/Utilities/TimeSeries +SOURCEDIR13=../src/Utilities/Memory +SOURCEDIR14=../src/Utilities/OutputControl +SOURCEDIR15=../src/Utilities/ArrayRead +SOURCEDIR16=../src/Utilities/Libraries +SOURCEDIR17=../src/Utilities/Libraries/rcm +SOURCEDIR18=../src/Utilities/Libraries/blas +SOURCEDIR19=../src/Utilities/Libraries/sparskit2 +SOURCEDIR20=../src/Utilities/Libraries/daglib +SOURCEDIR21=../src/Utilities/Libraries/sparsekit +SOURCEDIR22=../src/Utilities/Vector +SOURCEDIR23=../src/Utilities/Matrix +SOURCEDIR24=../src/Utilities/Observation +SOURCEDIR25=../src/Model +SOURCEDIR26=../src/Model/Connection +SOURCEDIR27=../src/Model/GroundWaterTransport +SOURCEDIR28=../src/Model/ModelUtilities +SOURCEDIR29=../src/Model/GroundWaterFlow +SOURCEDIR30=../src/Model/TransportModel +SOURCEDIR31=../src/Model/Geometry VPATH = \ ${SOURCEDIR1} \ @@ -75,6 +75,7 @@ OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ $(OBJDIR)/SimVariables.o \ +$(OBJDIR)/ErrorUtil.o \ $(OBJDIR)/genericutils.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index fc83f1729b4..e726cc70f89 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -385,6 +385,7 @@ + diff --git a/msvs/mf6lib.vfproj b/msvs/mf6lib.vfproj index 9273b73d8ce..7186195f1e3 100644 --- a/msvs/mf6lib.vfproj +++ b/msvs/mf6lib.vfproj @@ -144,6 +144,7 @@ + diff --git a/src/Model/Connection/ConnectionBuilder.f90 b/src/Model/Connection/ConnectionBuilder.f90 index 4cf244cc59b..7fbe65b5fc0 100644 --- a/src/Model/Connection/ConnectionBuilder.f90 +++ b/src/Model/Connection/ConnectionBuilder.f90 @@ -2,7 +2,7 @@ module ConnectionBuilderModule use KindModule, only: I4B, LGP use SimModule, only: store_error, count_errors, ustop use SimVariablesModule, only: iout - use ListModule, only: ListType, arePointersEqual, isEqualIface, ListNodeType + use ListModule, only: ListType, isEqualIface, ListNodeType use BaseSolutionModule, only: BaseSolutionType use NumericalSolutionModule, only: NumericalSolutionType use BaseExchangeModule, only: BaseExchangeType, GetBaseExchangeFromList diff --git a/src/Model/Connection/GridConnection.f90 b/src/Model/Connection/GridConnection.f90 index 4530aee1df5..ae4b45e075f 100644 --- a/src/Model/Connection/GridConnection.f90 +++ b/src/Model/Connection/GridConnection.f90 @@ -9,7 +9,7 @@ module GridConnectionModule use CharacterStringModule use MemoryManagerModule, only: mem_allocate, mem_deallocate use MemoryHelperModule, only: create_mem_path - use ListModule, only: ListType, isEqualIface, arePointersEqual + use ListModule, only: ListType, isEqualIface use NumericalModelModule use GwfDisuModule use DisConnExchangeModule @@ -218,11 +218,9 @@ subroutine addToRegionalModels(this, v_model) class(VirtualModelType), pointer :: v_model !< the model to add to the region ! local class(*), pointer :: vm_obj - procedure(isEqualIface), pointer :: areEqualMethod vm_obj => v_model - areEqualMethod => arePointersEqual - if (.not. this%regionalModels%ContainsObject(vm_obj, areEqualMethod)) then + if (.not. this%regionalModels%ContainsObject(vm_obj)) then call this%regionalModels%Add(vm_obj) end if diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index f9fb303dbe7..6670e416f47 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -2,6 +2,7 @@ module NumericalSolutionModule use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop use TimerModule, only: code_timer use ConstantsModule, only: LINELENGTH, LENSOLUTIONNAME, LENPAKLOC, & DPREC, DZERO, DEM20, DEM15, DEM6, & @@ -12,7 +13,7 @@ module NumericalSolutionModule LENMEMPATH use MemoryHelperModule, only: create_mem_path use TableModule, only: TableType, table_cr - use GenericUtilitiesModule, only: is_same, sim_message, stop_with_error + use GenericUtilitiesModule, only: is_same, sim_message use VersionModule, only: IDEVELOPMODE use BaseModelModule, only: BaseModelType use BaseExchangeModule, only: BaseExchangeType @@ -1610,7 +1611,7 @@ subroutine solve(this, kiter) WRITE (99, *) 'MATRIX SOLUTION FOLLOWS' WRITE (99, '(10(I8,G15.4))') (n, this%x(N), N=1, this%NEQ) close (99) - call stop_with_error() + call pstop() end if !------------------------------------------------------- ! diff --git a/src/Utilities/ArrayHandlers.f90 b/src/Utilities/ArrayHandlers.f90 index 920abb49867..f716cd0f49d 100644 --- a/src/Utilities/ArrayHandlers.f90 +++ b/src/Utilities/ArrayHandlers.f90 @@ -1,9 +1,8 @@ module ArrayHandlersModule use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO, DTEN - use SimVariablesModule, only: iout - use GenericUtilitiesModule, only: sim_message, stop_with_error implicit none private public :: ExpandArray, ExpandArray2D, ExpandArrayWrapper, ExtendPtrArray @@ -200,7 +199,6 @@ subroutine expand_character(array, increment) character(len=*), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment ! -- local - character(len=LINELENGTH) :: line character(len=MAXCHARLEN), allocatable, dimension(:) :: array_temp integer(I4B) :: i, inclocal, isize, lenc, newsize ! -- format @@ -209,16 +207,8 @@ subroutine expand_character(array, increment) ! -- check character length lenc = len(array) if (lenc > MAXCHARLEN) then - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Need to increase MAXCHARLEN' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) + call pstop(138, 'Error in ArrayHandlersModule: '// & + 'Need to increase MAXCHARLEN. Stopping...') end if ! ! -- initialize @@ -339,7 +329,6 @@ subroutine extend_double(array, increment) real(DP), dimension(:), pointer, contiguous, intent(inout) :: array integer(I4B), optional, intent(in) :: increment ! -- local - character(len=LINELENGTH) :: line character(len=100) :: ermsg integer(I4B) :: i, inclocal, isize, istat, newsize real(DP), dimension(:), pointer, contiguous :: array_temp => null() @@ -375,20 +364,8 @@ subroutine extend_double(array, increment) ! -- Error reporting 99 continue - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Could not increase array size' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- error message - call sim_message(ermsg, iunit=iout) - call sim_message(ermsg) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) + call pstop(138, 'Error in ArrayHandlersModule: '// & + 'Could not increase array size. Stopping...') end subroutine extend_double @@ -397,7 +374,6 @@ subroutine extend_integer(array, increment) integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: array integer(I4B), optional, intent(in) :: increment ! -- local - character(len=LINELENGTH) :: line character(len=100) :: ermsg integer(I4B) :: i, inclocal, isize, istat, newsize integer(I4B), dimension(:), pointer, contiguous :: array_temp => null() @@ -433,20 +409,8 @@ subroutine extend_integer(array, increment) ! -- Error reporting 99 continue - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Could not increase array size' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- error message - call sim_message(ermsg, iunit=iout) - call sim_message(ermsg) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) + call pstop(138, 'Error in ArrayHandlersModule: '// & + 'Could not increase array size. Stopping ...') end subroutine extend_integer @@ -536,7 +500,6 @@ subroutine remove_character(array, ipos) character(len=*), allocatable, intent(inout) :: array(:) integer(I4B), intent(in) :: ipos ! -- local - character(len=LINELENGTH) :: line character(len=MAXCHARLEN), allocatable, dimension(:) :: array_temp integer(I4B) :: i, isize, lenc, newsize, inew ! -- format @@ -546,16 +509,8 @@ subroutine remove_character(array, ipos) lenc = len(array) if (lenc > MAXCHARLEN) then - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Need to increase MAXCHARLEN' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) + call pstop(138, 'Error in ArrayHandlersModule: '// & + 'Need to increase MAXCHARLEN. Stopping...') end if ! ! -- calculate sizes diff --git a/src/Utilities/DevFeature.f90 b/src/Utilities/DevFeature.f90 index 60a7ff10637..a36e1fb22e2 100644 --- a/src/Utilities/DevFeature.f90 +++ b/src/Utilities/DevFeature.f90 @@ -9,7 +9,7 @@ module DevFeatureModule contains - !> @ brief Development feature, terminate if in release mode + !> @brief Terminate if in release mode (guard development features) !! !! Terminate the program with an error if the IDEVELOPMODE flag !! is set to 0. This allows developing features on the mainline @@ -21,7 +21,7 @@ subroutine dev_feature(errmsg, iunit) ! -- dummy character(len=*), intent(in) :: errmsg integer(I4B), intent(in), optional :: iunit - ! + ! -- store error and terminate if in release mode if (IDEVELOPMODE == 0) then if (present(iunit)) then @@ -31,9 +31,7 @@ subroutine dev_feature(errmsg, iunit) call store_error(errmsg, terminate=.true.) end if end if - ! - ! -- return - return + end subroutine dev_feature end module DevFeatureModule diff --git a/src/Utilities/ErrorUtil.f90 b/src/Utilities/ErrorUtil.f90 new file mode 100644 index 00000000000..f967168d906 --- /dev/null +++ b/src/Utilities/ErrorUtil.f90 @@ -0,0 +1,26 @@ +module ErrorUtilModule + use KindModule, only: I4B + implicit none +contains + + !> @brief Stop the program, optionally specifying an error status code. + !! + !! If a non-zero status is specified, the program is terminated with the + !! error status code. If no status is specified or status=0, the program + !! stops with code 0. A message may be provided to print before exiting, + !! useful e.g. for "contact developer" messages upon programming errors. + !< + subroutine pstop(status, message) + integer(I4B), intent(in), optional :: status !< optional error code to return (default=0) + character(len=*), intent(in), optional :: message !< optional message to print before stopping + + if (present(message)) print *, message + if (present(status)) then + if (status == 0) stop + call exit(status) + else + stop + end if + end subroutine pstop + +end module ErrorUtilModule diff --git a/src/Utilities/List.f90 b/src/Utilities/List.f90 index 1273359f0ce..70ac71dd502 100644 --- a/src/Utilities/List.f90 +++ b/src/Utilities/List.f90 @@ -1,12 +1,12 @@ module ListModule - ! -- ListType implements a generic list. use KindModule, only: DP, I4B + use ErrorUtilModule, only: pstop use ConstantsModule, only: LINELENGTH - use GenericUtilitiesModule, only: sim_message, stop_with_error implicit none private - public :: ListType, ListNodeType, isEqualIface, arePointersEqual + public :: ListType, ListNodeType, isEqualIface + !> @brief A generic heterogeneous doubly-linked list. type :: ListType ! -- Public members type(ListNodeType), pointer, public :: firstNode => null() @@ -65,8 +65,7 @@ function isEqualIface(obj1, obj2) result(isEqual) contains - ! -- Public type-bound procedures for ListType - + !> @brief Append the given item to the list subroutine Add(this, objptr) ! -- dummy variables class(ListType), intent(inout) :: this @@ -84,17 +83,10 @@ subroutine Add(this, objptr) this%lastNode => this%lastNode%nextNode end if this%nodeCount = this%nodeCount + 1 - return end subroutine Add + !> @brief Deallocate all items in list subroutine Clear(this, destroy) - ! ************************************************************************** - ! clear_list (finalizer) - ! Deallocate all items in linked list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy variables class(ListType) :: this logical, intent(in), optional :: destroy @@ -130,32 +122,21 @@ subroutine Clear(this, destroy) end do ! call this%Reset() - ! - return + end subroutine Clear + !> @brief Return number of nodes in list function Count(this) - ! ************************************************************************** - ! Count - ! Return number of nodes in linked list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- - ! -- return integer(I4B) :: Count - ! -- dummy variables class(ListType) :: this - ! Count = this%nodeCount - ! - return end function Count + !> @brief Determine whether the list contains the given object. function ContainsObject(this, obj, isEqual) result(hasObj) class(ListType), intent(inout) :: this class(*), pointer :: obj - procedure(isEqualIface), pointer, intent(in) :: isEqual + procedure(isEqualIface), pointer, intent(in), optional :: isEqual logical :: hasObj ! local type(ListNodeType), pointer :: current => null() @@ -163,33 +144,26 @@ function ContainsObject(this, obj, isEqual) result(hasObj) hasObj = .false. current => this%firstNode do while (associated(current)) - if (isEqual(current%Value, obj)) then - hasObj = .true. - return + if (present(isEqual)) then + if (isEqual(current%Value, obj)) then + hasObj = .true. + return + end if + else + if (associated(current%Value, obj)) then + hasObj = .true. + return + end if end if ! -- Advance to the next node current => current%nextNode end do - ! this means there is no match - return end function - function arePointersEqual(obj1, obj2) result(areIdentical) - class(*), pointer :: obj1, obj2 - logical :: areIdentical - areIdentical = associated(obj1, obj2) - end function arePointersEqual - + !> @brief Deallocate fromNode and all previous nodes, and reassign firstNode. subroutine DeallocateBackward(this, fromNode) - ! ************************************************************************** - ! DeallocateBackward - ! Deallocate fromNode and all previous nodes in list; reassign firstNode. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(ListType), target, intent(inout) :: this type(ListNodeType), pointer, intent(inout) :: fromNode @@ -215,10 +189,10 @@ subroutine DeallocateBackward(this, fromNode) end do fromNode => null() end if - ! - return + end subroutine DeallocateBackward + !> @brief Get the index of the given item in the list. function GetIndex(this, obj) result(idx) class(ListType), target, intent(inout) :: this class(*), pointer :: obj @@ -238,33 +212,29 @@ function GetIndex(this, obj) result(idx) end function GetIndex + !> @brief Get the next item in the list function GetNextItem(this) result(resultobj) class(ListType), target, intent(inout) :: this - ! result class(*), pointer :: resultobj - ! call this%Next() resultobj => this%get_current_item() - return end function GetNextItem + !> @brief Get the previous item in the list function GetPreviousItem(this) result(resultobj) class(ListType), target, intent(inout) :: this - ! result class(*), pointer :: resultobj - ! call this%Previous() resultobj => this%get_current_item() - return end function GetPreviousItem + !> @brief Insert the given item after the given index. subroutine InsertAfter(this, objptr, indx) ! -- dummy class(ListType), intent(inout) :: this class(*), pointer, intent(inout) :: objptr integer(I4B), intent(in) :: indx ! -- local - character(len=LINELENGTH) :: line integer(I4B) :: numnodes type(ListNodeType), pointer :: precedingNode => null() type(ListNodeType), pointer :: followingNode => null() @@ -285,17 +255,14 @@ subroutine InsertAfter(this, objptr, indx) followingNode%prevNode => newNode this%nodeCount = this%nodeCount + 1 else - write (line, '(a)') 'Programming error in ListType%insert_after' - call sim_message(line) - call stop_with_error(1) + call pstop(1, 'Programming error in ListType%insert_after') end if end if - ! - return + end subroutine InsertAfter + !> @brief Insert the given item before the given node. subroutine InsertBefore(this, objptr, targetNode) - ! Insert an object into the list in front of a target node ! -- dummy class(ListType), intent(inout) :: this class(*), pointer, intent(inout) :: objptr @@ -303,9 +270,8 @@ subroutine InsertBefore(this, objptr, targetNode) ! -- local type(ListNodeType), pointer :: newNode => null() ! - if (.not. associated(targetNode)) then - stop 'Programming error, likely in call to ListType%InsertBefore' - end if + if (.not. associated(targetNode)) & + call pstop(1, 'Programming error in ListType%InsertBefore') ! ! Allocate a new list node and point its Value member to the object allocate (newNode) @@ -324,13 +290,13 @@ subroutine InsertBefore(this, objptr, targetNode) end if targetNode%prevNode => newNode this%nodeCount = this%nodeCount + 1 - ! - return + end subroutine InsertBefore + !> @brief Move the list's current node pointer and index one node forwards. subroutine Next(this) class(ListType), target, intent(inout) :: this - ! + if (this%currentNodeIndex == 0) then if (associated(this%firstNode)) then this%currentNode => this%firstNode @@ -348,29 +314,27 @@ subroutine Next(this) this%currentNodeIndex = 0 end if end if - return end subroutine Next + !> @brief Move the list's current node pointer and index one node backwards. subroutine Previous(this) class(ListType), target, intent(inout) :: this - ! if (this%currentNodeIndex <= 1) then call this%Reset() else this%currentNode => this%currentNode%prevNode this%currentNodeIndex = this%currentNodeIndex - 1 end if - return end subroutine Previous + !> @brief Reset the list's current node pointer and index. subroutine Reset(this) class(ListType), target, intent(inout) :: this - ! this%currentNode => null() this%currentNodeIndex = 0 - return end subroutine Reset + !> @brief Remove the node at the given index, optionally destroying its value. subroutine remove_node_by_index(this, i, destroyValue) ! -- dummy class(ListType), intent(inout) :: this @@ -384,10 +348,10 @@ subroutine remove_node_by_index(this, i, destroyValue) if (associated(node)) then call this%remove_this_node(node, destroyValue) end if - ! - return + end subroutine remove_node_by_index + !> @brief Remove the given node, optionally destroying its value. subroutine remove_this_node(this, node, destroyValue) ! -- dummy class(ListType), intent(inout) :: this @@ -432,12 +396,12 @@ subroutine remove_this_node(this, node, destroyValue) end if call this%Reset() end if - ! - return + end subroutine remove_this_node ! -- Private type-bound procedures for ListType + !> @brief Get a pointer to the item at the current node. function get_current_item(this) result(resultobj) class(ListType), target, intent(inout) :: this ! result @@ -447,17 +411,10 @@ function get_current_item(this) result(resultobj) if (associated(this%currentNode)) then resultobj => this%currentNode%Value end if - return end function get_current_item + !> @brief Get a pointer to the item at the given index. function get_item_by_index(this, indx) result(resultobj) - ! ************************************************************************** - ! get_item_by_index (implements GetItem) - ! Return object stored in ListNodeType%Value by index in list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(ListType), intent(inout) :: this integer(I4B), intent(in) :: indx @@ -511,17 +468,10 @@ function get_item_by_index(this, indx) result(resultobj) return end if end do - return end function get_item_by_index + !> @brief Get the node at the given index function get_node_by_index(this, indx) result(resultnode) - ! ************************************************************************** - ! get_item_by_index (implements GetItem) - ! Return object stored in ListNodeType%Value by index in list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(ListType), intent(inout) :: this integer(I4B), intent(in) :: indx @@ -572,36 +522,22 @@ function get_node_by_index(this, indx) result(resultnode) return end if end do - return end function get_node_by_index ! -- Type-bound procedures for ListNodeType + !> @brief Return a pointer to this node's value. function GetItem(this) result(valueObject) - ! ************************************************************************ - ! Perform a pointer assignment of valueObject to the contents of - ! this%Value - ! ************************************************************************ - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------ class(ListNodeType), intent(inout) :: this class(*), pointer :: valueObject - ! valueObject => this%Value - return end function GetItem + !> @brief Nullify (optionally deallocating) this node's value. subroutine DeallocValue(this, destroy) - ! ************************************************************************ - ! Deallocate whatever is stored in the Value component of this node. - ! ************************************************************************ - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------ class(ListNodeType), intent(inout) :: this logical, intent(in), optional :: destroy - ! + if (associated(this%Value)) then if (present(destroy)) then if (destroy) then @@ -610,7 +546,6 @@ subroutine DeallocValue(this, destroy) end if nullify (this%Value) end if - return end subroutine DeallocValue end module ListModule diff --git a/src/Utilities/Sim.f90 b/src/Utilities/Sim.f90 index 298f0c544a5..3535296d972 100644 --- a/src/Utilities/Sim.f90 +++ b/src/Utilities/Sim.f90 @@ -10,6 +10,7 @@ module SimModule use KindModule, only: DP, I4B + use ErrorUtilModule, only: pstop use DefinedMacros, only: get_os use ConstantsModule, only: MAXCHARLEN, LINELENGTH, & DONE, & @@ -19,7 +20,7 @@ module SimModule use SimVariablesModule, only: istdout, iout, isim_level, ireturnerr, & iforcestop, iunext, & warnmsg - use GenericUtilitiesModule, only: sim_message, stop_with_error + use GenericUtilitiesModule, only: sim_message use MessageModule, only: MessageType implicit none @@ -370,8 +371,8 @@ subroutine ustop(stopmess, ioutlocal) ! -- print the final message call print_final_message(stopmess, ioutlocal) ! - ! -- return appropriate error codes when terminating the program - call stop_with_error(ireturnerr) + ! -- terminate with the appropriate error code + call pstop(ireturnerr) end subroutine ustop @@ -569,7 +570,7 @@ subroutine final_message() ! ! -- return or halt if (iforcestop == 1) then - call stop_with_error(ireturnerr) + call pstop(ireturnerr) end if end subroutine final_message diff --git a/src/Utilities/genericutils.f90 b/src/Utilities/genericutils.f90 index 549e3476d17..70cc58bb75c 100644 --- a/src/Utilities/genericutils.f90 +++ b/src/Utilities/genericutils.f90 @@ -19,7 +19,6 @@ module GenericUtilitiesModule public :: write_message public :: write_centered public :: is_same - public :: stop_with_error contains @@ -387,27 +386,4 @@ function is_same(a, b, eps) result(lvalue) return end function is_same - !> @brief Subroutine to stop the program - !! - !! Subroutine to stop the program and issue the correct return code. - !! - !< - subroutine stop_with_error(ierr) - ! -- dummy variables - integer(I4B), intent(in), optional :: ierr !< optional error code to return (default=0) - ! -- local variables - integer(I4B) :: ireturn_err - ! - ! -- process optional dummy variables - if (present(ierr)) then - ireturn_err = ierr - else - ireturn_err = 0 - end if - - ! -- return the correct return code - call exit(ireturn_err) - - end subroutine stop_with_error - end module GenericUtilitiesModule diff --git a/src/meson.build b/src/meson.build index e9a2bb01386..cfdd7a601bd 100644 --- a/src/meson.build +++ b/src/meson.build @@ -226,6 +226,7 @@ modflow_sources = files( 'Utilities' / 'Constants.f90', 'Utilities' / 'defmacro.F90', 'Utilities' / 'DevFeature.f90', + 'Utilities' / 'ErrorUtil.f90', 'Utilities' / 'genericutils.f90', 'Utilities' / 'GeomUtil.f90', 'Utilities' / 'HashTable.f90', diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index bc180329a32..621d30e3a1d 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -5,10 +5,10 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src -SOURCEDIR2=../src/LGR -SOURCEDIR3=../src/Preproc -SOURCEDIR4=../src/MF2005 -SOURCEDIR5=../src/NWT +SOURCEDIR2=../src/NWT +SOURCEDIR3=../src/LGR +SOURCEDIR4=../src/Preproc +SOURCEDIR5=../src/MF2005 SOURCEDIR6=../../../src/Utilities/Memory SOURCEDIR7=../../../src/Utilities/TimeSeries SOURCEDIR8=../../../src/Utilities @@ -43,6 +43,7 @@ $(OBJDIR)/TableTerm.o \ $(OBJDIR)/Table.o \ $(OBJDIR)/MemoryHelper.o \ $(OBJDIR)/CharString.o \ +$(OBJDIR)/ErrorUtil.o \ $(OBJDIR)/Memory.o \ $(OBJDIR)/List.o \ $(OBJDIR)/MemoryList.o \ diff --git a/utils/mf5to6/msvs/mf5to6.vfproj b/utils/mf5to6/msvs/mf5to6.vfproj index 659749449f7..93f8637e238 100644 --- a/utils/mf5to6/msvs/mf5to6.vfproj +++ b/utils/mf5to6/msvs/mf5to6.vfproj @@ -104,6 +104,7 @@ + diff --git a/utils/mf5to6/pymake/extrafiles.txt b/utils/mf5to6/pymake/extrafiles.txt index 343fddbb95b..7d95ddb2adf 100644 --- a/utils/mf5to6/pymake/extrafiles.txt +++ b/utils/mf5to6/pymake/extrafiles.txt @@ -10,6 +10,7 @@ ../../../src/Utilities/SimVariables.f90 ../../../src/Utilities/compilerversion.F90 ../../../src/Utilities/genericutils.f90 +../../../src/Utilities/ErrorUtil.f90 ../../../src/Utilities/InputOutput.f90 ../../../src/Utilities/kind.f90 ../../../src/Utilities/List.f90 diff --git a/utils/zonebudget/make/makefile b/utils/zonebudget/make/makefile index 033ff998ba0..da71a89f852 100644 --- a/utils/zonebudget/make/makefile +++ b/utils/zonebudget/make/makefile @@ -17,6 +17,7 @@ OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ $(OBJDIR)/SimVariables.o \ +$(OBJDIR)/ErrorUtil.o \ $(OBJDIR)/genericutils.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ diff --git a/utils/zonebudget/msvs/zonebudget.vfproj b/utils/zonebudget/msvs/zonebudget.vfproj index f6fb2420c05..d77e3204c8f 100644 --- a/utils/zonebudget/msvs/zonebudget.vfproj +++ b/utils/zonebudget/msvs/zonebudget.vfproj @@ -45,6 +45,7 @@ + diff --git a/utils/zonebudget/pymake/extrafiles.txt b/utils/zonebudget/pymake/extrafiles.txt index f957dc49813..e5e75b3d7bd 100644 --- a/utils/zonebudget/pymake/extrafiles.txt +++ b/utils/zonebudget/pymake/extrafiles.txt @@ -5,6 +5,7 @@ ../../../src/Utilities/Constants.f90 ../../../src/Utilities/compilerversion.F90 ../../../src/Utilities/genericutils.f90 +../../../src/Utilities/ErrorUtil.f90 ../../../src/Utilities/InputOutput.f90 ../../../src/Utilities/kind.f90 ../../../src/Utilities/LongLineReader.f90