From f4f1363b0b56fd77f569ba3debfa8ef35fe3c4a8 Mon Sep 17 00:00:00 2001 From: langevin-usgs Date: Tue, 8 Nov 2022 11:56:45 -0600 Subject: [PATCH] refactor(io): miscellaneous io cleanup (#1073) --- autotest/test_gwf_returncodes.py | 4 +- doc/ReleaseNotes/ReleaseNotes.tex | 9 +- src/Model/GroundWaterFlow/gwf3dis8.f90 | 28 +++---- src/Model/GroundWaterFlow/gwf3disu8.f90 | 22 ++--- src/Model/GroundWaterFlow/gwf3disv8.f90 | 28 +++---- src/Model/GroundWaterFlow/gwf3npf8.f90 | 84 +++++++++---------- src/Model/GroundWaterTransport/gwt1dsp.f90 | 6 +- .../ArrayRead/LayeredArrayReader.f90 | 18 ++-- src/Utilities/Idm/LoadMf6FileType.f90 | 3 +- src/Utilities/kind.f90 | 8 +- 10 files changed, 108 insertions(+), 102 deletions(-) diff --git a/autotest/test_gwf_returncodes.py b/autotest/test_gwf_returncodes.py index daea5cec788..9201054d3df 100644 --- a/autotest/test_gwf_returncodes.py +++ b/autotest/test_gwf_returncodes.py @@ -19,7 +19,7 @@ name = "gwf_ret_codes01" base_ws = os.path.join("temp", name) if not os.path.isdir(base_ws): - os.makedirs(base_ws) + os.makedirs(base_ws, exist_ok=True) app = "mf6" if sys.platform.lower() == "win32": app += ".exe" @@ -219,7 +219,7 @@ def idomain_runtime_error(): returncode, buff = run_mf6([mf6_exe], ws) msg = f"could not run {sim.name}" if returncode != 0: - err_str = "IDOMAIN ARRAY HAS SOME VALUES GREATER THAN ZERO" + err_str = "Ensure IDOMAIN array has some" err = any(err_str in s for s in buff) if err: clean(ws) diff --git a/doc/ReleaseNotes/ReleaseNotes.tex b/doc/ReleaseNotes/ReleaseNotes.tex index 7394311db4a..e9b0cc1ca60 100644 --- a/doc/ReleaseNotes/ReleaseNotes.tex +++ b/doc/ReleaseNotes/ReleaseNotes.tex @@ -197,12 +197,12 @@ \section{Changes Introduced in this Release} % \item xxx \end{itemize} - %\underline{EXAMPLES} - %\begin{itemize} - % \item xxx + \underline{EXAMPLES} + \begin{itemize} + \item A new example called ex-gwt-stallman was added. This new problem uses the GWT Model as a surrogate for simulating heat flow. The example represents heat conduction in subsurface with a periodic temperature boundary condition at the surface. % \item xxx % \item xxx - %\end{itemize} + \end{itemize} \textbf{\underline{BUG FIXES AND OTHER CHANGES TO EXISTING FUNCTIONALITY}} \\ \underline{BASIC FUNCTIONALITY} @@ -213,6 +213,7 @@ \section{Changes Introduced in this Release} \item When a GWF Model and a corresponding GWT model are solved in the same simulation, the GWF Model must be solved before the corresponding GWT model. The GWF Model must also be solved by a different IMS than the GWT Model. There was not a check for this in previous versions and if these conditions were not met, the solution would often not converge or it would give erroneous results. \item The DISV Package would not raise an error if a model cell was defined as a line. The program was modified to check for the case where the calculated cell area is equal to zero. If the calculated cell area is equal to zero, the program terminates with an error. \item When searching for a required block in an input file, the program would not terminate with a sensible error message if the end of file was found instead of the required block. Program now indicates that the required block was not found. + \item This release contains a first step toward implementation of generic input routines to read input files. The new input routines were implemented for the DIS, DISV, and DISU Packages of the GWF and GWT Models, for the NPF Package of the GWF Model, and the DSP Package of the GWT Model. Output summaries written to the GWF and GWT Model listing files are different from summaries written using previous versions. For packages that use the new input data model, the IPRN capability of the READARRAY utility (described in mf6io.pdf) is no longer supported as a way to write input arrays to the model listing file. \end{itemize} \underline{INTERNAL FLOW PACKAGES} diff --git a/src/Model/GroundWaterFlow/gwf3dis8.f90 b/src/Model/GroundWaterFlow/gwf3dis8.f90 index e7e954471f5..d81cdffafe7 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8.f90 @@ -239,13 +239,13 @@ subroutine log_options(this, found) write (this%iout, '(1x,a)') 'Setting Discretization Options' if (found%length_units) then - write (this%iout, '(4x,a,i0)') 'MODEL LENGTH UNIT [0=UND, 1=FEET, & - &2=METERS, 3=CENTIMETERS] SET AS ', this%lenuni + write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, & + &2=METERS, 3=CENTIMETERS] set as ', this%lenuni end if if (found%nogrb) then - write (this%iout, '(4x,a,i0)') 'BINARY GRB FILE [0=GRB, 1=NOGRB] & - &SET AS ', this%nogrb + write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] & + &set as ', this%nogrb end if if (found%xorigin) then @@ -295,17 +295,17 @@ subroutine source_dimensions(this) ! -- verify dimensions were set if (this%nlay < 1) then call store_error( & - 'ERROR. NLAY WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.') + 'NLAY was not specified or was specified incorrectly.') call this%parser%StoreErrorUnit() end if if (this%nrow < 1) then call store_error( & - 'ERROR. NROW WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.') + 'NROW was not specified or was specified incorrectly.') call this%parser%StoreErrorUnit() end if if (this%ncol < 1) then call store_error( & - 'ERROR. NCOL WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.') + 'NCOL was not specified or was specified incorrectly.') call this%parser%StoreErrorUnit() end if ! @@ -454,12 +454,12 @@ subroutine grid_finalize(this) real(DP) :: dz ! -- formats character(len=*), parameter :: fmtdz = & - "('ERROR. CELL (',i0,',',i0,',',i0,') THICKNESS <= 0. ', & + "('CELL (',i0,',',i0,',',i0,') THICKNESS <= 0. ', & &'TOP, BOT: ',2(1pg24.15))" character(len=*), parameter :: fmtnr = & - "(/1x, 'THE SPECIFIED IDOMAIN RESULTS IN A REDUCED NUMBER OF CELLS.',& - &/1x, 'NUMBER OF USER NODES: ',I0,& - &/1X, 'NUMBER OF NODES IN SOLUTION: ', I0, //)" + "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',& + &/1x, 'Number of user nodes: ',I0,& + &/1X, 'Number of nodes in solution: ', I0, //)" ! ------------------------------------------------------------------------------ ! ! -- count active cells @@ -474,9 +474,9 @@ subroutine grid_finalize(this) ! ! -- Check to make sure nodes is a valid number if (this%nodes == 0) then - call store_error('ERROR. MODEL DOES NOT HAVE ANY ACTIVE NODES.') - call store_error('MAKE SURE IDOMAIN ARRAY HAS SOME VALUES GREATER & - &THAN ZERO.') + call store_error('Model does not have any active nodes. & + &Ensure IDOMAIN array has some values greater & + &than zero.') call this%parser%StoreErrorUnit() end if ! diff --git a/src/Model/GroundWaterFlow/gwf3disu8.f90 b/src/Model/GroundWaterFlow/gwf3disu8.f90 index 62dc3ecd788..02d1ff99b36 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8.f90 @@ -209,12 +209,12 @@ subroutine grid_finalize(this) integer(I4B) :: nrsize ! -- formats character(len=*), parameter :: fmtdz = & - "('ERROR. CELL (',i0,',',i0,',',i0,') THICKNESS <= 0. ', & + "('CELL (',i0,',',i0,',',i0,') THICKNESS <= 0. ', & &'TOP, BOT: ',2(1pg24.15))" character(len=*), parameter :: fmtnr = & - "(/1x, 'THE SPECIFIED IDOMAIN RESULTS IN A REDUCED NUMBER OF CELLS.',& - &/1x, 'NUMBER OF USER NODES: ',I0,& - &/1X, 'NUMBER OF NODES IN SOLUTION: ', I0, //)" + "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',& + &/1x, 'Number of user nodes: ',I0,& + &/1X, 'Number of nodes in solution: ', I0, //)" ! ------------------------------------------------------------------------------ ! ! -- count active cells @@ -225,9 +225,9 @@ subroutine grid_finalize(this) ! ! -- Check to make sure nodes is a valid number if (this%nodes == 0) then - call store_error('ERROR. MODEL DOES NOT HAVE ANY ACTIVE NODES.') - call store_error('MAKE SURE IDOMAIN ARRAY HAS SOME VALUES GREATER & - &THAN ZERO.') + call store_error('Model does not have any active nodes. & + &Ensure IDOMAIN array has some values greater & + &than zero.') call this%parser%StoreErrorUnit() end if ! @@ -561,13 +561,13 @@ subroutine log_options(this, found) write (this%iout, '(1x,a)') 'Setting Discretization Options' if (found%length_units) then - write (this%iout, '(4x,a,i0)') 'MODEL LENGTH UNIT [0=UND, 1=FEET, & - &2=METERS, 3=CENTIMETERS] SET AS ', this%lenuni + write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, & + &2=METERS, 3=CENTIMETERS] set as ', this%lenuni end if if (found%nogrb) then - write (this%iout, '(4x,a,i0)') 'BINARY GRB FILE [0=GRB, 1=NOGRB] & - &SET AS ', this%nogrb + write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] & + &set as ', this%nogrb end if if (found%xorigin) then diff --git a/src/Model/GroundWaterFlow/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90 index 421904e501b..4b5bfc9c7da 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8.f90 @@ -261,13 +261,13 @@ subroutine log_options(this, found) write (this%iout, '(1x,a)') 'Setting Discretization Options' if (found%length_units) then - write (this%iout, '(4x,a,i0)') 'MODEL LENGTH UNIT [0=UND, 1=FEET, & - &2=METERS, 3=CENTIMETERS] SET AS ', this%lenuni + write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, & + &2=METERS, 3=CENTIMETERS] set as ', this%lenuni end if if (found%nogrb) then - write (this%iout, '(4x,a,i0)') 'BINARY GRB FILE [0=GRB, 1=NOGRB] & - &SET AS ', this%nogrb + write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] & + &set as ', this%nogrb end if if (found%xorigin) then @@ -323,17 +323,17 @@ subroutine source_dimensions(this) ! -- verify dimensions were set if (this%nlay < 1) then call store_error( & - 'NLAY WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.') + 'NLAY was not specified or was specified incorrectly.') call this%parser%StoreErrorUnit() end if if (this%ncpl < 1) then call store_error( & - 'NCPL WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.') + 'NCPL was not specified or was specified incorrectly.') call this%parser%StoreErrorUnit() end if if (this%nvert < 1) then call store_error( & - 'NVERT WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.') + 'NVERT was not specified or was specified incorrectly.') call this%parser%StoreErrorUnit() end if ! @@ -465,12 +465,12 @@ subroutine grid_finalize(this) character(len=300) :: ermsg ! -- formats character(len=*), parameter :: fmtdz = & - "('ERROR. CELL (',i0,',',i0,') THICKNESS <= 0. ', & + "('CELL (',i0,',',i0,') THICKNESS <= 0. ', & &'TOP, BOT: ',2(1pg24.15))" character(len=*), parameter :: fmtnr = & - "(/1x, 'THE SPECIFIED IDOMAIN RESULTS IN A REDUCED NUMBER OF CELLS.',& - &/1x, 'NUMBER OF USER NODES: ',I7,& - &/1X, 'NUMBER OF NODES IN SOLUTION: ', I7, //)" + "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',& + &/1x, 'Number of user nodes: ',I0,& + &/1X, 'Number of nodes in solution: ', I0, //)" ! -- data ! ------------------------------------------------------------------------------ ! @@ -484,9 +484,9 @@ subroutine grid_finalize(this) ! ! -- Check to make sure nodes is a valid number if (this%nodes == 0) then - call store_error('MODEL DOES NOT HAVE ANY ACTIVE NODES.') - call store_error('MAKE SURE IDOMAIN ARRAY HAS SOME VALUES GREATER & - &THAN ZERO.') + call store_error('Model does not have any active nodes. & + &Ensure IDOMAIN array has some values greater & + &than zero.') call this%parser%StoreErrorUnit() end if ! diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90 index c154d66e751..bfefc942866 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8.f90 @@ -375,7 +375,6 @@ end subroutine npf_ar subroutine npf_rp(this) implicit none class(GwfNpfType) :: this -! ------------------------------------------------------------------------------ ! ! -- TVK if (this%intvk /= 0) then @@ -1311,43 +1310,43 @@ subroutine log_options(this, found) ! write (this%iout, '(1x,a)') 'Setting NPF Options' if (found%iprflow) & - write (this%iout, '(4x,a)') 'CELL-BY-CELL FLOW INFORMATION WILL BE PRINTED & - &TO LISTING FILE WHENEVER ICBCFL IS NOT ZERO.' + write (this%iout, '(4x,a)') 'Cell-by-cell flow information will be printed & + &to listing file whenever ICBCFL is not zero.' if (found%ipakcb) & - write (this%iout, '(4x,a)') 'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED & - &TO BINARY FILE WHENEVER ICBCFL IS NOT ZERO.' + write (this%iout, '(4x,a)') 'Cell-by-cell flow information will be saved & + &to binary file whenever ICBCFL is not zero.' if (found%cellavg) & - write (this%iout, '(4x,a,i0)') 'ALTERNATIVE CELL AVERAGING [1=LOGARITHMIC, & - &2=AMT-LMK, 3=AMT-HMK] SET TO: ', & + write (this%iout, '(4x,a,i0)') 'Alternative cell averaging [1=logarithmic, & + &2=AMT-LMK, 3=AMT-HMK] set to: ', & this%icellavg if (found%ithickstrt) & - write (this%iout, '(4x,a)') 'THICKSTRT OPTION HAS BEEN ACTIVATED.' + write (this%iout, '(4x,a)') 'THICKSTRT option has been activated.' if (found%iperched) & - write (this%iout, '(4x,a)') 'VERTICAL FLOW WILL BE ADJUSTED FOR PERCHED & - &CONDITIONS.' + write (this%iout, '(4x,a)') 'Vertical flow will be adjusted for perched & + &conditions.' if (found%ivarcv) & - write (this%iout, '(4x,a)') 'VERTICAL CONDUCTANCE VARIES WITH WATER TABLE.' + write (this%iout, '(4x,a)') 'Vertical conductance varies with water table.' if (found%idewatcv) & - write (this%iout, '(4x,a)') 'VERTICAL CONDUCTANCE ACCOUNTS FOR DEWATERED & - &PORTION OF AN UNDERLYING CELL.' - if (found%ixt3d) write (this%iout, '(4x,a)') 'XT3D FORMULATION IS SELECTED.' + write (this%iout, '(4x,a)') 'Vertical conductance accounts for dewatered & + &portion of an underlying cell.' + if (found%ixt3d) write (this%iout, '(4x,a)') 'XT3D formulation is selected.' if (found%ixt3drhs) & - write (this%iout, '(4x,a)') 'XT3D RHS FORMULATION IS SELECTED.' + write (this%iout, '(4x,a)') 'XT3D RHS formulation is selected.' if (found%isavspdis) & - write (this%iout, '(4x,a)') 'SPECIFIC DISCHARGE WILL BE CALCULATED AT CELL & - &CENTERS AND WRITTEN TO DATA-SPDIS IN BUDGET & - &FILE WHEN REQUESTED.' + write (this%iout, '(4x,a)') 'Specific discharge will be calculated at cell & + ¢ers and written to DATA-SPDIS in budget & + &file when requested.' if (found%isavsat) & - write (this%iout, '(4x,a)') 'SATURATION WILL BE WRITTEN TO DATA-SAT IN & - &BUDGET FILE WHEN REQUESTED.' + write (this%iout, '(4x,a)') 'Saturation will be written to DATA-SAT in & + &budget file when requested.' if (found%ik22overk) & - write (this%iout, '(4x,a)') 'VALUES SPECIFIED FOR K22 ARE ANISOTROPY & - &RATIOS AND WILL BE MULTIPLIED BY K BEFORE & - &BEING USED IN CALCULATIONS.' + write (this%iout, '(4x,a)') 'Values specified for K22 are anisotropy & + &ratios and will be multiplied by K before & + &being used in calculations.' if (found%ik33overk) & - write (this%iout, '(4x,a)') 'VALUES SPECIFIED FOR K33 ARE ANISOTROPY & - &RATIOS AND WILL BE MULTIPLIED BY K BEFORE & - &BEING USED IN CALCULATIONS.' + write (this%iout, '(4x,a)') 'Values specified for K33 are anisotropy & + &ratios and will be multiplied by K before & + &being used in calculations.' if (found%inewton) & write (this%iout, '(4x,a)') 'NEWTON-RAPHSON method disabled for unconfined & &cells' @@ -1358,25 +1357,22 @@ subroutine log_options(this, found) write (this%iout, '(4x,a)') 'MODFLOW-NWT upstream weighting method will be & &used' if (found%satmin) & - write (this%iout, '(4x,a,1pg15.6)') 'MINIMUM SATURATED THICKNESS HAS BEEN & - &SET TO: ', this%satmin + write (this%iout, '(4x,a,1pg15.6)') 'Minimum saturated thickness has been & + &set to: ', this%satmin if (found%satomega) & - write (this%iout, '(4x,a,1pg15.6)') 'SATURATION OMEGA: ', this%satomega - if (found%irewet) write (this%iout, '(4x,a)') 'REWETTING IS ACTIVE.' + write (this%iout, '(4x,a,1pg15.6)') 'Saturation omega: ', this%satomega + if (found%irewet) & + write (this%iout, '(4x,a)') 'Rewetting is active.' if (found%wetfct) & - write (this%iout, '(4x,a,1pg15.6)') 'WETTING FACTOR HAS BEEN SET TO: ', & - this%wetfct + write (this%iout, '(4x,a,1pg15.6)') & + 'Wetting factor (WETFCT) has been set to: ', this%wetfct if (found%iwetit) & - write (this%iout, '(4x,a,i5)') 'IWETIT HAS BEEN SET TO: ', this%iwetit + write (this%iout, '(4x,a,i5)') & + 'Wetting iteration interval (IWETIT) has been set to: ', this%iwetit if (found%ihdwet) & - write (this%iout, '(4x,a,i5)') 'IHDWET HAS BEEN SET TO: ', this%ihdwet + write (this%iout, '(4x,a,i5)') & + 'Head rewet equation (IHDWET) has been set to: ', this%ihdwet write (this%iout, '(1x,a,/)') 'End Setting NPF Options' - ! - ! -- Write rewet settings - write (this%iout, '(1x, a)') 'THE FOLLOWING REWET SETTINGS WILL BE USED.' - write (this%iout, '(4x, a,1pg15.6)') ' WETFCT = ', this%wetfct - write (this%iout, '(4x, a,i0)') ' IWETIT = ', this%iwetit - write (this%iout, '(4x, a,i0)') ' IHDWET = ', this%ihdwet end subroutine log_options @@ -1616,10 +1612,14 @@ subroutine log_griddata(this, found) if (found%k33) then write (this%iout, '(4x,a)') 'K33 set from input file' + else + write (this%iout, '(4x,a)') 'K33 not provided. Setting K33 = K.' end if if (found%k22) then write (this%iout, '(4x,a)') 'K22 set from input file' + else + write (this%iout, '(4x,a)') 'K22 not provided. Setting K22 = K.' end if if (found%wetdry) then @@ -1670,7 +1670,7 @@ subroutine source_griddata(this) ! -- set memory path idmMemoryPath = create_mem_path(this%name_model, 'NPF', idm_context) ! - ! -- set map + ! -- set map to convert user input data into reduced data map => null() if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser ! @@ -1719,11 +1719,9 @@ subroutine source_griddata(this) ! ! -- handle not found side effects if (.not. found%k33) then - write (this%iout, '(1x, a)') 'K33 not provided. Setting K33 = K.' call mem_set_value(this%k33, 'K', idmMemoryPath, map, afound(1)) end if if (.not. found%k22) then - write (this%iout, '(1x, a)') 'K22 not provided. Setting K22 = K.' call mem_set_value(this%k22, 'K', idmMemoryPath, map, afound(2)) end if if (.not. found%wetdry) call mem_reallocate(this%wetdry, 1, 'WETDRY', & diff --git a/src/Model/GroundWaterTransport/gwt1dsp.f90 b/src/Model/GroundWaterTransport/gwt1dsp.f90 index d2a773dd6ea..8419a508de0 100644 --- a/src/Model/GroundWaterTransport/gwt1dsp.f90 +++ b/src/Model/GroundWaterTransport/gwt1dsp.f90 @@ -557,8 +557,8 @@ subroutine log_options(this, found) type(GwtDspParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting DSP Options' - write (this%iout, '(4x,a,i0)') 'XT3D FORMULATION [0=INACTIVE, 1=ACTIVE, & - &3=ACTIVE RHS] SET TO: ', this%ixt3d + write (this%iout, '(4x,a,i0)') 'XT3D formulation [0=INACTIVE, 1=ACTIVE, & + &3=ACTIVE RHS] set to: ', this%ixt3d write (this%iout, '(1x,a,/)') 'End Setting DSP Options' end subroutine log_options @@ -704,7 +704,7 @@ subroutine source_griddata(this) if (this%idisp > 0) then if (.not. (found%alh .and. found%ath1)) then write (errmsg, '(1x,a)') & - 'IF DISPERSIVITIES ARE SPECIFIED THEN ALH AND ATH1 ARE REQUIRED.' + 'if dispersivities are specified then ALH and ATH1 are required.' call store_error(errmsg) end if ! -- If alv not specified then point it to alh diff --git a/src/Utilities/ArrayRead/LayeredArrayReader.f90 b/src/Utilities/ArrayRead/LayeredArrayReader.f90 index 26170fd7939..3207c87c8e9 100644 --- a/src/Utilities/ArrayRead/LayeredArrayReader.f90 +++ b/src/Utilities/ArrayRead/LayeredArrayReader.f90 @@ -28,7 +28,7 @@ subroutine read_dbl1d_layered(parser, dbl1d, aname, nlay, layer_shape) integer(I4B) :: k integer(I4B) :: ncpl, nrow, ncol integer(I4B) :: index_start, index_stop - real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr + real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr => null() ncpl = product(layer_shape) index_start = 1 @@ -44,6 +44,7 @@ subroutine read_dbl1d_layered(parser, dbl1d, aname, nlay, layer_shape) end if index_start = index_stop + 1 end do + nullify (dbl2d_ptr) end subroutine read_dbl1d_layered @@ -57,13 +58,14 @@ subroutine read_dbl2d_layered(parser, dbl2d, aname, nlay, layer_shape) ! -- local integer(I4B) :: k integer(I4B) :: ncpl - real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr + real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr => null() ncpl = layer_shape(1) do k = 1, nlay dbl1d_ptr(1:ncpl) => dbl2d(1:ncpl, k) call read_dbl1d(parser, dbl1d_ptr, aname) end do + nullify (dbl1d_ptr) end subroutine read_dbl2d_layered @@ -77,7 +79,7 @@ subroutine read_dbl3d_layered(parser, dbl3d, aname, nlay, layer_shape) ! -- local integer(I4B) :: k integer(I4B) :: ncol, nrow - real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr + real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr => null() ncol = layer_shape(1) nrow = layer_shape(2) @@ -85,6 +87,7 @@ subroutine read_dbl3d_layered(parser, dbl3d, aname, nlay, layer_shape) dbl2d_ptr(1:ncol, 1:nrow) => dbl3d(:, :, k:k) call read_dbl2d(parser, dbl2d_ptr, aname) end do + nullify (dbl2d_ptr) end subroutine read_dbl3d_layered @@ -99,7 +102,7 @@ subroutine read_int1d_layered(parser, int1d, aname, nlay, layer_shape) integer(I4B) :: k integer(I4B) :: ncpl, nrow, ncol integer(I4B) :: index_start, index_stop - integer(I4B), dimension(:, :), contiguous, pointer :: int2d_ptr + integer(I4B), dimension(:, :), contiguous, pointer :: int2d_ptr => null() ncpl = product(layer_shape) index_start = 1 @@ -115,6 +118,7 @@ subroutine read_int1d_layered(parser, int1d, aname, nlay, layer_shape) end if index_start = index_stop + 1 end do + nullify (int2d_ptr) end subroutine read_int1d_layered @@ -128,13 +132,14 @@ subroutine read_int2d_layered(parser, int2d, aname, nlay, layer_shape) ! -- local integer(I4B) :: k integer(I4B) :: ncpl - integer(I4B), dimension(:), contiguous, pointer :: int1d_ptr + integer(I4B), dimension(:), contiguous, pointer :: int1d_ptr => null() ncpl = layer_shape(1) do k = 1, nlay int1d_ptr(1:ncpl) => int2d(1:ncpl, k) call read_int1d(parser, int1d_ptr, aname) end do + nullify (int1d_ptr) end subroutine read_int2d_layered @@ -148,7 +153,7 @@ subroutine read_int3d_layered(parser, int3d, aname, nlay, layer_shape) ! -- local integer(I4B) :: k integer(I4B) :: ncol, nrow - integer(I4B), dimension(:, :), contiguous, pointer :: int2d_ptr + integer(I4B), dimension(:, :), contiguous, pointer :: int2d_ptr => null() ncol = layer_shape(1) nrow = layer_shape(2) @@ -156,6 +161,7 @@ subroutine read_int3d_layered(parser, int3d, aname, nlay, layer_shape) int2d_ptr(1:ncol, 1:nrow) => int3d(:, :, k:k) call read_int2d(parser, int2d_ptr, aname) end do + nullify (int2d_ptr) end subroutine read_int3d_layered diff --git a/src/Utilities/Idm/LoadMf6FileType.f90 b/src/Utilities/Idm/LoadMf6FileType.f90 index ce6c6943427..5f3038955b3 100644 --- a/src/Utilities/Idm/LoadMf6FileType.f90 +++ b/src/Utilities/Idm/LoadMf6FileType.f90 @@ -396,7 +396,8 @@ subroutine load_integer1d_type(parser, idt, memoryPath, mshape, iout) integer(I4B), dimension(:), allocatable :: layer_shape character(len=LINELENGTH) :: keyword - ! Check if it is a full grid sized array (NODES) + ! Check if it is a full grid sized array (NODES), otherwise use + ! idt%shape to construct shape from variables in memoryPath if (idt%shape == 'NODES') then nvals = product(mshape) else diff --git a/src/Utilities/kind.f90 b/src/Utilities/kind.f90 index 60b355d0aa2..42d2da55f92 100644 --- a/src/Utilities/kind.f90 +++ b/src/Utilities/kind.f90 @@ -40,21 +40,21 @@ subroutine write_kindinfo(iout) tiny(rdum) write (iout, '(2x,a,1pg15.6)') 'HUGE (largest value): ', huge(rdum) write (iout, '(2x,a,i0)') 'PRECISION: ', precision(rdum) - write (iout, '(2x,a,i0)') 'BIT SIZE: ', bit_size(irdum) + write (iout, '(2x,a,i0)') 'SIZE IN BITS: ', bit_size(irdum) write (iout, '(/a)') 'Integer Variables' write (iout, '(2x,a,i0)') 'KIND: ', I4B write (iout, '(2x,a,i0)') 'HUGE (largest value): ', huge(idum) - write (iout, '(2x,a,i0)') 'BIT SIZE: ', bit_size(idum) + write (iout, '(2x,a,i0)') 'SIZE IN BITS: ', bit_size(idum) write (iout, '(/a)') 'Long Integer Variables' write (iout, '(2x,a,i0)') 'KIND: ', I8B write (iout, '(2x,a,i0)') 'HUGE (largest value): ', huge(long_idum) - write (iout, '(2x,a,i0)') 'BIT SIZE: ', bit_size(long_idum) + write (iout, '(2x,a,i0)') 'SIZE IN BITS: ', bit_size(long_idum) write (iout, '(/a)') 'Logical Variables' write (iout, '(2x,a,i0)') 'KIND: ', LGP - write (iout, '(2x,a,i0)') 'BIT SIZE: ', bit_size(ldum) + write (iout, '(2x,a,i0)') 'SIZE IN BITS: ', bit_size(ldum) ! ! -- Return return