refactor(debug): fix source to allow debug executable to run tests (#…

…1959) * refactor(debug): changes to allow debug version to run tests * allow zero-sized auxvar to be passed properly without array bounds runtime error * convert charstring routine to recursive to allow operator overloading to work with debug * fprettify * remove gfortran-12 macos pin
MODFLOW-USGS · Jul 19, 2024 · c5da9b3 · c5da9b3
1 parent 1fd801d
commit c5da9b3
Show file tree

Hide file tree

Showing 10 changed files with 42 additions and 21 deletions.
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -222,11 +222,11 @@ jobs:
           repository: MODFLOW-USGS/modflow6-examples
           path: modflow6-examples
 
-      - name: Setup ${{ env.FC }} ${{ contains(fromJSON('["macos-14"]'), matrix.os) && 12 || env.FC_V }}
+      - name: Setup ${{ env.FC }} ${{ env.FC_V }}
         uses: fortran-lang/setup-fortran@v1
         with:
           compiler: gcc
-          version: ${{ contains(fromJSON('["macos-14"]'), matrix.os) && 12 || env.FC_V }}
+          version: ${{ env.FC_V }}
 
       - name: Setup pixi
         uses: prefix-dev/setup-pixi@v0.8.1

diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
@@ -127,13 +127,13 @@ jobs:
             bash
             powershell
 
-      - name: Setup ${{ matrix.compiler }} ${{ contains(fromJSON('["macos-14"]'), matrix.os) && 12 || matrix.version }}
+      - name: Setup ${{ matrix.compiler }} ${{ matrix.version }}
         if: (!(runner.os == 'Windows' && matrix.parallel))
         id: setup-fortran
         uses: fortran-lang/setup-fortran@v1
         with:
           compiler: ${{ matrix.compiler }}
-          version: ${{ contains(fromJSON('["macos-14"]'), matrix.os) && 12 || matrix.version }}
+          version: ${{ matrix.version }}
 
       - name: Set version number
         id: set_version

diff --git a/src/Exchange/exg-gwegwe.f90 b/src/Exchange/exg-gwegwe.f90
@@ -495,6 +495,7 @@ subroutine gwe_gwe_bdsav_model(this, model)
     real(DP) :: ratin, ratout, rrate
     logical(LGP) :: is_for_model1
     integer(I4B) :: isuppress_output
+    real(DP), dimension(this%naux) :: auxrow
     !
     ! -- initialize local variables
     isuppress_output = 0
@@ -620,13 +621,16 @@ subroutine gwe_gwe_bdsav_model(this, model)
       n1u = this%v_model1%dis_get_nodeuser(n1)
       n2u = this%v_model2%dis_get_nodeuser(n2)
       if (ibinun /= 0) then
+        if (this%naux > 0) then
+          auxrow(:) = this%auxvar(:, i)
+        end if
         if (is_for_model1) then
           call model%dis%record_mf6_list_entry( &
-            ibinun, n1u, n2u, rrate, this%naux, this%auxvar(:, i), &
+            ibinun, n1u, n2u, rrate, this%naux, auxrow, &
             .false., .false.)
         else
           call model%dis%record_mf6_list_entry( &
-            ibinun, n2u, n1u, -rrate, this%naux, this%auxvar(:, i), &
+            ibinun, n2u, n1u, -rrate, this%naux, auxrow, &
             .false., .false.)
         end if
       end if

diff --git a/src/Exchange/exg-gwfgwf.f90 b/src/Exchange/exg-gwfgwf.f90
@@ -1068,6 +1068,7 @@ subroutine gwf_gwf_bdsav_model(this, model)
     integer(I4B) :: ibinun
     real(DP) :: ratin, ratout, rrate
     logical(LGP) :: is_for_model1
+    real(DP), dimension(this%naux) :: auxrow
     !
     budtxt(1) = '    FLOW-JA-FACE'
     packname = 'EXG '//this%name
