refactor(fortran): turned on gfortran flags for better error checking (…

…#246) * refactor(fortran): turned on gfortran flags for better error checking * Close #182 * removed the min_satthk variable from xt3d as it is not needed
MODFLOW-USGS · Nov 6, 2019 · ba0e394 · ba0e394
1 parent 991a63d
commit ba0e394
Show file tree

Hide file tree

Showing 22 changed files with 31 additions and 130 deletions.
diff --git a/autotest/test000_setup.py b/autotest/test000_setup.py
@@ -174,9 +174,10 @@ def test_build_modflow6():
     fflags = None
     if fc == 'gfortran':
         # some flags to check for errors in the code
-        # but they are not working yet, so had to deactivate
-        fflags = 'Werror Wtabs Wline-truncation'
-        fflags = None
+        # add -Werror for compilation to terminate if errors are found
+        fflags = ('-Wtabs -Wline-truncation -Wunused-label '
+                  '-Wunused-variable')
+        #fflags = None
 
     pymake.main(srcdir, target, fc=fc, cc=cc, include_subdirs=True,
                 fflags=fflags)
@@ -225,7 +226,16 @@ def test_build_zonebudget():
                               'extrafiles.txt')
     fc, cc = pymake.set_compiler('mf6')
 
-    pymake.main(srcdir, target, fc=fc, cc=cc, extrafiles=extrafiles)
+    fflags = None
+    if fc == 'gfortran':
+        # some flags to check for errors in the code
+        # add -Werror for compilation to terminate if errors are found
+        fflags = ('-Wtabs -Wline-truncation -Wunused-label '
+                  '-Wunused-variable')
+        #fflags = None
+
+    pymake.main(srcdir, target, fc=fc, cc=cc, extrafiles=extrafiles,
+                fflags=fflags)
 
     msg = '{} does not exist.'.format(relpath_fallback(target))
     assert os.path.isfile(target), msg

diff --git a/src/Model/GroundWaterFlow/gwf3.f90 b/src/Model/GroundWaterFlow/gwf3.f90
@@ -1082,7 +1082,6 @@ subroutine gwf_fp(this)
     ! -- dummy
     class(GwfModelType) :: this
     ! -- local
-    class(BndType), pointer :: packobj
 ! ------------------------------------------------------------------------------
     !
     return

diff --git a/src/Model/GroundWaterFlow/gwf3dis8.f90 b/src/Model/GroundWaterFlow/gwf3dis8.f90
@@ -1464,7 +1464,6 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, &
     integer(I4B) :: nrow
     integer(I4B) :: ncol
     integer(I4B) :: nval
-    integer(I4B) :: nodeu, noder
     integer(I4B), dimension(:), pointer, contiguous :: itemp
 ! ------------------------------------------------------------------------------
     !

diff --git a/src/Model/GroundWaterFlow/gwf3disu8.f90 b/src/Model/GroundWaterFlow/gwf3disu8.f90
@@ -644,7 +644,6 @@ subroutine read_vertices(this)
     use ConstantsModule,   only: LINELENGTH, DZERO
     ! -- dummy
     class(GwfDisuType) :: this
-    character(len=LINELENGTH) :: line
     integer(I4B) :: i
     integer(I4B) :: ierr, ival
     logical :: isfound, endOfBlock
@@ -732,7 +731,6 @@ subroutine read_cell2d(this)
     use SparseModule, only: sparsematrix
     ! -- dummy
     class(GwfDisuType) :: this
-    character(len=LINELENGTH) :: line
     integer(I4B) :: i, j, ivert, ivert1, ncvert
     integer(I4B) :: ierr, ival
     logical :: isfound, endOfBlock
@@ -1423,7 +1421,6 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, &
     integer(I4B) :: nrow
     integer(I4B) :: ncol
     integer(I4B) :: nval
-    integer(I4B) :: nodeu, noder
     integer(I4B), dimension(:), pointer, contiguous :: itemp
 ! ------------------------------------------------------------------------------
     !
@@ -1483,7 +1480,6 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, &
     integer(I4B) :: nrow
     integer(I4B) :: ncol
     integer(I4B) :: nval
