diff --git a/src/Model/Connection/GridSorting.f90 b/src/Model/Connection/GridSorting.f90 index 5908d931113..5d15fa2382c 100644 --- a/src/Model/Connection/GridSorting.f90 +++ b/src/Model/Connection/GridSorting.f90 @@ -2,7 +2,7 @@ module GridSorting use KindModule, only: I4B, DP, LGP use ConstantsModule, only: DHALF use CellWithNbrsModule, only: GlobalCellType - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use BaseDisModule, only: dis_transform_xy implicit none private @@ -75,11 +75,11 @@ function lessThan(n, m) result(isLess) dis_bot_m(gcm%index)) ! compare - if (.not. is_same(zn, zm, 10 * epsilon(zn))) then + if (.not. is_close(zn, zm, 10 * epsilon(zn))) then isLess = zn > zm - else if (.not. is_same(yn, ym, 10 * epsilon(yn))) then + else if (.not. is_close(yn, ym, 10 * epsilon(yn))) then isLess = yn > ym - else if (.not. is_same(xn, xm, 10 * epsilon(xn))) then + else if (.not. is_close(xn, xm, 10 * epsilon(xn))) then isLess = xn < xm else isLess = .false. diff --git a/src/Model/GroundWaterFlow/gwf3csub8.f90 b/src/Model/GroundWaterFlow/gwf3csub8.f90 index 6a548777103..ec343dc2042 100644 --- a/src/Model/GroundWaterFlow/gwf3csub8.f90 +++ b/src/Model/GroundWaterFlow/gwf3csub8.f90 @@ -19,7 +19,7 @@ module GwfCsubModule TABSTRING, TABUCSTRING, TABINTEGER, TABREAL use MemoryHelperModule, only: create_mem_path use GenericUtilitiesModule, only: sim_message - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use SmoothingModule, only: sQuadraticSaturation, & sQuadraticSaturationDerivative, & sQuadratic0sp, & diff --git a/src/Model/GroundWaterFlow/gwf3lak8.f90 b/src/Model/GroundWaterFlow/gwf3lak8.f90 index 598b6df83a2..c1f0c92bfa8 100644 --- a/src/Model/GroundWaterFlow/gwf3lak8.f90 +++ b/src/Model/GroundWaterFlow/gwf3lak8.f90 @@ -29,7 +29,7 @@ module LakModule use SimModule, only: count_errors, store_error, store_error_unit, & deprecation_warning use GenericUtilitiesModule, only: sim_message - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use BlockParserModule, only: BlockParserType use BaseDisModule, only: DisBaseType use SimVariablesModule, only: errmsg, warnmsg @@ -834,7 +834,7 @@ subroutine lak_read_lake_connections(this) warnmsg, this%parser%GetUnit()) case default read (keyword, *) rval - if (is_same(rval, DNODATA)) then + if (is_close(rval, DNODATA)) then is_lake_bed = .FALSE. else is_lake_bed = .TRUE. @@ -1833,7 +1833,7 @@ subroutine lak_read_initial_attr(this) end if length = this%connlength(j) end if - if (is_same(this%bedleak(j), DNODATA)) then + if (is_close(this%bedleak(j), DNODATA)) then clb(j) = DNODATA else if (this%bedleak(j) > DZERO) then clb(j) = DONE / this%bedleak(j) @@ -1845,7 +1845,7 @@ subroutine lak_read_initial_attr(this) else caq(j) = DZERO end if - if (is_same(this%bedleak(j), DNODATA)) then + if (is_close(this%bedleak(j), DNODATA)) then this%satcond(j) = area / caq(j) else if (clb(j) * caq(j) > DZERO) then this%satcond(j) = area / (clb(j) + caq(j)) @@ -1880,7 +1880,7 @@ subroutine lak_read_initial_attr(this) nn = this%cellid(j) area = this%warea(j) c1 = DZERO - if (is_same(clb(j), DNODATA)) then + if (is_close(clb(j), DNODATA)) then cbedleak = ' NONE ' cbedcond = ' NONE ' else if (clb(j) > DZERO) then @@ -2605,7 +2605,7 @@ subroutine lak_calculate_evaporation(this, ilak, stage, avail, ev) call this%lak_calculate_sarea(ilak, stage, sa) ev = sa * this%evaporation(ilak) if (ev > avail) then - if (is_same(avail, DPREC)) then + if (is_close(avail, DPREC)) then ev = DZERO else ev = -avail diff --git a/src/Solution/LinearMethods/ims8base.f90 b/src/Solution/LinearMethods/ims8base.f90 index 372dfa51c75..62edf89adcd 100644 --- a/src/Solution/LinearMethods/ims8base.f90 +++ b/src/Solution/LinearMethods/ims8base.f90 @@ -10,7 +10,7 @@ MODULE IMSLinearBaseModule use ConstantsModule, only: LINELENGTH, IZERO, & DZERO, DPREC, DEM6, DEM3, DHALF, DONE use GenericUtilitiesModule, only: sim_message - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use BlockParserModule, only: BlockParserType use IMSReorderingModule, only: ims_odrv use ConvergenceSummaryModule @@ -212,7 +212,7 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & IF (ICNVG .NE. 0) EXIT INNER ! ! -- CHECK THAT CURRENT AND PREVIOUS rho ARE DIFFERENT - lsame = is_same(rho, rho0) + lsame = is_close(rho, rho0) IF (lsame) THEN EXIT INNER END IF @@ -514,15 +514,15 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & ! ! -- CHECK THAT CURRENT AND PREVIOUS rho, alpha, AND omega ARE ! DIFFERENT - lsame = is_same(rho, rho0) + lsame = is_close(rho, rho0) IF (lsame) THEN EXIT INNER END IF - lsame = is_same(alpha, alpha0) + lsame = is_close(alpha, alpha0) IF (lsame) THEN EXIT INNER END IF - lsame = is_same(omega, omega0) + lsame = is_close(omega, omega0) IF (lsame) THEN EXIT INNER END IF diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index 02caae32c6f..db78754ba9e 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -14,7 +14,7 @@ module NumericalSolutionModule use MemoryHelperModule, only: create_mem_path use TableModule, only: TableType, table_cr use GenericUtilitiesModule, only: sim_message - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use VersionModule, only: IDEVELOPMODE use BaseModelModule, only: BaseModelType use BaseExchangeModule, only: BaseExchangeType @@ -2476,7 +2476,7 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) end if end if else - lsame = is_same(l2norm, this%l2norm0) + lsame = is_close(l2norm, this%l2norm0) if (lsame) then iptc = 0 end if diff --git a/src/Utilities/InputOutput.f90 b/src/Utilities/InputOutput.f90 index 6dbf44012e2..3662e1cb61e 100644 --- a/src/Utilities/InputOutput.f90 +++ b/src/Utilities/InputOutput.f90 @@ -12,7 +12,7 @@ module InputOutputModule TABSTRING, TABUCSTRING, TABINTEGER, TABREAL, & DZERO use GenericUtilitiesModule, only: sim_message - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close private public :: GetUnit, & UPCASE, URWORD, ULSTLB, UBDSV4, & diff --git a/src/Utilities/TimeSeries/TimeArraySeries.f90 b/src/Utilities/TimeSeries/TimeArraySeries.f90 index e13345a2ddc..7c8c4607bbc 100644 --- a/src/Utilities/TimeSeries/TimeArraySeries.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeries.f90 @@ -4,7 +4,7 @@ module TimeArraySeriesModule use BlockParserModule, only: BlockParserType use ConstantsModule, only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR, & LENTIMESERIESNAME, LENMODELNAME, DZERO, DONE - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use InputOutputModule, only: GetUnit, openfile use KindModule, only: DP, I4B use ListModule, only: ListType, ListNodeType @@ -474,7 +474,7 @@ subroutine get_values_at_time(this, nvals, values, time) ierr = 1 end if else - if (is_same(taEarlier%taTime, time)) then + if (is_close(taEarlier%taTime, time)) then values = taEarlier%taArray else ! -- Only earlier time is available, and it is not time of interest; @@ -488,7 +488,7 @@ subroutine get_values_at_time(this, nvals, values, time) end if else if (associated(taLater)) then - if (is_same(taLater%taTime, time)) then + if (is_close(taLater%taTime, time)) then values = taLater%taArray else ! -- only later time is available, and it is not time of interest @@ -717,7 +717,7 @@ subroutine get_latest_preceding_node(this, time, tslNode) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() ta => CastAsTimeArrayType(obj) - if (ta%taTime < time .or. is_same(ta%taTime, time)) then + if (ta%taTime < time .or. is_close(ta%taTime, time)) then currNode => currNode%nextNode else exit diff --git a/src/Utilities/TimeSeries/TimeSeries.f90 b/src/Utilities/TimeSeries/TimeSeries.f90 index b5cba5ba795..b4a5d9d48f2 100644 --- a/src/Utilities/TimeSeries/TimeSeries.f90 +++ b/src/Utilities/TimeSeries/TimeSeries.f90 @@ -5,7 +5,7 @@ module TimeSeriesModule use ConstantsModule, only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR, & LINEAREND, LENTIMESERIESNAME, LENHUGELINE, & DZERO, DONE, DNODATA - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use InputOutputModule, only: GetUnit, openfile, ParseLine, upcase use ListModule, only: ListType, ListNodeType use SimVariablesModule, only: errmsg @@ -319,7 +319,7 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() tsr => CastAsTimeSeriesRecordType(obj) - if (tsr%tsrTime < time .and. .not. is_same(tsr%tsrTime, time)) then + if (tsr%tsrTime < time .and. .not. is_close(tsr%tsrTime, time)) then currNode => currNode%nextNode else exit @@ -356,7 +356,7 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) obj => tsNode1%GetItem() tsrec1 => CastAsTimeSeriesRecordType(obj) time1 = tsrec1%tsrTime - do while (time1 < time .and. .not. is_same(time1, time)) + do while (time1 < time .and. .not. is_close(time1, time)) if (associated(tsNode1%nextNode)) then tsNode1 => tsNode1%nextNode obj => tsNode1%GetItem() @@ -373,8 +373,8 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) ! end if ! - if (time0 < time .or. is_same(time0, time)) tsrecEarlier => tsrec0 - if (time1 > time .or. is_same(time1, time)) tsrecLater => tsrec1 + if (time0 < time .or. is_close(time0, time)) tsrecEarlier => tsrec0 + if (time1 > time .or. is_close(time1, time)) tsrecLater => tsrec1 ! ! -- Return return @@ -418,7 +418,7 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() tsr => CastAsTimeSeriesRecordType(obj) - if (tsr%tsrTime < time .and. .not. is_same(tsr%tsrTime, time)) then + if (tsr%tsrTime < time .and. .not. is_close(tsr%tsrTime, time)) then currNode => currNode%nextNode else exit @@ -454,7 +454,7 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) obj => tsNode1%GetItem() tsrec1 => CastAsTimeSeriesRecordType(obj) time1 = tsrec1%tsrTime - do while (time1 < time .and. .not. is_same(time1, time)) + do while (time1 < time .and. .not. is_close(time1, time)) if (associated(tsNode1%nextNode)) then tsNode1 => tsNode1%nextNode obj => tsNode1%GetItem() @@ -467,11 +467,11 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) ! end if ! - if (time0 < time .or. is_same(time0, time)) then + if (time0 < time .or. is_close(time0, time)) then tsrecEarlier => tsrec0 nodeEarlier => tsNode0 end if - if (time1 > time .or. is_same(time1, time)) then + if (time1 > time .or. is_close(time1, time)) then tsrecLater => tsrec1 nodeLater => tsNode1 end if @@ -552,7 +552,7 @@ function get_value_at_time(this, time, extendToEndOfSimulation) ierr = 1 end if else - if (extendToEndOfSimulation .or. is_same(tsrEarlier%tsrTime, time)) then + if (extendToEndOfSimulation .or. is_close(tsrEarlier%tsrTime, time)) then get_value_at_time = tsrEarlier%tsrValue else ! -- Only earlier time is available, and it is not time of interest; @@ -566,7 +566,7 @@ function get_value_at_time(this, time, extendToEndOfSimulation) end if else if (associated(tsrLater)) then - if (is_same(tsrLater%tsrTime, time)) then + if (is_close(tsrLater%tsrTime, time)) then get_value_at_time = tsrLater%tsrValue else ! -- only later time is available, and it is not time of interest @@ -624,7 +624,7 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) currObj => currNode%GetItem() currRecord => CastAsTimeSeriesRecordType(currObj) currTime = currRecord%tsrTime - if (is_same(currTime, time1)) then + if (is_close(currTime, time1)) then ! Current node time = time1 so should be ldone ldone = .true. elseif (currTime < time1) then @@ -657,12 +657,12 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) if (lprocess) then ! -- determine lower and upper limits of time span of interest ! within current interval - if (currTime > time0 .or. is_same(currTime, time0)) then + if (currTime > time0 .or. is_close(currTime, time0)) then t0 = currTime else t0 = time0 end if - if (nextTime < time1 .or. is_same(nextTime, time1)) then + if (nextTime < time1 .or. is_close(nextTime, time1)) then t1 = nextTime else t1 = time1 @@ -697,7 +697,7 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) ! -- Are we done yet? if (t1 > time1) then ldone = .true. - elseif (is_same(t1, time1)) then + elseif (is_close(t1, time1)) then ldone = .true. else ! -- We are not done yet @@ -796,7 +796,7 @@ subroutine get_latest_preceding_node(this, time, tslNode) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() tsr => CastAsTimeSeriesRecordType(obj) - if (tsr%tsrTime < time .or. is_same(tsr%tsrTime, time)) then + if (tsr%tsrTime < time .or. is_close(tsr%tsrTime, time)) then currNode => currNode%nextNode else exit @@ -829,7 +829,7 @@ subroutine get_latest_preceding_node(this, time, tslNode) end do end if ! - if (time0 < time .or. is_same(time0, time)) tslNode => tsNode0 + if (time0 < time .or. is_close(time0, time)) tslNode => tsNode0 ! ! -- Return return @@ -946,7 +946,7 @@ function GetTimeSeriesRecord(this, time, epsi) result(res) do tsr => this%GetNextTimeSeriesRecord() if (associated(tsr)) then - if (is_same(tsr%tsrTime, time)) then + if (is_close(tsr%tsrTime, time)) then res => tsr exit end if diff --git a/utils/mf5to6/src/MultiLayerObsModule.f90 b/utils/mf5to6/src/MultiLayerObsModule.f90 index dfd3c69dd7b..e2c87430a8e 100644 --- a/utils/mf5to6/src/MultiLayerObsModule.f90 +++ b/utils/mf5to6/src/MultiLayerObsModule.f90 @@ -2,7 +2,7 @@ module MultiLayerObs use ConstantsModule, only: DONE, MAXCHARLEN use ConstantsPHMFModule, only: LENOBSNAMENEW - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use ListModule, only: ListType use SimModule, only: store_error, ustop @@ -153,7 +153,7 @@ subroutine CheckWeightSum(this) weightsum = weightsum + layobs%weight end do ! - if (.not. is_same(weightsum, DONE)) then + if (.not. is_close(weightsum, DONE)) then write (ermsg, 10) trim(this%mlobsname) call store_error(ermsg) call ustop() diff --git a/utils/mf5to6/src/Preproc/ObsBlock.f90 b/utils/mf5to6/src/Preproc/ObsBlock.f90 index f57a256b29b..c4e51a3562e 100644 --- a/utils/mf5to6/src/Preproc/ObsBlock.f90 +++ b/utils/mf5to6/src/Preproc/ObsBlock.f90 @@ -3,7 +3,7 @@ module ObsBlockModule use BlockParserModule, only: BlockParserType use ConstantsModule, only: DONE, DZERO, & LINELENGTH, MAXCHARLEN, LENOBSNAME - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use ConstantsPHMFModule, only: CONTINUOUS, SINGLE, LENOBSNAMENEW use DnmDis3dModule, only: Dis3dType use GlobalVariablesPHMFModule, only: verbose @@ -184,7 +184,7 @@ subroutine process_block(this, insertLine, WriteBeginEnd, parser) iadjrow = 0 jadjcol = 0 ! - if (.not. is_same(xoff, DZERO)) then + if (.not. is_close(xoff, DZERO)) then if (xoff > DZERO) then if (jcol < ncol) then if (dis3d%idomain(jcol+1, irow, layer) == 1) then @@ -202,7 +202,7 @@ subroutine process_block(this, insertLine, WriteBeginEnd, parser) endif endif ! - if (.not. is_same(yoff, DZERO)) then + if (.not. is_close(yoff, DZERO)) then if (yoff > DZERO) then if (irow > 1) then if (dis3d%idomain(jcol, irow-1, layer) == 1) then diff --git a/utils/mf5to6/src/Preproc/ObservePHMF.f90 b/utils/mf5to6/src/Preproc/ObservePHMF.f90 index 3d8880a2873..c50c7ad5f8d 100644 --- a/utils/mf5to6/src/Preproc/ObservePHMF.f90 +++ b/utils/mf5to6/src/Preproc/ObservePHMF.f90 @@ -15,7 +15,7 @@ module ObserveModule use ConstantsModule, only: DONE, DZERO, LENOBSNAME, & LENOBSTYPE, MAXCHARLEN use ConstantsPHMFModule, only: LENOBSNAMENEW, HUGEDBL, HDRYDEFAULT - use MathUtilModule, only: is_same + use MathUtilModule, only: is_close use ListModule, only: ListType use SimModule, only: store_warning, store_error, & store_error_unit, ustop @@ -206,7 +206,7 @@ subroutine CalcSimVal(this, itime) sumweights = DZERO k = 0 do i=1,nsrc - if (is_same(this%srcvals(itime, i), this%hdry)) then + if (is_close(this%srcvals(itime, i), this%hdry)) then k = k + 1 weights(i) = DZERO else