@@ -1188,13 +1189,16 @@ subroutine gwf_gwf_bdsav_model(this, model)
       n1u = this%v_model1%dis_get_nodeuser(n1)
       n2u = this%v_model2%dis_get_nodeuser(n2)
       if (ibinun /= 0) then
+        if (this%naux > 0) then
+          auxrow(:) = this%auxvar(:, i)
+        end if
         if (is_for_model1) then
           call model%dis%record_mf6_list_entry(ibinun, n1u, n2u, rrate, &
-                                               this%naux, this%auxvar(:, i), &
+                                               this%naux, auxrow, &
                                                .false., .false.)
         else
           call model%dis%record_mf6_list_entry(ibinun, n2u, n1u, -rrate, &
-                                               this%naux, this%auxvar(:, i), &
+                                               this%naux, auxrow, &
                                                .false., .false.)
         end if
       end if

diff --git a/src/Exchange/exg-gwtgwt.f90 b/src/Exchange/exg-gwtgwt.f90
@@ -492,6 +492,7 @@ subroutine gwt_gwt_bdsav_model(this, model)
     real(DP) :: ratin, ratout, rrate
     logical(LGP) :: is_for_model1
     integer(I4B) :: isuppress_output
+    real(DP), dimension(this%naux) :: auxrow
     !
     ! -- initialize local variables
     isuppress_output = 0
@@ -617,13 +618,16 @@ subroutine gwt_gwt_bdsav_model(this, model)
       n1u = this%v_model1%dis_get_nodeuser(n1)
       n2u = this%v_model2%dis_get_nodeuser(n2)
       if (ibinun /= 0) then
+        if (this%naux > 0) then
+          auxrow(:) = this%auxvar(:, i)
+        end if
         if (is_for_model1) then
           call model%dis%record_mf6_list_entry( &
-            ibinun, n1u, n2u, rrate, this%naux, this%auxvar(:, i), &
+            ibinun, n1u, n2u, rrate, this%naux, auxrow, &
             .false., .false.)
         else
           call model%dis%record_mf6_list_entry( &
-            ibinun, n2u, n1u, -rrate, this%naux, this%auxvar(:, i), &
+            ibinun, n2u, n1u, -rrate, this%naux, auxrow, &
             .false., .false.)
         end if
       end if

diff --git a/src/Exchange/exg-swfgwf.f90 b/src/Exchange/exg-swfgwf.f90
@@ -1052,6 +1052,7 @@ end subroutine swf_gwf_bdsav
   !   integer(I4B) :: ibinun
   !   real(DP) :: ratin, ratout, rrate
   !   logical(LGP) :: is_for_model1
+  !   real(DP), dimension(this%naux) :: auxrow
   !   !
   !   budtxt(1) = '    FLOW-JA-FACE'
   !   packname = 'EXG '//this%name
@@ -1171,12 +1172,15 @@ end subroutine swf_gwf_bdsav
   !     n2u = this%v_model2%dis_get_nodeuser(n2)
   !     if (ibinun /= 0) then
   !       if (is_for_model1) then