-    integer(I4B) :: nodeu, noder
     real(DP), dimension(:), pointer, contiguous :: dtemp
 ! ------------------------------------------------------------------------------
     !

diff --git a/src/Model/GroundWaterFlow/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90
@@ -460,11 +460,9 @@ subroutine read_mf6_griddata(this)
     class(GwfDisvType) :: this
     ! -- locals
     character(len=LINELENGTH) :: keyword
-    integer(I4B) :: n, node, noder, j, k
+    integer(I4B) :: n
     integer(I4B) :: ierr
     logical :: isfound, endOfBlock
-    real(DP) :: top
-    real(DP) :: dz
     integer(I4B), parameter :: nname = 3
     logical, dimension(nname) :: lname
     character(len=24),dimension(nname) :: aname
@@ -566,9 +564,7 @@ subroutine grid_finalize(this)
     ! -- dummy
     class(GwfDisvType) :: this
     ! -- locals
-    character(len=LINELENGTH) :: keyword
-    integer(I4B) :: n, node, noder, j, k
-    integer(I4B) :: ierr
+    integer(I4B) :: node, noder, j, k
     real(DP) :: top
     real(DP) :: dz
     character(len=300) :: ermsg
@@ -1890,7 +1886,6 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, &
     integer(I4B) :: nrow
     integer(I4B) :: ncol
     integer(I4B) :: nval
-    integer(I4B) :: nodeu, noder
     integer(I4B), dimension(:), pointer, contiguous :: itemp
 ! ------------------------------------------------------------------------------
     !
@@ -1961,7 +1956,6 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, &
     integer(I4B) :: nrow
     integer(I4B) :: ncol
     integer(I4B) :: nval
-    integer(I4B) :: nodeu, noder
     real(DP), dimension(:), pointer, contiguous :: dtemp
 ! ------------------------------------------------------------------------------
     !

diff --git a/src/Model/GroundWaterFlow/gwf3lak8.f90 b/src/Model/GroundWaterFlow/gwf3lak8.f90
@@ -3809,7 +3809,6 @@ subroutine lak_cc(this, iend, icnvg, hclose, rclose)
 !
 !    SPECIFICATIONS:
 ! --------------------------------------------------------------------------
-    use TdisModule, only: delt
     ! -- dummy
     class(LakType), intent(inout) :: this
     integer(I4B), intent(in) :: iend
@@ -5259,9 +5258,6 @@ subroutine lak_rp_obs(this)
     ! -- formats
 10  format('Error: Boundary "',a,'" for observation "',a, &
            '" is invalid in package "',a,'"')
-30  format('Error: Boundary name not provided for observation "',a, &
-           '" in package "',a,'"')
-60  format('Error: Invalid node number in OBS input: ',i0)
     !
     do i = 1, this%obs%npakobs
       obsrv => this%obs%pakobs(i)%obsrv

diff --git a/src/Model/GroundWaterFlow/gwf3maw8.f90 b/src/Model/GroundWaterFlow/gwf3maw8.f90
@@ -1938,7 +1938,7 @@ subroutine maw_fc(this, rhs, ia, idxglo, amatsln)
 !    SPECIFICATIONS:
 ! ------------------------------------------------------------------------------
     ! -- modules
-    use TdisModule,only: delt, kper, kstp
+    use TdisModule,only: delt
     ! -- dummy
     class(MawType) :: this
     real(DP), dimension(:), intent(inout) :: rhs
