swap is_close for is_same (should be identical without atol/symmetric)

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.

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, &

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

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

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

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,                                    &

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

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

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()

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

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