refactor(InputOutputModule): refactor dclosetest (#49)

Refactor dclosetest and replace with IS_SAME in GenericUtilities.
Convert IS_SAME to logical function and allow passing of evaluation
value (eps). If eps is not passed then DSAME is used. Modified calls
to dclosetest to IS_SAME but did not pass an eps value (unlike what
was done previously). All tests pass so current tests are not sensitive
to a passed eps value. Need to monitor this for timeseries functionality
which used dclosetest.

README.md

@@ -7,8 +7,8 @@
 
 ## Automated Testing Status on Travis-CI
 
-### Version 6.0.3 fix-47 — build 28
-[![Build Status](https://travis-ci.org/MODFLOW-USGS/modflow6.svg?branch=fix-47)](https://travis-ci.org/MODFLOW-USGS/modflow6)
+### Version 6.0.3 refactor-dclosetest — build 28
+[![Build Status](https://travis-ci.org/MODFLOW-USGS/modflow6.svg?branch=refactor-dclosetest)](https://travis-ci.org/MODFLOW-USGS/modflow6)
 
 ## Introduction
 
@@ -31,7 +31,7 @@ MODFLOW 6 is the latest core version of MODFLOW. It synthesizes many of the capa
 
 #### ***Software/Code citation for MODFLOW 6:***
 
-[Langevin, C.D., Hughes, J.D., Banta, E.R., Provost, A.M., Niswonger, R.G., and Panday, Sorab, 2018, MODFLOW 6 Modular Hydrologic Model version 6.0.3 — fix-47: U.S. Geological Survey Software Release, 12 October 2018, https://doi.org/10.5066/F76Q1VQV](https://doi.org/10.5066/F76Q1VQV)
+[Langevin, C.D., Hughes, J.D., Banta, E.R., Provost, A.M., Niswonger, R.G., and Panday, Sorab, 2018, MODFLOW 6 Modular Hydrologic Model version 6.0.3 — refactor-dclosetest: U.S. Geological Survey Software Release, 12 October 2018, https://doi.org/10.5066/F76Q1VQV](https://doi.org/10.5066/F76Q1VQV)
 
 
 ## Instructions for building definition files for new packages

code.json

@@ -1,23 +1,23 @@
 [
     {
         "status": "Release Candidate", 
-        "languages": [
-            "Fortran2008"
-        ], 
+        "downloadURL": "https://code.usgs.gov/usgs/modflow/modflow6/archive/master.zip", 
         "repositoryURL": "https://code.usgs.gov/usgs/modflow/modflow6.git", 
-        "laborHours": -1, 
+        "disclaimerURL": "https://code.usgs.gov/usgs/modflow/modflow6/blob/master/DISCLAIMER.md", 
         "description": "MODFLOW is the USGS's modular hydrologic model. MODFLOW is considered an international standard for simulating and predicting groundwater conditions and groundwater/surface-water interactions.", 
         "tags": [
             "MODFLOW", 
             "groundwater model"
         ], 
-        "name": "modflow6", 
-        "downloadURL": "https://code.usgs.gov/usgs/modflow/modflow6/archive/master.zip", 
+        "vcs": "git", 
+        "languages": [
+            "Fortran2008"
+        ], 
         "contact": {
             "name": "Christian D. Langevin", 
             "email": "langevin@usgs.gov"
         }, 
-        "vcs": "git", 
+        "laborHours": -1, 
         "version": "6.0.3.28", 
         "date": {
             "metadataLastUpdated": "2018-10-12"
@@ -33,6 +33,6 @@
             "usageType": "openSource"
         }, 
         "homepageURL": "https://code.usgs.gov/usgs/modflow/modflow6/", 
-        "disclaimerURL": "https://code.usgs.gov/usgs/modflow/modflow6/blob/master/DISCLAIMER.md"
+        "name": "modflow6"
     }
 ]

src/Solution/NumericalSolution.f90

@@ -1853,9 +1853,9 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, itersum, iptc, ptcf)
     integer(I4B), intent(inout) :: iptc
     real(DP), intent(in) :: ptcf
     ! -- local
+    logical :: lsame
     integer(I4B) :: n
     integer(I4B) :: itestmat, i, i1, i2
-    integer(I4B) :: isame
     integer(I4B) :: iptct
     real(DP) :: adiag, diagval
     real(DP) :: l2norm
@@ -1905,8 +1905,8 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, itersum, iptc, ptcf)
           end if
         end if
       else
-        isame = IS_SAME(l2norm, this%l2norm0) 
-        if (isame /= 0) then
+        lsame = IS_SAME(l2norm, this%l2norm0) 
+        if (lsame) then
           iptc = 0
         end if
       end if

src/Solution/SparseMatrixSolver/ims8linear.f90

@@ -1522,10 +1522,10 @@ SUBROUTINE IMSLINEARSUB_CG(ICNVG, ITMAX, INNERIT,                         &
         real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDRMAX
 !       + + + LOCAL DEFINITIONS + + + 
         LOGICAL :: LORTH
+        logical :: lsame 
         character(len=31) :: cval
         integer(I4B) :: n 
         integer(I4B) :: iiter 
-        integer(I4B) :: isame 
         integer(I4B) :: xloc, rloc
         integer(I4B) :: im, im0, im1
         real(DP) :: tv 
@@ -1647,9 +1647,8 @@ SUBROUTINE IMSLINEARSUB_CG(ICNVG, ITMAX, INNERIT,                         &
           IF (rcnvg ==  DZERO) ICNVG = 1 
           IF (ICNVG.NE.0) EXIT INNER 
 !-----------CHECK THAT CURRENT AND PREVIOUS rho ARE DIFFERENT           
-          !isame = IMSLINEARSUB_SAME(rho, rho0) 
-          isame = IS_SAME(rho, rho0) 
-          IF (isame.NE.0) THEN 
+          lsame = IS_SAME(rho, rho0) 
+          IF (lsame) THEN 
             EXIT INNER 
           END IF 
 !-----------RECALCULATE THE RESIDUAL
@@ -1735,10 +1734,10 @@ SUBROUTINE IMSLINEARSUB_BCGS(ICNVG, ITMAX, INNERIT,                       &
         real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDRMAX
 !       + + + LOCAL DEFINITIONS + + +  
         LOGICAL :: LORTH
+        logical :: lsame 
         character(len=15) :: cval1, cval2
         integer(I4B) :: n 
         integer(I4B) :: iiter 
-        integer(I4B) :: isame 
         integer(I4B) :: xloc, rloc
         integer(I4B) :: im, im0, im1
         real(DP) :: tv 
@@ -1923,19 +1922,16 @@ SUBROUTINE IMSLINEARSUB_BCGS(ICNVG, ITMAX, INNERIT,                       &
           IF (ICNVG.NE.0) EXIT INNER
 !-----------CHECK THAT CURRENT AND PREVIOUS rho, alpha, AND omega ARE 
 !           DIFFERENT
-          !isame = IMSLINEARSUB_SAME(rho, rho0) 
-          isame = IS_SAME(rho, rho0) 
-          IF (isame.NE.0) THEN 
+          lsame = IS_SAME(rho, rho0) 
+          IF (lsame) THEN 
             EXIT INNER 
           END IF 
-          !isame = IMSLINEARSUB_SAME(alpha, alpha0) 
-          isame = IS_SAME(alpha, alpha0) 
-          IF (isame.NE.0) THEN 
+          lsame = IS_SAME(alpha, alpha0) 
+          IF (lsame) THEN 
             EXIT INNER 
           END IF 
-          !isame = IMSLINEARSUB_SAME(omega, omega0) 
-          isame = IS_SAME(omega, omega0) 
-          IF (isame.NE.0) THEN 
+          lsame = IS_SAME(omega, omega0) 
+          IF (lsame) THEN 
             EXIT INNER 
           END IF 
 !-----------RECALCULATE THE RESIDUAL

src/Utilities/InputOutput.f90

@@ -7,8 +7,9 @@ module InputOutputModule
                        store_error_filename
   use ConstantsModule, only: LINELENGTH, LENBIGLINE, LENBOUNDNAME,             &
                              NAMEDBOUNDFLAG, LINELENGTH, MAXCHARLEN
+  use GenericUtilities, only: IS_SAME
   private
-  public :: dclosetest, GetUnit, u8rdcom, uget_block,                          &
+  public :: GetUnit, u8rdcom, uget_block,                                      &
             uterminate_block, UPCASE, URWORD, ULSTLB, UBDSV4,                  &
             ubdsv06, UBDSVB, UCOLNO, ULAPRW,                                   &
             ULASAV, ubdsv1, ubdsvc, ubdsvd, UWWORD,                            &
@@ -22,41 +23,6 @@ module InputOutputModule
 
   contains
 
-  logical function dclosetest(a,b,eps)
-! ******************************************************************************
-! Check and see if two doubles are close enough to be considered equal
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
-    implicit none
-    ! -- dummy
-    real(DP), intent(in) :: a
-    real(DP), intent(in) :: b
-    real(DP), intent(in), optional :: eps
-    ! -- local
-    real(DP) :: epslocal, absval
-! ------------------------------------------------------------------------------
-    !
-    if (present(eps)) then
-      epslocal = eps
-    else
-      epslocal = 1.2d-7
-    endif
-    dclosetest=.true.
-    if(a.gt.b) then
-      absval = abs(a)
-      if((a-b) .le. absval*epslocal) return
-    else
-      absval = abs(b)
-      if((b-a) .le. absval*epslocal) return
-    end if
-    dclosetest=.false.
-    !
-    ! -- Return
-    return
-  end function dclosetest
-
   subroutine openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt,          &
                       filstat_opt)
 ! ******************************************************************************
@@ -1652,7 +1618,7 @@ function linear_interpolate(t0, t1, y0, y1, t) result(y)
     character(len=100) :: msg
     !
     ! -- don't get bitten by rounding errors or divide-by-zero
-    if (dclosetest(t0, t1) .or. dclosetest(t, t1)) then
+    if (IS_SAME(t0, t1) .or. IS_SAME(t, t1)) then
       y = y1
     elseif (t == t0) then
       y = y0

src/Utilities/Observation/Observe.f90

@@ -15,7 +15,7 @@ module ObserveModule
   use BaseDisModule,     only: DisBaseType
   use ConstantsModule,   only: LENBOUNDNAME, LENOBSNAME, LENOBSTYPE, &
                                MAXOBSTYPES, DNODATA, DZERO
-  use InputOutputModule, only: dclosetest, urword
+  use InputOutputModule, only: urword
   use ListModule,        only: ListType
   use SimModule,         only: store_warning, store_error, &
                                store_error_unit, ustop

src/Utilities/TimeSeries/TimeArraySeries.f90

@@ -4,7 +4,8 @@ module TimeArraySeriesModule
   use BlockParserModule,  only: BlockParserType
   use ConstantsModule,    only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR,        &
                                 LENTIMESERIESNAME, LENBIGLINE, DZERO, DONE
-  use InputOutputModule,  only: dclosetest, GetUnit, openfile
+  use GenericUtilities,   only: IS_SAME
+  use InputOutputModule,  only: GetUnit, openfile
   use KindModule,         only: DP, I4B
   use ListModule,         only: ListType, ListNodeType
   use SimModule,          only: count_errors, store_error, store_error_unit, &
@@ -19,9 +20,6 @@ module TimeArraySeriesModule
   private
   public  :: TimeArraySeriesType, ConstructTimeArraySeries, &
              CastAsTimeArraySeriesType, GetTimeArraySeriesFromList
-  private :: epsil
-
-  real(DP), parameter :: epsil = 1.0d-10
 
   type TimeArraySeriesType
     ! -- Public members
@@ -501,7 +499,7 @@ subroutine get_values_at_time(this, nvals, values, time)
           ierr = 1
         endif
       else
-        if (dclosetest(taEarlier%taTime, time, epsil)) then
+        if (IS_SAME(taEarlier%taTime, time)) then
           values = taEarlier%taArray
         else
           ! -- Only earlier time is available, and it is not time of interest;
@@ -515,7 +513,7 @@ subroutine get_values_at_time(this, nvals, values, time)
       endif
     else
       if (associated(taLater)) then
-        if (dclosetest(taLater%taTime, time, epsil)) then
+        if (IS_SAME(taLater%taTime, time)) then
           values = taLater%taArray
         else
           ! -- only later time is available, and it is not time of interest
@@ -760,7 +758,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. dclosetest(ta%taTime, time, epsil)) then
+          if (ta%taTime < time  .or. IS_SAME(ta%taTime, time)) then
             currNode => currNode%nextNode
           else
             exit