@@ -2299,7 +2299,7 @@ subroutine maw_bd(this, x, idvfl, icbcfl, ibudfl, icbcun, iprobs,            &
     real(DP) :: ratsum
     integer(I4B) :: naux
     ! -- for budget
-    integer(I4B) :: i, j, n
+    integer(I4B) :: j, n
     integer(I4B) :: n2
     integer(I4B) :: igwfnode
     integer(I4B) :: ibnd
@@ -3461,9 +3461,6 @@ subroutine maw_rp_obs(this)
     ! -- formats
 10  format('Error: Boundary "',a,'" for observation "',a, &
            '" is invalid in package "',a,'"')
-30  format('Error: Boundary name not provided for observation "',a, &
-           '" in package "',a,'"')
-60  format('Error: Invalid node number in OBS input: ',i5)
     !
     !
     do i = 1, this%obs%npakobs

diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90
@@ -363,7 +363,7 @@ subroutine npf_ar(this, ic, ibound, hnew)
     if (this%ixt3d /= 0) then
       call this%xt3d%xt3d_ar(ibound, this%k11, this%ik33, this%k33,              &
                              this%sat, this%ik22, this%k22, this%inewton,        &
-                             this%satmin, this%icelltype, this%iangle1,          &
+                             this%icelltype, this%iangle1,                       &
                              this%iangle2, this%iangle3, this%angle1,            &
                              this%angle2, this%angle3)
     end if
@@ -1576,9 +1576,9 @@ subroutine read_data(this)
     ! -- dummy
     class(GwfNpftype) :: this
     ! -- local
-    character(len=LINELENGTH) :: line, errmsg, cellstr, keyword
-    integer(I4B) :: n, istart, istop, lloc, ierr, nerr
-    logical :: isfound, endOfBlock
+    character(len=LINELENGTH) :: errmsg
+    integer(I4B) :: n, ierr
+    logical :: isfound
     logical, dimension(8)           :: lname
     character(len=24), dimension(:), pointer :: aname
     !character(len=24), dimension(8) :: aname

diff --git a/src/Model/GroundWaterFlow/gwf3obs8.f90 b/src/Model/GroundWaterFlow/gwf3obs8.f90
@@ -205,7 +205,6 @@ subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout)
     integer(I4B) :: icol, istart, istop
     character(len=LINELENGTH) :: ermsg, strng
     ! formats
- 30 format(i10)
     !
     ! -- Initialize variables
     strng = obsrv%IDstring
@@ -240,7 +239,6 @@ subroutine gwf_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
     integer(I4B) :: icol, istart, istop, jaidx
     character(len=LINELENGTH) :: ermsg, strng
     ! formats
- 30 format(i10)
  70 format('Error: No connection exists between cells identified in text: ',a)
     !
     ! -- Initialize variables

diff --git a/src/Model/GroundWaterFlow/gwf3sfr8.f90 b/src/Model/GroundWaterFlow/gwf3sfr8.f90
@@ -1253,7 +1253,7 @@ subroutine sfr_ad(this)
     class(SfrType) :: this
     ! -- local
     integer(I4B) :: n
-    integer(I4B) :: j, iaux
+    integer(I4B) :: iaux
 ! ------------------------------------------------------------------------------
     !
     ! -- Advance the time series manager
@@ -2627,7 +2627,6 @@ subroutine sfr_rp_obs(this)
            '" is invalid in package "',a,'"')
 30  format('Error: Boundary name not provided for observation "',a, &
            '" in package "',a,'"')
-60  format('Error: Invalid node number in OBS input: ',i5)
     do i = 1, this%obs%npakobs
       obsrv => this%obs%pakobs(i)%obsrv
       !
@@ -2734,7 +2733,6 @@ subroutine sfr_process_obsID(obsrv, dis, inunitobs, iout)
     character(len=LINELENGTH) :: strng
     character(len=LENBOUNDNAME) :: bndname
     ! formats
- 30 format(i10)
     !
     strng = obsrv%IDstring
     ! -- Extract reach number from strng and store it.

diff --git a/src/Model/GroundWaterFlow/gwf3uzf8.f90 b/src/Model/GroundWaterFlow/gwf3uzf8.f90
@@ -426,7 +426,6 @@ subroutine uzf_options(this, option, found)
     logical,          intent(inout) :: found
     ! -- local
     character(len=MAXCHARLEN) :: fname, keyword
-    real(DP) :: r
     ! -- formats
     character(len=*),parameter :: fmtnotfound= &
       "(4x, 'NO UZF OPTIONS WERE FOUND.')"
@@ -3120,7 +3119,6 @@ subroutine uzf_rp_obs(this)
     ! --------------------------------------------------------------------------
     ! -- formats
 60  format('Error: Invalid node number in OBS input: ',i5)