-  !         call model%dis%record_mf6_list_entry(ibinun, n1u, n2u, rrate, &
-  !                                              this%naux, this%auxvar(:, i), &
+  ! if (size(auxrow) > 0) then
+  !   auxrow(:) = this%auxvar(:, i)
+  ! end if
+!         call model%dis%record_mf6_list_entry(ibinun, n1u, n2u, rrate, &
+  !                                              this%naux, auxrow, &
   !                                              .false., .false.)
   !       else
   !         call model%dis%record_mf6_list_entry(ibinun, n2u, n1u, -rrate, &
-  !                                              this%naux, this%auxvar(:, i), &
+  !                                              this%naux, auxrow, &
   !                                              .false., .false.)
   !       end if
   !     end if

diff --git a/src/Model/GroundWaterTransport/gwt-ist.f90 b/src/Model/GroundWaterTransport/gwt-ist.f90
@@ -523,12 +523,13 @@ subroutine ist_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
     integer(I4B), intent(in) :: ibudfl !< flag indication if cell-by-cell data should be saved
     integer(I4B), intent(in) :: icbcun !< unit number for cell-by-cell output
     integer(I4B), dimension(:), optional, intent(in) :: imap !< mapping vector
-    ! -- loca
+    ! -- local
     integer(I4B) :: n
     integer(I4B) :: ibinun
     integer(I4B) :: nbound
     integer(I4B) :: naux
     real(DP) :: rate
+    real(DP), dimension(0) :: auxrow
     !
     ! -- Set unit number for binary output
     if (this%ipakcb < 0) then
@@ -566,7 +567,7 @@ subroutine ist_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
       ! -- If saving cell-by-cell flows in list, write flow
       if (ibinun /= 0) then
         call this%dis%record_mf6_list_entry(ibinun, n, n, rate, &
-                                            naux, this%auxvar(:, n), &
+                                            naux, auxrow, &
                                             olconv=.TRUE., &
                                             olconv2=.TRUE.)
       end if

diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90
@@ -1962,6 +1962,7 @@ subroutine save_print_model_flows(icbcfl, ibudfl, icbcun, iprflow, &
     integer(I4B) :: ibinun
     integer(I4B) :: nboundcount
     real(DP) :: rrate
+    real(DP), dimension(naux) :: auxrow
     ! -- for observations
     character(len=LENBOUNDNAME) :: bname
     !
@@ -2051,8 +2052,11 @@ subroutine save_print_model_flows(icbcfl, ibudfl, icbcun, iprflow, &
           if (ibinun /= 0) then
             n2 = i
             if (present(imap)) n2 = imap(i)
+            if (naux > 0) then
+              auxrow(:) = auxvar(:, i)
+            end if
             call dis%record_mf6_list_entry(ibinun, node, n2, rrate, naux, &
-                                           auxvar(:, i), olconv2=.FALSE.)
+                                           auxrow, olconv2=.FALSE.)
           end if
         end if
         !

diff --git a/src/Model/TransportModel/tsp-ssm.f90 b/src/Model/TransportModel/tsp-ssm.f90
@@ -565,15 +565,16 @@ subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun)
     real(DP) :: qssm
     real(DP) :: cssm
     integer(I4B) :: naux
-    real(DP), dimension(0, 0) :: auxvar
+    real(DP), dimension(0) :: auxrow
     character(len=LENAUXNAME), dimension(0) :: auxname
     ! -- for observations
     character(len=LENBOUNDNAME) :: bname
     ! -- formats
     character(len=*), parameter :: fmttkk = &
       &"(1X,/1X,A,'   PERIOD ',I0,'   STEP ',I0)"
     !
-    ! -- set maxrows
+    ! -- initialize
+    naux = 0
     maxrows = 0
     if (ibudfl /= 0 .and. this%iprflow /= 0) then
       call this%outputtab%set_kstpkper(kstp, kper)
@@ -608,7 +609,6 @@ subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun)
     !
     ! -- If cell-by-cell flows will be saved as a list, write header.
     if (ibinun /= 0) then
-      naux = 0
       call this%dis%record_srcdst_list_header(text, this%name_model, &
                                               this%name_model, this%name_model, &
                                               this%packName, naux, auxname, &
@@ -652,7 +652,7 @@ subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun)
           if (ibinun /= 0) then
             n2 = i
             call this%dis%record_mf6_list_entry(ibinun, node, n2, rrate, &
-                                                naux, auxvar(:, i), &
+                                                naux, auxrow, &
                                                 olconv2=.FALSE.)
           end if
           !

diff --git a/src/Utilities/CharString.f90 b/src/Utilities/CharString.f90
@@ -42,7 +42,7 @@ module CharacterStringModule
 
 contains
 
-  subroutine assign_to_charstring(lhs, rhs)
+  recursive subroutine assign_to_charstring(lhs, rhs)
     class(CharacterStringType), intent(out) :: lhs
     character(len=*), intent(in) :: rhs
     logical :: allocate_charstring