-70  format('Error: Invalid depth in OBS input: ',g15.7)
     !
     do i = 1, this%obs%npakobs
       obsrv => this%obs%pakobs(i)%obsrv

diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90
@@ -274,10 +274,9 @@ subroutine bnd_rp(this)
     ! -- dummy
     class(BndType),intent(inout) :: this
     ! -- local
-    integer(I4B) :: i, ierr, nlinks, nlist, node
-    logical :: isfound, endOfBlock
+    integer(I4B) :: ierr, nlist
+    logical :: isfound
     character(len=LINELENGTH) :: line, errmsg
-    type(TimeSeriesLinkType), pointer :: tsLink => null()
     ! -- formats
     character(len=*),parameter :: fmtblkerr = &
       "('Error.  Looking for BEGIN PERIOD iper.  Found ', a, ' instead.')"

diff --git a/src/Model/ModelUtilities/DiscretizationBase.f90 b/src/Model/ModelUtilities/DiscretizationBase.f90
@@ -902,7 +902,6 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in,         &
     real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray
     character(len=*), intent(in)                               :: aname
     ! -- local
-    integer(I4B) :: ival
     character(len=LINELENGTH) :: ermsg
 ! ------------------------------------------------------------------------------
     !
@@ -984,7 +983,6 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound,             &
     use ListReaderModule, only: ListReaderType
     use SimModule, only: store_error, store_error_unit, count_errors, ustop
     use InputOutputModule, only: urword
-    use TdisModule, only: totimsav, perlen
     use TimeSeriesLinkModule, only:  TimeSeriesLinkType
     use TimeSeriesManagerModule, only: read_value_or_time_series
     ! -- dummy
@@ -1140,8 +1138,6 @@ subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd,         &
     integer(I4B), intent(in) :: inunit
     integer(I4B), intent(in) :: iout
     ! -- local
-    integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nval, nodeu
-    logical :: found
     character(len=LINELENGTH) :: ermsg
 ! ------------------------------------------------------------------------------
     !

diff --git a/src/Model/ModelUtilities/Xt3dAlgorithm.f90 b/src/Model/ModelUtilities/Xt3dAlgorithm.f90
@@ -527,7 +527,6 @@ subroutine abwts(nnbrmx,nnbr,inbr,il01,nde1,vccde,                           &
          bd = bd*fatten
       end if
 !
-  999 return
   end subroutine abwts
 !
 end module Xt3dAlgorithmModule
diff --git a/src/Model/ModelUtilities/Xt3dInterface.f90 b/src/Model/ModelUtilities/Xt3dInterface.f90
@@ -41,7 +41,6 @@ module Xt3dModule
     integer(I4B), pointer                           :: ik33        => null()     !flag indicates K33 was read
     real(DP), dimension(:), pointer, contiguous     :: sat         => null()     !saturation (0. to 1.) for each cell
     integer(I4B), pointer                           :: inewton     => null()     !Newton flag
-    real(DP), pointer                               :: min_satthk  => null()     !min saturated thickness
     integer(I4B), dimension(:), pointer, contiguous :: icelltype   => null()     !cell type (confined or unconfined)
     integer(I4B), pointer                           :: iangle1     => null()     !flag to indicate angle1 was read
     integer(I4B), pointer                           :: iangle2     => null()     !flag to indicate angle2 was read
@@ -265,8 +264,7 @@ subroutine xt3d_mc(this, moffset, iasln, jasln, inewton)
   end subroutine xt3d_mc
 
   subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22,             &
-    inewton, min_satthk, icelltype, iangle1, iangle2, iangle3, angle1, angle2, &
-    angle3)
+    inewton, icelltype, iangle1, iangle2, iangle3, angle1, angle2, angle3)
 ! ******************************************************************************
 ! xt3d_ar -- Allocate and Read
 ! ******************************************************************************
@@ -285,7 +283,6 @@ subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22,             &
     integer(I4B), intent(in), pointer :: ik22
     real(DP), dimension(:), intent(in), pointer, contiguous :: k22
     integer(I4B), intent(in), pointer :: inewton
-    real(DP), intent(in), pointer :: min_satthk
     integer(I4B), dimension(:), intent(in), pointer, contiguous :: icelltype
     integer(I4B), intent(in), pointer :: iangle1
     integer(I4B), intent(in), pointer :: iangle2
@@ -313,7 +310,6 @@ subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22,             &
     this%ik22 => ik22
     this%k22 => k22
     this%inewton => inewton
-    this%min_satthk => min_satthk
     this%icelltype => icelltype
     this%iangle1 => iangle1
     this%iangle2 => iangle2

diff --git a/src/Model/NumericalModel.f90 b/src/Model/NumericalModel.f90
@@ -361,9 +361,6 @@ subroutine get_mnodeu(this, node, nodeu)
     integer(I4B), intent(in) :: node
     integer(I4B), intent(inout) :: nodeu
     ! -- local
-    integer(I4B) :: ip, ipaknode, istart, istop
-    class(BndType), pointer :: packobj
-
     if(node <= this%dis%nodes) then
       nodeu = this%dis%get_nodeuser(node)
     else

diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90
@@ -461,7 +461,6 @@ subroutine sln_ar(this)
     logical :: isfound, endOfBlock
     integer(I4B) :: ival
     real(DP) :: rval
-    real(DP) :: rclose
     character(len=*),parameter :: fmtcsvout = &
       "(4x, 'CSV OUTPUT WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)"
     character(len=*),parameter :: fmtptcout = &
@@ -630,8 +629,6 @@ subroutine sln_ar(this)
       write(iout,'(1x,a)')'NO IMS OPTION BLOCK DETECTED.'
     end if
 
-00020 FORMAT(1X,'SPECIFIED OPTION:',/,                                         &
-    &       1X,'SOLVER INPUT VALUES WILL BE USER-SPECIFIED')
 00021 FORMAT(1X,'SIMPLE OPTION:',/,                                            &
     &       1X,'DEFAULT SOLVER INPUT VALUES FOR FAST SOLUTIONS')
 00023 FORMAT(1X,'MODERATE OPTION:',/,1X,'DEFAULT SOLVER',                      &
@@ -2050,7 +2047,6 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, itersum, iptc, ptcf)
           WRITE(99,'(*(G0,:,","))') N, this%RHS(N), (this%ja(i),i=i1,i2), &
                         (this%AMAT(I),I=I1,I2)
         ENDDO
-66      FORMAT(I9,1X,G15.6,2X,100G15.6)
         close(99)
         !stop
       endif
@@ -2158,7 +2154,6 @@ subroutine sln_backtracking(this, mp, cp, kiter)
     class(NumericalExchangeType), pointer :: cp
     integer(I4B), intent(in) :: kiter
     ! -- local
-    character (len=16) :: cval
     integer(I4B) :: ic
     integer(I4B) :: im
     integer(I4B) :: nb

diff --git a/src/Solution/SparseMatrixSolver/ims8linear.f90 b/src/Solution/SparseMatrixSolver/ims8linear.f90
@@ -529,7 +529,7 @@ subroutine imslinear_summary(this, mxiter)
       CHARACTER (LEN= 16), DIMENSION(0:4) :: ccnvgopt
       CHARACTER (LEN= 15) :: clevel
       CHARACTER (LEN= 15) :: cdroptol 
-      integer(I4B) :: i, j, n
+      integer(I4B) :: i, j
 !     + + + PARAMETERS + + +
 !       DATA
       DATA clin  /'UNKNOWN   ', &
@@ -1002,7 +1002,6 @@ SUBROUTINE IMSLINEARSUB_CALC_ORDER(IOUT, IPRIMS, IORD, NEQ, NJA, IA, JA,  &
         integer(I4B) :: nsp 
         integer(I4B), DIMENSION(:), ALLOCATABLE :: iwork0, iwork1 
         integer(I4B) :: iflag 
-        integer(I4B) :: i,j 
 !       + + + PARAMETERS + + +                                            
 !       + + + FUNCTIONS + + +                                             
 !       + + + FORMATS + + +