From d6b4350d0ba7ab54fb8747d3cc76d12af1d04126 Mon Sep 17 00:00:00 2001 From: langevin-usgs Date: Wed, 26 Jul 2023 11:20:33 -0500 Subject: [PATCH] fix(backspace): remove Fortran backspace (#1310) * remove backspace so that ifx can be used to compile * update meson for ifx * fix initialization error in mf5to6 ghost node writer * introduce LongLineReader as a way to emulate backspace functionality * update vscode tasks.json for consistent build group definition --- .vscode/tasks.json | 40 ++- autotest/test_cli.py | 9 +- make/makedefaults | 2 +- make/makefile | 35 +-- meson.build | 18 +- msvs/mf6core.vfproj | 127 +++++---- src/Model/GroundWaterFlow/gwf3evt8.f90 | 3 +- src/Model/GroundWaterFlow/gwf3rch8.f90 | 3 +- src/Model/ModelUtilities/BoundaryPackage.f90 | 3 +- .../ModelUtilities/DiscretizationBase.f90 | 13 +- src/Utilities/ArrayReaders.f90 | 4 +- src/Utilities/BlockParser.f90 | 257 +++++++++++++++++- src/Utilities/InputOutput.f90 | 244 +---------------- src/Utilities/ListReader.f90 | 31 ++- src/Utilities/LongLineReader.f90 | 117 ++++++++ src/meson.build | 1 + utils/mf5to6/make/makedefaults | 2 +- utils/mf5to6/make/makefile | 3 +- utils/mf5to6/msvs/mf5to6.vfproj | 54 ++-- utils/mf5to6/pymake/extrafiles.txt | 1 + utils/mf5to6/src/Connection.f90 | 30 ++ utils/mf5to6/src/Preproc/ObsBlock.f90 | 2 +- utils/mf5to6/src/Preproc/Preproc.f90 | 7 +- utils/mf5to6/src/Preproc/Utilities.f90 | 64 +---- utils/mf5to6/src/mf5to6.f90 | 3 +- utils/zonebudget/make/makedefaults | 2 +- utils/zonebudget/make/makefile | 3 +- utils/zonebudget/msvs/zonebudget.vfproj | 53 ++-- utils/zonebudget/pymake/extrafiles.txt | 1 + 29 files changed, 656 insertions(+), 476 deletions(-) create mode 100644 src/Utilities/LongLineReader.f90 diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 490baff6416..76f6cb2fe2d 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -26,7 +26,10 @@ "release", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -53,7 +56,10 @@ "release", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -81,7 +87,10 @@ "release", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -108,7 +117,10 @@ "release", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -136,7 +148,10 @@ "debug", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -163,7 +178,10 @@ "debug", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -191,7 +209,10 @@ "debug", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -218,7 +239,10 @@ "debug", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } diff --git a/autotest/test_cli.py b/autotest/test_cli.py index 6aa73052988..d1f033bb0e9 100644 --- a/autotest/test_cli.py +++ b/autotest/test_cli.py @@ -1,16 +1,21 @@ import subprocess +import platform from conftest import project_root_path bin_path = project_root_path / "bin" +app = "mf6" +ext = ".exe" if platform.system() == "Windows" else "" +app = f"{app}{ext}" + def test_cli_version(): output = " ".join( - subprocess.check_output([str(bin_path / "mf6"), "-v"]).decode().split() + subprocess.check_output([str(bin_path / app), "-v"]).decode().split() ) print(output) - assert output.startswith("mf6:") + assert output.startswith(f"{app}:"), f"found: {output}" version = ( output.lower().split(' ')[1] diff --git a/make/makedefaults b/make/makedefaults index 7bbd4dd3293..a9174e9746d 100644 --- a/make/makedefaults +++ b/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.7) for the 'mf6' executable. +# makedefaults created by pymake (version 1.2.9.dev0) for the 'mf6' executable. # determine OS ifeq ($(OS), Windows_NT) diff --git a/make/makefile b/make/makefile index 552d7c70a1d..1fc009719ea 100644 --- a/make/makefile +++ b/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.7) for the 'mf6' executable. +# makefile created by pymake (version 1.2.9.dev0) for the 'mf6' executable. include ./makedefaults @@ -88,6 +88,7 @@ $(OBJDIR)/MemoryHelper.o \ $(OBJDIR)/CharString.o \ $(OBJDIR)/Memory.o \ $(OBJDIR)/List.o \ +$(OBJDIR)/LongLineReader.o \ $(OBJDIR)/MemoryList.o \ $(OBJDIR)/TimeSeriesRecord.o \ $(OBJDIR)/BlockParser.o \ @@ -122,28 +123,21 @@ $(OBJDIR)/PackageMover.o \ $(OBJDIR)/Obs3.o \ $(OBJDIR)/NumericalPackage.o \ $(OBJDIR)/Budget.o \ -$(OBJDIR)/SeqVector.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/SfrCrossSectionUtils.o \ $(OBJDIR)/BudgetTerm.o \ -$(OBJDIR)/BoundaryPackage.o \ -$(OBJDIR)/BaseModel.o \ -$(OBJDIR)/SparseMatrix.o \ -$(OBJDIR)/LinearSolverBase.o \ -$(OBJDIR)/ims8reordering.o \ $(OBJDIR)/VirtualBase.o \ $(OBJDIR)/STLVecInt.o \ +$(OBJDIR)/BoundaryPackage.o \ +$(OBJDIR)/BaseModel.o \ $(OBJDIR)/InputDefinition.o \ $(OBJDIR)/SfrCrossSectionManager.o \ $(OBJDIR)/dag_module.o \ $(OBJDIR)/BudgetObject.o \ -$(OBJDIR)/NumericalModel.o \ -$(OBJDIR)/BaseExchange.o \ -$(OBJDIR)/ImsLinearSolver.o \ -$(OBJDIR)/ims8base.o \ $(OBJDIR)/VirtualDataLists.o \ $(OBJDIR)/VirtualDataContainer.o \ $(OBJDIR)/SimStages.o \ +$(OBJDIR)/NumericalModel.o \ $(OBJDIR)/simnamidm.o \ $(OBJDIR)/gwt1idm.o \ $(OBJDIR)/gwt1dsp1idm.o \ @@ -168,13 +162,9 @@ $(OBJDIR)/gwf3lak8.o \ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf3ghb8.o \ $(OBJDIR)/gwf3drn8.o \ -$(OBJDIR)/Timer.o \ -$(OBJDIR)/NumericalExchange.o \ -$(OBJDIR)/LinearSolverFactory.o \ -$(OBJDIR)/ims8linear.o \ -$(OBJDIR)/BaseSolution.o \ $(OBJDIR)/IndexMap.o \ $(OBJDIR)/VirtualModel.o \ +$(OBJDIR)/BaseExchange.o \ $(OBJDIR)/IdmSimDfnSelector.o \ $(OBJDIR)/IdmGwtDfnSelector.o \ $(OBJDIR)/IdmGwfDfnSelector.o \ @@ -187,9 +177,10 @@ $(OBJDIR)/gwf3tvk8.o \ $(OBJDIR)/MemoryManagerExt.o \ $(OBJDIR)/gwf3vsc8.o \ $(OBJDIR)/GwfNpfOptions.o \ -$(OBJDIR)/NumericalSolution.o \ $(OBJDIR)/InterfaceMap.o \ +$(OBJDIR)/SeqVector.o \ $(OBJDIR)/CellWithNbrs.o \ +$(OBJDIR)/NumericalExchange.o \ $(OBJDIR)/IdmDfnSelector.o \ $(OBJDIR)/gwf3uzf8.o \ $(OBJDIR)/gwt1apt1.o \ @@ -207,6 +198,9 @@ $(OBJDIR)/GwfMvrPeriodData.o \ $(OBJDIR)/ims8misc.o \ $(OBJDIR)/GwfBuyInputData.o \ $(OBJDIR)/VirtualSolution.o \ +$(OBJDIR)/SparseMatrix.o \ +$(OBJDIR)/LinearSolverBase.o \ +$(OBJDIR)/ims8reordering.o \ $(OBJDIR)/ArrayReaderBase.o \ $(OBJDIR)/VirtualExchange.o \ $(OBJDIR)/gwf3disu8.o \ @@ -244,12 +238,18 @@ $(OBJDIR)/GhostNode.o \ $(OBJDIR)/gwf3evt8.o \ $(OBJDIR)/gwf3chd8.o \ $(OBJDIR)/RouterBase.o \ +$(OBJDIR)/ImsLinearSolver.o \ +$(OBJDIR)/ims8base.o \ $(OBJDIR)/Integer2dReader.o \ $(OBJDIR)/GridConnection.o \ $(OBJDIR)/DistributedVariable.o \ $(OBJDIR)/gwt1.o \ $(OBJDIR)/gwf3.o \ $(OBJDIR)/SerialRouter.o \ +$(OBJDIR)/Timer.o \ +$(OBJDIR)/LinearSolverFactory.o \ +$(OBJDIR)/ims8linear.o \ +$(OBJDIR)/BaseSolution.o \ $(OBJDIR)/StructVector.o \ $(OBJDIR)/IdmLogger.o \ $(OBJDIR)/Integer1dReader.o \ @@ -262,6 +262,7 @@ $(OBJDIR)/GwtGwtExchange.o \ $(OBJDIR)/GwfInterfaceModel.o \ $(OBJDIR)/GwfGwfExchange.o \ $(OBJDIR)/RouterFactory.o \ +$(OBJDIR)/NumericalSolution.o \ $(OBJDIR)/MappedMemory.o \ $(OBJDIR)/StructArray.o \ $(OBJDIR)/ModflowInput.o \ diff --git a/meson.build b/meson.build index 879bf5d4c3a..adc2078da00 100644 --- a/meson.build +++ b/meson.build @@ -25,6 +25,7 @@ message('The used profile is:', profile) # parse compiler options fc = meson.get_compiler('fortran') fc_id = fc.get_id() +message('The fc_id is:', fc_id) compile_args = [] link_args = [] @@ -85,8 +86,23 @@ elif fc_id == 'intel' '-diag-disable:5268', # Line too long ] link_args += '-static-intel' -endif + +# Command line options for ifx +elif fc_id == 'intel-llvm-cl' + # windows + compile_args += ['/fpe:0', # Activate all floating point exceptions + '/heap-arrays:0', + '/traceback', + '/fpp', # Activate preprocessing + '/Qdiag-disable:7416', # f2008 warning + '/Qdiag-disable:7025', # f2008 warning + '/Qdiag-disable:5268', # Line too long + ] + link_args += ['/ignore:4217', # access through ddlimport might be inefficient + '/ignore:4286' # same as 4217, but more general + ] +endif # parallel build options is_parallel_build = get_option('parallel') diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index e2be9f2e7b6..b2fe810728e 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -2,44 +2,50 @@ - + + - - - - - - - - + + + + + + + + + - - - - - - - - + + + + + + + + + - - - - - - - - + + + + + + + + + - - - - - - - - + + + + + + + + + + @@ -72,13 +78,13 @@ - + - + - + - + @@ -224,13 +230,13 @@ - + - + - + - + @@ -239,13 +245,13 @@ - + - + - + - + @@ -336,29 +342,30 @@ - + - + - + - + - + - + - + - + + @@ -381,13 +388,15 @@ - + - + - + - + - - + + + + diff --git a/src/Model/GroundWaterFlow/gwf3evt8.f90 b/src/Model/GroundWaterFlow/gwf3evt8.f90 index 34d687cfbdf..37652b31151 100644 --- a/src/Model/GroundWaterFlow/gwf3evt8.f90 +++ b/src/Model/GroundWaterFlow/gwf3evt8.f90 @@ -1093,7 +1093,8 @@ subroutine evt_rp_list(this, inrate) ! nlist = -1 maxboundorig = this%maxbound - call this%dis%read_list(this%parser%iuactive, this%iout, this%iprpak, & + call this%dis%read_list(this%parser%line_reader, & + this%parser%iuactive, this%iout, this%iprpak, & nlist, this%inamedbound, this%iauxmultcol, & this%nodelist, this%bound, this%auxvar, & this%auxname, this%boundname, this%listlabel, & diff --git a/src/Model/GroundWaterFlow/gwf3rch8.f90 b/src/Model/GroundWaterFlow/gwf3rch8.f90 index e50ad4f279b..d0add5b9f79 100644 --- a/src/Model/GroundWaterFlow/gwf3rch8.f90 +++ b/src/Model/GroundWaterFlow/gwf3rch8.f90 @@ -591,7 +591,8 @@ subroutine rch_rp_list(this, inrech) ! ! -- read the list of recharge values; scale the recharge by auxmultcol ! if it is specified. - call this%dis%read_list(this%parser%iuactive, this%iout, this%iprpak, & + call this%dis%read_list(this%parser%line_reader, & + this%parser%iuactive, this%iout, this%iprpak, & nlist, this%inamedbound, this%iauxmultcol, & this%nodelist, this%bound, this%auxvar, & this%auxname, this%boundname, this%listlabel, & diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90 index 1ec95293e16..8fd71401f45 100644 --- a/src/Model/ModelUtilities/BoundaryPackage.f90 +++ b/src/Model/ModelUtilities/BoundaryPackage.f90 @@ -364,7 +364,8 @@ subroutine bnd_rp(this) call this%TasManager%Reset(this%packName) ! ! -- Read data as a list - call this%dis%read_list(this%parser%iuactive, this%iout, & + call this%dis%read_list(this%parser%line_reader, & + this%parser%iuactive, this%iout, & this%iprpak, nlist, this%inamedbound, & this%iauxmultcol, this%nodelist, & this%bound, this%auxvar, this%auxname, & diff --git a/src/Model/ModelUtilities/DiscretizationBase.f90 b/src/Model/ModelUtilities/DiscretizationBase.f90 index dd03ac8faa3..6c43a150d01 100644 --- a/src/Model/ModelUtilities/DiscretizationBase.f90 +++ b/src/Model/ModelUtilities/DiscretizationBase.f90 @@ -1016,9 +1016,9 @@ subroutine fill_dbl_array(this, buff1, buff2) return end subroutine fill_dbl_array - subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & - iauxmultcol, nodelist, rlist, auxvar, auxname, & - boundname, label, pkgname, tsManager, iscloc, & + subroutine read_list(this, line_reader, in, iout, iprpak, nlist, & + inamedbound, iauxmultcol, nodelist, rlist, auxvar, & + auxname, boundname, label, pkgname, tsManager, iscloc, & indxconvertflux) ! ****************************************************************************** ! read_list -- Read a list using the list reader object. @@ -1032,6 +1032,7 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & ! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBOUNDNAME, LINELENGTH + use LongLineReaderModule, only: LongLineReaderType use ListReaderModule, only: ListReaderType use SimModule, only: store_error, store_error_unit, count_errors use InputOutputModule, only: urword @@ -1039,6 +1040,7 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & use TimeSeriesManagerModule, only: read_value_or_time_series ! -- dummy class(DisBaseType) :: this + type(LongLineReaderType), intent(inout) :: line_reader integer(I4B), intent(in) :: in integer(I4B), intent(in) :: iout integer(I4B), intent(in) :: iprpak @@ -1070,8 +1072,9 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & ! ------------------------------------------------------------------------------ ! ! -- Read the list - call lstrdobj%read_list(in, iout, nlist, inamedbound, this%mshape, & - nodelist, rlist, auxvar, auxname, boundname, label) + call lstrdobj%read_list(line_reader, in, iout, nlist, inamedbound, & + this%mshape, nodelist, rlist, auxvar, auxname, & + boundname, label) ! ! -- Go through all locations where a text string was found instead of ! a double precision value and make time-series links to rlist diff --git a/src/Utilities/ArrayReaders.f90 b/src/Utilities/ArrayReaders.f90 index 37d0141b369..32e49130faa 100644 --- a/src/Utilities/ArrayReaders.f90 +++ b/src/Utilities/ArrayReaders.f90 @@ -674,6 +674,7 @@ subroutine read_control_dbl(iu, iout, aname, locat, cnstnt, & end subroutine read_control_dbl subroutine read_control_1(iu, iout, aname, locat, iclose, line, icol, fname) + use SimModule, only: ustop ! -- Read CONSTANT, INTERNAL, or OPEN/CLOSE from array control record. ! -- dummy integer(I4B), intent(in) :: iu @@ -690,7 +691,8 @@ subroutine read_control_1(iu, iout, aname, locat, iclose, line, icol, fname) integer(I4B) :: ierr real(DP) :: r ! - ! -- Read array control record. + ! -- Read array control record. Any future refactoring + ! should use the LongLineReader here instead of u9rdcom call u9rdcom(iu, iout, line, ierr) ! iclose = 0 diff --git a/src/Utilities/BlockParser.f90 b/src/Utilities/BlockParser.f90 index 2cc5159db58..9b6e015a3bb 100644 --- a/src/Utilities/BlockParser.f90 +++ b/src/Utilities/BlockParser.f90 @@ -7,17 +7,18 @@ module BlockParserModule use KindModule, only: DP, I4B - use ConstantsModule, only: LENHUGELINE, LINELENGTH, MAXCHARLEN + use ConstantsModule, only: LENBIGLINE, LENHUGELINE, LINELENGTH, MAXCHARLEN use VersionModule, only: IDEVELOPMODE - use InputOutputModule, only: uget_block, uget_any_block, uterminate_block, & - u9rdcom, urword, upcase + use InputOutputModule, only: urword, upcase, openfile, & + io_getunit => GetUnit use SimModule, only: store_error, store_error_unit use SimVariablesModule, only: errmsg + use LongLineReaderModule, only: LongLineReaderType implicit none private - public :: BlockParserType + public :: BlockParserType, uget_block, uget_any_block, uterminate_block type :: BlockParserType integer(I4B), public :: iuactive !< flag indicating if a file unit is active, variable is not used internally @@ -30,6 +31,7 @@ module BlockParserModule character(len=LINELENGTH), private :: blockNameFound !< block name found character(len=LENHUGELINE), private :: laststring !< last string read character(len=:), allocatable, private :: line !< current line + type(LongLineReaderType) :: line_reader contains procedure, public :: Initialize procedure, public :: Clear @@ -155,8 +157,9 @@ subroutine GetBlock(this, blockName, isFound, ierr, supportOpenClose, & this%blockNameFound = '' ! if (blockName == '*') then - call uget_any_block(this%inunit, this%iout, isFound, this%lloc, & - this%line, blockNameFound, this%iuext) + call uget_any_block(this%line_reader, this%inunit, this%iout, & + isFound, this%lloc, this%line, blockNameFound, & + this%iuext) if (isFound) then this%blockNameFound = blockNameFound ierr = 0 @@ -164,7 +167,8 @@ subroutine GetBlock(this, blockName, isFound, ierr, supportOpenClose, & ierr = 1 end if else - call uget_block(this%inunit, this%iout, this%blockName, ierr, isFound, & + call uget_block(this%line_reader, this%inunit, this%iout, & + this%blockName, ierr, isFound, & this%lloc, this%line, this%iuext, continueRead, & supportOpenCloseLocal) if (isFound) this%blockNameFound = this%blockName @@ -202,7 +206,7 @@ subroutine GetNextLine(this, endOfBlock) ! -- read next line loop1: do if (lineread) exit loop1 - call u9rdcom(this%iuext, this%iout, this%line, ierr) + call this%line_reader%rdcom(this%iuext, this%iout, this%line, ierr) this%lloc = 1 call urword(this%line, this%lloc, istart, istop, 0, ival, rval, & this%iout, this%iuext) @@ -587,4 +591,241 @@ subroutine DevOpt(this) return end subroutine DevOpt + ! -- static methods previously in InputOutput + !> @brief Find a block in a file + !! + !! Subroutine to read from a file until the tag (ctag) for a block is + !! is found. Return isfound with true, if found. + !! + !< + subroutine uget_block(line_reader, iin, iout, ctag, ierr, isfound, & + lloc, line, iuext, blockRequired, supportopenclose) + implicit none + ! -- dummy variables + type(LongLineReaderType), intent(inout) :: line_reader + integer(I4B), intent(in) :: iin !< file unit + integer(I4B), intent(in) :: iout !< output listing file unit + character(len=*), intent(in) :: ctag !< block tag + integer(I4B), intent(out) :: ierr !< error + logical, intent(inout) :: isfound !< boolean indicating if the block was found + integer(I4B), intent(inout) :: lloc !< position in line + character(len=:), allocatable, intent(inout) :: line !< line + integer(I4B), intent(inout) :: iuext !< external file unit number + logical, optional, intent(in) :: blockRequired !< boolean indicating if the block is required + logical, optional, intent(in) :: supportopenclose !< boolean indicating if the block supports open/close + ! -- local variables + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: ival + integer(I4B) :: lloc2 + real(DP) :: rval + character(len=:), allocatable :: line2 + character(len=LINELENGTH) :: fname + character(len=MAXCHARLEN) :: ermsg + logical :: supportoc, blockRequiredLocal + ! + ! -- code + if (present(blockRequired)) then + blockRequiredLocal = blockRequired + else + blockRequiredLocal = .true. + end if + supportoc = .false. + if (present(supportopenclose)) then + supportoc = supportopenclose + end if + iuext = iin + isfound = .false. + mainloop: do + lloc = 1 + call line_reader%rdcom(iin, iout, line, ierr) + if (ierr < 0) then + if (blockRequiredLocal) then + ermsg = 'Required block "'//trim(ctag)// & + '" not found. Found end of file instead.' + call store_error(ermsg) + call store_error_unit(iuext) + end if + ! block not found so exit + exit + end if + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == 'BEGIN') then + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == ctag) then + isfound = .true. + if (supportoc) then + ! Look for OPEN/CLOSE on 1st line after line starting with BEGIN + call line_reader%rdcom(iin, iout, line2, ierr) + if (ierr < 0) exit + lloc2 = 1 + call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) + if (line2(istart:istop) == 'OPEN/CLOSE') then + ! -- Get filename and preserve case + call urword(line2, lloc2, istart, istop, 0, ival, rval, iin, iout) + fname = line2(istart:istop) + ! If line contains '(BINARY)' or 'SFAC', handle this block elsewhere + chk: do + call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) + if (line2(istart:istop) == '') exit chk + if (line2(istart:istop) == '(BINARY)' .or. & + line2(istart:istop) == 'SFAC') then + call line_reader%bkspc(iin) + exit mainloop + end if + end do chk + iuext = io_getunit() + call openfile(iuext, iout, fname, 'OPEN/CLOSE') + else + call line_reader%bkspc(iin) + end if + end if + else + if (blockRequiredLocal) then + ermsg = 'Error: Required block "'//trim(ctag)// & + '" not found. Found block "'//line(istart:istop)// & + '" instead.' + call store_error(ermsg) + call store_error_unit(iuext) + else + call line_reader%bkspc(iin) + end if + end if + exit mainloop + else if (line(istart:istop) == 'END') then + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == ctag) then + ermsg = 'Error: Looking for BEGIN '//trim(ctag)// & + ' but found END '//line(istart:istop)// & + ' instead.' + call store_error(ermsg) + call store_error_unit(iuext) + end if + end if + end do mainloop + ! + ! -- return + return + end subroutine uget_block + + !> @brief Find the next block in a file + !! + !! Subroutine to read from a file until next block is found. + !! Return isfound with true, if found, and return the block name. + !! + !< + subroutine uget_any_block(line_reader, iin, iout, isfound, & + lloc, line, ctagfound, iuext) + implicit none + ! -- dummy variables + type(LongLineReaderType), intent(inout) :: line_reader + integer(I4B), intent(in) :: iin !< file unit number + integer(I4B), intent(in) :: iout !< output listing file unit + logical, intent(inout) :: isfound !< boolean indicating if a block was found + integer(I4B), intent(inout) :: lloc !< position in line + character(len=:), allocatable, intent(inout) :: line !< line + character(len=*), intent(out) :: ctagfound !< block name + integer(I4B), intent(inout) :: iuext !< external file unit number + ! -- local variables + integer(I4B) :: ierr, istart, istop + integer(I4B) :: ival, lloc2 + real(DP) :: rval + character(len=100) :: ermsg + character(len=:), allocatable :: line2 + character(len=LINELENGTH) :: fname + ! + ! -- code + isfound = .false. + ctagfound = '' + iuext = iin + do + lloc = 1 + call line_reader%rdcom(iin, iout, line, ierr) + if (ierr < 0) exit + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == 'BEGIN') then + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) /= '') then + isfound = .true. + ctagfound = line(istart:istop) + call line_reader%rdcom(iin, iout, line2, ierr) + if (ierr < 0) exit + lloc2 = 1 + call urword(line2, lloc2, istart, istop, 1, ival, rval, iout, iin) + if (line2(istart:istop) == 'OPEN/CLOSE') then + iuext = io_getunit() + call urword(line2, lloc2, istart, istop, 0, ival, rval, iout, iin) + fname = line2(istart:istop) + call openfile(iuext, iout, fname, 'OPEN/CLOSE') + else + call line_reader%bkspc(iin) + end if + else + ermsg = 'Block name missing in file.' + call store_error(ermsg) + call store_error_unit(iin) + end if + exit + end if + end do + return + end subroutine uget_any_block + + !> @brief Evaluate if the end of a block has been found + !! + !! Subroutine to evaluate if the end of a block has been found. Abnormal + !! termination if 'begin' is found or if 'end' encountered with + !! incorrect tag. + !! + !< + subroutine uterminate_block(iin, iout, key, ctag, lloc, line, ierr, iuext) + implicit none + ! -- dummy variables + integer(I4B), intent(in) :: iin !< file unit number + integer(I4B), intent(in) :: iout !< output listing file unit number + character(len=*), intent(in) :: key !< keyword in block + character(len=*), intent(in) :: ctag !< block name + integer(I4B), intent(inout) :: lloc !< position in line + character(len=*), intent(inout) :: line !< line + integer(I4B), intent(inout) :: ierr !< error + integer(I4B), intent(inout) :: iuext !< external file unit number + ! -- local variables + character(len=LENBIGLINE) :: ermsg + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: ival + real(DP) :: rval + ! -- format +1 format('ERROR. "', A, '" DETECTED WITHOUT "', A, '". ', '"END', 1X, A, & + '" MUST BE USED TO END ', A, '.') +2 format('ERROR. "', A, '" DETECTED BEFORE "END', 1X, A, '". ', '"END', 1X, A, & + '" MUST BE USED TO END ', A, '.') + ! + ! -- code + ierr = 1 + select case (key) + case ('END') + call urword(line, lloc, istart, istop, 1, ival, rval, iout, iin) + if (line(istart:istop) /= ctag) then + write (ermsg, 1) trim(key), trim(ctag), trim(ctag), trim(ctag) + call store_error(ermsg) + call store_error_unit(iin) + else + ierr = 0 + if (iuext /= iin) then + ! -- close external file + close (iuext) + iuext = iin + end if + end if + case ('BEGIN') + write (ermsg, 2) trim(key), trim(ctag), trim(ctag), trim(ctag) + call store_error(ermsg) + call store_error_unit(iin) + end select + ! + ! -- return + return + end subroutine uterminate_block + end module BlockParserModule diff --git a/src/Utilities/InputOutput.f90 b/src/Utilities/InputOutput.f90 index 8d12c1bd21b..ed27ffd90e6 100644 --- a/src/Utilities/InputOutput.f90 +++ b/src/Utilities/InputOutput.f90 @@ -13,14 +13,14 @@ module InputOutputModule DZERO use GenericUtilitiesModule, only: is_same, sim_message private - public :: GetUnit, uget_block, & - uterminate_block, UPCASE, URWORD, ULSTLB, UBDSV4, & + public :: GetUnit, & + UPCASE, URWORD, ULSTLB, UBDSV4, & ubdsv06, UBDSVB, UCOLNO, ULAPRW, & ULASAV, ubdsv1, ubdsvc, ubdsvd, UWWORD, & same_word, get_node, get_ijk, unitinquire, & ParseLine, ulaprufw, openfile, & linear_interpolate, lowcase, & - read_line, uget_any_block, & + read_line, & GetFileFromPath, extract_idnum_or_bndname, urdaux, & get_jk, print_format, BuildFixedFormat, & BuildFloatFormat, BuildIntFormat, fseek_stream, & @@ -201,239 +201,6 @@ function getunit() return end function getunit - !> @brief Find a block in a file - !! - !! Subroutine to read from a file until the tag (ctag) for a block is - !! is found. Return isfound with true, if found. - !! - !< - subroutine uget_block(iin, iout, ctag, ierr, isfound, lloc, line, iuext, & - blockRequired, supportopenclose) - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin !< file unit - integer(I4B), intent(in) :: iout !< output listing file unit - character (len=*), intent(in) :: ctag !< block tag - integer(I4B), intent(out) :: ierr !< error - logical, intent(inout) :: isfound !< boolean indicating if the block was found - integer(I4B), intent(inout) :: lloc !< position in line - character (len=:), allocatable, intent(inout) :: line !< line - integer(I4B), intent(inout) :: iuext !< external file unit number - logical, optional, intent(in) :: blockRequired !< boolean indicating if the block is required - logical, optional, intent(in) :: supportopenclose !< boolean indicating if the block supports open/close - ! -- local variables - integer(I4B) :: istart - integer(I4B) :: istop - integer(I4B) :: ival - integer(I4B) :: lloc2 - real(DP) :: rval - character (len=:), allocatable :: line2 - character(len=LINELENGTH) :: fname - character(len=MAXCHARLEN) :: ermsg - logical :: supportoc, blockRequiredLocal - ! - ! -- code - if (present(blockRequired)) then - blockRequiredLocal = blockRequired - else - blockRequiredLocal = .true. - endif - supportoc = .false. - if (present(supportopenclose)) then - supportoc = supportopenclose - endif - iuext = iin - isfound = .false. - mainloop: do - lloc = 1 - call u9rdcom(iin, iout, line, ierr) - if (ierr < 0) then - if (blockRequiredLocal) then - ermsg = 'Required block "' // trim(ctag) // & - '" not found. Found end of file instead.' - call store_error(ermsg) - call store_error_unit(iuext) - end if - ! block not found so exit - exit - end if - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == 'BEGIN') then - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == ctag) then - isfound = .true. - if (supportoc) then - ! Look for OPEN/CLOSE on 1st line after line starting with BEGIN - call u9rdcom(iin, iout, line2, ierr) - if (ierr < 0) exit - lloc2 = 1 - call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) - if (line2(istart:istop) == 'OPEN/CLOSE') then - ! -- Get filename and preserve case - call urword(line2, lloc2, istart, istop, 0, ival, rval, iin, iout) - fname = line2(istart:istop) - ! If line contains '(BINARY)' or 'SFAC', handle this block elsewhere - chk: do - call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) - if (line2(istart:istop) == '') exit chk - if (line2(istart:istop) == '(BINARY)' .or. & - line2(istart:istop) == 'SFAC') then - backspace(iin) - exit mainloop - end if - end do chk - iuext = GetUnit() - call openfile(iuext,iout,fname,'OPEN/CLOSE') - else - backspace(iin) - end if - end if - else - if (blockRequiredLocal) then - ermsg = 'Error: Required block "' // trim(ctag) // & - '" not found. Found block "' // line(istart:istop) // & - '" instead.' - call store_error(ermsg) - call store_error_unit(iuext) - else - backspace(iin) - endif - end if - exit mainloop - else if (line(istart:istop) == 'END') then - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == ctag) then - ermsg = 'Error: Looking for BEGIN ' // trim(ctag) // & - ' but found END ' // line(istart:istop) // & - ' instead.' - call store_error(ermsg) - call store_error_unit(iuext) - endif - end if - end do mainloop - ! - ! -- return - return - end subroutine uget_block - - !> @brief Find the next block in a file - !! - !! Subroutine to read from a file until next block is found. - !! Return isfound with true, if found, and return the block name. - !! - !< - subroutine uget_any_block(iin,iout,isfound,lloc,line,ctagfound,iuext) - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin !< file unit number - integer(I4B), intent(in) :: iout !< output listing file unit - logical, intent(inout) :: isfound !< boolean indicating if a block was found - integer(I4B), intent(inout) :: lloc !< position in line - character (len=:), allocatable, intent(inout) :: line !< line - character(len=*), intent(out) :: ctagfound !< block name - integer(I4B), intent(inout) :: iuext !< external file unit number - ! -- local variables - integer(I4B) :: ierr, istart, istop - integer(I4B) :: ival, lloc2 - real(DP) :: rval - character(len=100) :: ermsg - character (len=:), allocatable :: line2 - character(len=LINELENGTH) :: fname - ! - ! -- code - isfound = .false. - ctagfound = '' - iuext = iin - do - lloc = 1 - call u9rdcom(iin,iout,line,ierr) - if (ierr < 0) exit - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == 'BEGIN') then - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) /= '') then - isfound = .true. - ctagfound = line(istart:istop) - call u9rdcom(iin,iout,line2,ierr) - if (ierr < 0) exit - lloc2 = 1 - call urword(line2,lloc2,istart,istop,1,ival,rval,iout,iin) - if (line2(istart:istop) == 'OPEN/CLOSE') then - iuext = GetUnit() - call urword(line2,lloc2,istart,istop,0,ival,rval,iout,iin) - fname = line2(istart:istop) - call openfile(iuext,iout,fname,'OPEN/CLOSE') - else - backspace(iin) - endif - else - ermsg = 'Block name missing in file.' - call store_error(ermsg) - call store_error_unit(iin) - end if - exit - end if - end do - return - end subroutine uget_any_block - - !> @brief Evaluate if the end of a block has been found - !! - !! Subroutine to evaluate if the end of a block has been found. Abnormal - !! termination if 'begin' is found or if 'end' encountered with - !! incorrect tag. - !! - !< - subroutine uterminate_block(iin,iout,key,ctag,lloc,line,ierr,iuext) - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin !< file unit number - integer(I4B), intent(in) :: iout !< output listing file unit number - character (len=*), intent(in) :: key !< keyword in block - character (len=*), intent(in) :: ctag !< block name - integer(I4B), intent(inout) :: lloc !< position in line - character (len=*), intent(inout) :: line !< line - integer(I4B), intent(inout) :: ierr !< error - integer(I4B), intent(inout) :: iuext !< external file unit number - ! -- local variables - character(len=LENBIGLINE) :: ermsg - integer(I4B) :: istart - integer(I4B) :: istop - integer(I4B) :: ival - real(DP) :: rval - ! -- format -1 format('ERROR. "',A,'" DETECTED WITHOUT "',A,'". ','"END',1X,A, & - '" MUST BE USED TO END ',A,'.') -2 format('ERROR. "',A,'" DETECTED BEFORE "END',1X,A,'". ','"END',1X,A, & - '" MUST BE USED TO END ',A,'.') - ! - ! -- code - ierr = 1 - select case(key) - case ('END') - call urword(line, lloc, istart, istop, 1, ival, rval, iout, iin) - if (line(istart:istop) /= ctag) then - write(ermsg, 1) trim(key), trim(ctag), trim(ctag), trim(ctag) - call store_error(ermsg) - call store_error_unit(iin) - else - ierr = 0 - if (iuext /= iin) then - ! -- close external file - close(iuext) - iuext = iin - endif - end if - case ('BEGIN') - write(ermsg, 2) trim(key), trim(ctag), trim(ctag), trim(ctag) - call store_error(ermsg) - call store_error_unit(iin) - end select - ! - ! -- return - return - end subroutine uterminate_block - !> @brief Convert to upper case !! !! Subroutine to convert a character string to upper case. @@ -2128,9 +1895,8 @@ subroutine u9rdcom(iin, iout, line, ierr) pcomments: do call get_line(iin, line, ierr) if (ierr == IOSTAT_END) then - ! -- End of file reached. - ! -- Backspace is needed for gfortran. - backspace(iin) + ! -- End of file reached. Return with ierr = IOSTAT_END + ! and line as an empty string line = ' ' exit pcomments elseif (ierr /= 0) then diff --git a/src/Utilities/ListReader.f90 b/src/Utilities/ListReader.f90 index fc5150937ac..959b1cdd0e2 100644 --- a/src/Utilities/ListReader.f90 +++ b/src/Utilities/ListReader.f90 @@ -6,6 +6,7 @@ module ListReaderModule LENAUXNAME, LENLISTLABEL, DONE use SimVariablesModule, only: errmsg use SimModule, only: store_error, count_errors, store_error_unit + use LongLineReaderModule, only: LongLineReaderType implicit none private @@ -41,6 +42,7 @@ module ListReaderModule integer(I4B), dimension(:), allocatable :: idxtxtauxcol ! col locations of text in auxvar character(len=LENTIMESERIESNAME), dimension(:), allocatable :: txtrlist ! text found in rlist character(len=LENTIMESERIESNAME), dimension(:), allocatable :: txtauxvar ! text found in auxvar + type(LongLineReaderType), pointer :: line_reader => null() contains procedure :: read_list procedure :: write_list @@ -53,8 +55,9 @@ module ListReaderModule contains - subroutine read_list(this, in, iout, nlist, inamedbound, mshape, nodelist, & - rlist, auxvar, auxname, boundname, label) + subroutine read_list(this, line_reader, in, iout, nlist, inamedbound, & + mshape, nodelist, rlist, auxvar, auxname, boundname, & + label) ! ****************************************************************************** ! init -- Initialize the reader ! ****************************************************************************** @@ -65,6 +68,7 @@ subroutine read_list(this, in, iout, nlist, inamedbound, mshape, nodelist, & use ConstantsModule, only: LENBOUNDNAME ! -- dummy class(ListReaderType) :: this + type(LongLineReaderType), intent(inout), target :: line_reader integer(I4B), intent(in) :: in integer(I4B), intent(in) :: iout integer(I4B), intent(inout) :: nlist @@ -95,6 +99,7 @@ subroutine read_list(this, in, iout, nlist, inamedbound, mshape, nodelist, & this%auxvar => auxvar this%auxname => auxname this%boundname => boundname + this%line_reader => line_reader ! ! -- Allocate arrays for storing text and text locations if (.not. allocated(this%idxtxtrow)) allocate (this%idxtxtrow(0)) @@ -125,7 +130,7 @@ subroutine read_control_record(this) ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: u9rdcom, urword + use InputOutputModule, only: urword ! -- dummy class(ListReaderType) :: this ! -- local @@ -142,7 +147,7 @@ subroutine read_control_record(this) this%ibinary = 0 ! ! -- Read to the first non-commented line - call u9rdcom(this%in, this%iout, this%line, this%ierr) + call this%line_reader%rdcom(this%in, this%iout, this%line, this%ierr) this%lloc = 1 call urword(this%line, this%lloc, this%istart, this%istop, 1, idum, r, & this%iout, this%in) @@ -167,7 +172,7 @@ subroutine set_openclose(this) ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: u9rdcom, urword, openfile + use InputOutputModule, only: urword, openfile use OpenSpecModule, only: form, access use ConstantsModule, only: LINELENGTH ! -- dummy @@ -237,8 +242,9 @@ subroutine set_openclose(this) ! ! -- Read the first line from inlist to be consistent with how the list is ! read when it is included in the package input file - if (this%ibinary /= 1) call u9rdcom(this%inlist, this%iout, this%line, & - this%ierr) + if (this%ibinary /= 1) & + call this%line_reader%rdcom(this%inlist, this%iout, this%line, & + this%ierr) ! ! -- return return @@ -394,7 +400,7 @@ subroutine read_ascii(this) ! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBOUNDNAME, LINELENGTH, DZERO - use InputOutputModule, only: u9rdcom, urword, get_node + use InputOutputModule, only: urword, get_node use ArrayHandlersModule, only: ExpandArray use TdisModule, only: kper ! -- dummy @@ -427,7 +433,8 @@ subroutine read_ascii(this) readloop: do ! ! -- First line was already read, so don't read again - if (ii /= 1) call u9rdcom(this%inlist, 0, this%line, this%ierr) + if (ii /= 1) & + call this%line_reader%rdcom(this%inlist, 0, this%line, this%ierr) ! ! -- If this is an unknown-length list, then check for END. ! If found, then backspace, set nlist, and exit readloop. @@ -436,10 +443,10 @@ subroutine read_ascii(this) call urword(this%line, this%lloc, this%istart, this%istop, 1, idum, r, & this%iout, this%inlist) if (this%line(this%istart:this%istop) == 'END' .or. this%ierr < 0) then - ! If ierr < 0, backspace was already performed in u9rdcom, so only - ! need to backspace if END was found. + ! If END was found then call line_reader backspace + ! emulator so that caller can proceed with reading END. if (this%ierr == 0) then - backspace (this%inlist) + call this%line_reader%bkspc(this%inlist) end if this%nlist = ii - 1 exit readloop diff --git a/src/Utilities/LongLineReader.f90 b/src/Utilities/LongLineReader.f90 new file mode 100644 index 00000000000..bce57afd45d --- /dev/null +++ b/src/Utilities/LongLineReader.f90 @@ -0,0 +1,117 @@ +!> @brief This module contains the LongLineReaderType +!! +!! The LongLineReader is a utility for reading text lines +!! from mf6 input files. It calls u9rdcom (which calls +!! get_line) to read the first non-commented line of an +!! input file. The LongLineReader can emulate the Fortran +!! backspace command by calling the bkspc method, which stores +!! the current line in last_line, and will return last_line +!! upon the next call to rdcom. The LongLineReader was +!! implemented to replace all Fortran backspace calls, due +!! to a bug in ifort and ifx that prevented the backspace +!! command from working properly with non-advancing IO. +!! +!< +module LongLineReaderModule + + use, intrinsic :: iso_fortran_env, only: IOSTAT_END + use KindModule, only: I4B + use SimModule, only: store_error + use InputOutputModule, only: u9rdcom + + implicit none + + private + public :: LongLineReaderType + + !> @brief LongLineReaderType + !! + !! Object for reading input from mf6 input files + !! + !< + type :: LongLineReaderType + + character(len=:), allocatable :: line + character(len=:), allocatable :: last_line + integer(I4B) :: nbackspace = 0 + integer(I4B) :: iostat = 0 + integer(I4B) :: last_unit = 0 + + contains + + procedure :: bkspc + procedure :: rdcom + + end type LongLineReaderType + +contains + + !> @brief Return the first non-comment line + !! + !! Skip through any comments and return the first + !! non-commented line. If an end of file was + !! encountered previously, then return a blank line. + !! If a backspace was called prior to this call, + !! then do not read a new line and return last_line + !! instead. + !! + !< + subroutine rdcom(this, iu, iout, line, ierr) + class(LongLineReaderType) :: this + integer(I4B), intent(in) :: iu + integer(I4B), intent(in) :: iout + character(len=:), intent(inout), allocatable :: line + integer(I4B), intent(inout) :: ierr + + ierr = 0 + + ! If using this reader to read from a new file + ! then reset state + if (iu /= this%last_unit) then + this%nbackspace = 0 + this%iostat = 0 + end if + + if (this%nbackspace == 1) then + ! If backspace was called, then return last line + if (allocated(line)) deallocate (line) + allocate (character(len=len(this%last_line) + 1) :: line) + line(:) = this%last_line(:) + this%nbackspace = 0 + else + ! if end of file was reached previously, then return a + ! blank line and return ierr as IOSTAT_END + if (this%iostat == IOSTAT_END) then + line = ' ' + ierr = IOSTAT_END + else + call u9rdcom(iu, iout, line, ierr) + end if + this%last_line = line + this%iostat = ierr + end if + this%last_unit = iu + return + end subroutine rdcom + + !> @brief Emulate a Fortan backspace + !! + !! Emulate a fortran backspace call by storing + !! the current line in long_line + !! + !< + subroutine bkspc(this, iin) + class(LongLineReaderType) :: this + integer(I4B), intent(in) :: iin + if (this%nbackspace > 0) then + call store_error( & + "Programming error in LongLineReaderType%bkspc(). Backspace & + & called more than once for an open file.", & + terminate=.true.) + else + this%nbackspace = 1 + end if + return + end subroutine bkspc + +end module LongLineReaderModule diff --git a/src/meson.build b/src/meson.build index 5f57e065d7b..eea4e2a0618 100644 --- a/src/meson.build +++ b/src/meson.build @@ -209,6 +209,7 @@ modflow_sources = files( 'Utilities' / 'kind.f90', 'Utilities' / 'List.f90', 'Utilities' / 'ListReader.f90', + 'Utilities' / 'LongLineReader.f90', 'Utilities' / 'Message.f90', 'Utilities' / 'OpenSpec.f90', 'Utilities' / 'PackageBudget.f90', diff --git a/utils/mf5to6/make/makedefaults b/utils/mf5to6/make/makedefaults index fdc2fdb51cb..bcea1425b67 100644 --- a/utils/mf5to6/make/makedefaults +++ b/utils/mf5to6/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.7) for the 'mf5to6' executable. +# makedefaults created by pymake (version 1.2.9.dev0) for the 'mf5to6' executable. # determine OS ifeq ($(OS), Windows_NT) diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index d8eb7e6963d..c455f6d76b0 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.7) for the 'mf5to6' executable. +# makefile created by pymake (version 1.2.9.dev0) for the 'mf5to6' executable. include ./makedefaults @@ -46,6 +46,7 @@ $(OBJDIR)/CharString.o \ $(OBJDIR)/Memory.o \ $(OBJDIR)/List.o \ $(OBJDIR)/MemoryList.o \ +$(OBJDIR)/LongLineReader.o \ $(OBJDIR)/Utilities.o \ $(OBJDIR)/ConstantsPHMF.o \ $(OBJDIR)/MemoryManager.o \ diff --git a/utils/mf5to6/msvs/mf5to6.vfproj b/utils/mf5to6/msvs/mf5to6.vfproj index 0fdd1b971ce..a027537f04b 100644 --- a/utils/mf5to6/msvs/mf5to6.vfproj +++ b/utils/mf5to6/msvs/mf5to6.vfproj @@ -1,28 +1,32 @@ - + + - - - - - - - - - + + + + + + + + + + - - - - - - - - - + + + + + + + + + + + @@ -93,12 +97,16 @@ - + + + + + @@ -190,5 +198,7 @@ - - + + + + diff --git a/utils/mf5to6/pymake/extrafiles.txt b/utils/mf5to6/pymake/extrafiles.txt index 1699e51ed46..89a298d0b93 100644 --- a/utils/mf5to6/pymake/extrafiles.txt +++ b/utils/mf5to6/pymake/extrafiles.txt @@ -13,6 +13,7 @@ ../../../src/Utilities/InputOutput.f90 ../../../src/Utilities/kind.f90 ../../../src/Utilities/List.f90 +../../../src/Utilities/LongLineReader.f90 ../../../src/Utilities/OpenSpec.f90 ../../../src/Utilities/defmacro.F90 ../../../src/Utilities/version.f90 diff --git a/utils/mf5to6/src/Connection.f90 b/utils/mf5to6/src/Connection.f90 index 561d737a049..8c0d8fec34b 100644 --- a/utils/mf5to6/src/Connection.f90 +++ b/utils/mf5to6/src/Connection.f90 @@ -67,13 +67,43 @@ subroutine WriteGhostNodeCorrection(this, iu, numalphaj) ! select case (numalphaj) case (1) + if (this%alphaj1 == 0) then + this%k1 = 0 + this%i1 = 0 + this%j1 = 0 + end if write(iu,10)this%kp, this%ip, this%jp, this%kc, this%ic, this%jc, & this%k1, this%i1, this%j1, this%alphaj1 case (2) + if (this%alphaj1 == 0.) then + this%k1 = 0 + this%i1 = 0 + this%j1 = 0 + end if + if (this%alphaj2 == 0.) then + this%k2 = 0 + this%i2 = 0 + this%j2 = 0 + end if write(iu,20)this%kp, this%ip, this%jp, this%kc, this%ic, this%jc, & this%k1, this%i1, this%j1, this%k2, this%i2, this%j2, & this%alphaj1, this%alphaj2 case (3) + if (this%alphaj1 == 0.) then + this%k1 = 0 + this%i1 = 0 + this%j1 = 0 + end if + if (this%alphaj2 == 0.) then + this%k2 = 0 + this%i2 = 0 + this%j2 = 0 + end if + if (this%alphaj12 == 0.) then + this%k12 = 0 + this%i12 = 0 + this%j12 = 0 + end if write(iu,30)this%kp, this%ip, this%jp, this%kc, this%ic, this%jc, & this%k1, this%i1, this%j1, this%k2, this%i2, this%j2, & this%k12, this%i12, this%j12, this%alphaj1, this%alphaj2, & diff --git a/utils/mf5to6/src/Preproc/ObsBlock.f90 b/utils/mf5to6/src/Preproc/ObsBlock.f90 index 9a16e3bfd50..61f3e5bad78 100644 --- a/utils/mf5to6/src/Preproc/ObsBlock.f90 +++ b/utils/mf5to6/src/Preproc/ObsBlock.f90 @@ -7,7 +7,7 @@ module ObsBlockModule use ConstantsPHMFModule, only: CONTINUOUS, SINGLE, LENOBSNAMENEW use DnmDis3dModule, only: Dis3dType use GlobalVariablesPHMFModule, only: verbose - use InputOutputModule, only: UPCASE, URWORD, uterminate_block + use InputOutputModule, only: UPCASE, URWORD use ListModule, only: ListType use ObserveModule, only: ObserveType, AddObserveToList, & GetObserveFromList, ConstructObservation diff --git a/utils/mf5to6/src/Preproc/Preproc.f90 b/utils/mf5to6/src/Preproc/Preproc.f90 index c320028b428..df58ae136e1 100644 --- a/utils/mf5to6/src/Preproc/Preproc.f90 +++ b/utils/mf5to6/src/Preproc/Preproc.f90 @@ -14,9 +14,7 @@ module PreprocModule use GLOBAL, only: NCOL, NROW, DELC, DELR use globalPHMF, only: ioutPHMF, outfile use GlobalVariablesPHMFModule, only: prognamPHMF, verbose, vnam - use InputOutputModule, only: GetUnit, uget_block, urword, & - uterminate_block, GetUnit, openfile, & - uget_any_block + use InputOutputModule, only: GetUnit, urword, GetUnit, openfile use ListModule, only: ListType use ObsBlockModule, only: ObsBlockType, ConstructObsBlockType, & AddObsBlockToList, GetObsBlockFromList @@ -203,8 +201,6 @@ subroutine read_options(this) ierr = 0 ! ! -- get BEGIN line of OPTIONS block -! call uget_block(iin, 0, blockTypeWanted, ierr, found, & -! lloc, line, iuext, continueread) call this%parser%GetBlock('OPTIONS', found, ierr, supportOpenClose=.true.) if (ierr /= 0) then ! end of file @@ -733,7 +729,6 @@ subroutine read_any_block(this, iu ,k, eof, dis3d, WriteBeginEnd) ! ! -- Read any block as long as it's SINGLE or CONTINUOUS. lloc = 1 -! call uget_any_block(iu, this%iout, isfound, lloc, line, ctagfound, iuext) call this%parser%GetBlock('*', isfound, ierr, .true., & .false., ctagfound) if (.not. isfound) then diff --git a/utils/mf5to6/src/Preproc/Utilities.f90 b/utils/mf5to6/src/Preproc/Utilities.f90 index 3d97b4c0618..13e7ec9c3f4 100644 --- a/utils/mf5to6/src/Preproc/Utilities.f90 +++ b/utils/mf5to6/src/Preproc/Utilities.f90 @@ -3,8 +3,7 @@ module UtilitiesModule use ConstantsModule, only: MAXCHARLEN, DZERO, MAXCHARLEN use GlobalVariablesModule, only: optfile, PathToPostObsMf, ScriptType, & verbose, echo - use InputOutputModule, only: GetUnit, openfile, UPCASE, URWORD, & - uget_block, uterminate_block, u9rdcom + use InputOutputModule, only: GetUnit, openfile, UPCASE, URWORD use SimModule, onlY: store_error, store_note, store_warning, ustop private @@ -15,7 +14,7 @@ module UtilitiesModule BuildArrayFormat, Write1dValues, & Write2dValues, Write3dValues, findcell, & close_file, GreaterOf, GreatestOf, RemoveElement, & - get_extension, ReadMf5to6Options, count_file_records, & + get_extension, count_file_records, & CalcContribFactors, PhmfOption interface RemoveElement @@ -876,65 +875,6 @@ subroutine get_extension(name, ext) return end subroutine get_extension - subroutine ReadMf5to6Options() - implicit none - ! local - integer :: ierr, istart, istop, iu, idum, icol - double precision :: rdum - character(len=MAXCHARLEN) :: ermsg - character(len=:), allocatable :: line - character(len=10) :: stype - logical :: continueread=.true., found - integer :: iuext - ! - if (optfile /= '') then - iu = GetUnit() - call openfile(iu, 0, optfile, 'OPTIONS', filstat_opt='OLD') - call uget_block(iu, 0, 'OPTIONS', ierr, found, icol, line, iuext, & - continueread) - if (found) then - do - icol = 1 - call u9rdcom(iu, 0, line, ierr) - call urword(line, icol, istart, istop, 1, idum, rdum, 0, iu) - select case (line(istart:istop)) - case ('PATHTOPOSTOBSMF') - call urword(line, icol, istart, istop, 0, idum, rdum, 0, iu) - PathToPostObsMf = line(istart:istop) - case ('SCRIPT') - call urword(line, icol, istart, istop, 1, idum, rdum, 0, iu) - stype = line(istart:istop) - select case (stype) - case ('BATCH') - ScriptType = 'BATCH' - case ('PYTHON') - ScriptType = 'PYTHON' - case default - ermsg = 'Unknown Script option: ' // line(istart:istop) - call store_error(ermsg) - call ustop() - end select - case default - ermsg = 'Unknown Mf5to6 option: ' // line(istart:istop) - call store_error(ermsg) - call ustop() - case ('END','BEGIN') - call uterminate_block(iu,0,line(istart:istop), & - 'OPTIONS', icol,line,ierr, iuext) - if(ierr==0) exit - end select - enddo - close(iu) - else - ermsg = 'Mf5to6 options file not found: ' // trim(optfile) - call store_error(ermsg) - call ustop() - endif - endif - ! - return - end subroutine ReadMf5to6Options - function count_file_records(filename) result(nrecs) ! Open a text file, count the number of records in it, and close the file. ! dummy diff --git a/utils/mf5to6/src/mf5to6.f90 b/utils/mf5to6/src/mf5to6.f90 index 1e7b07dc8da..ecf2131c8de 100644 --- a/utils/mf5to6/src/mf5to6.f90 +++ b/utils/mf5to6/src/mf5to6.f90 @@ -19,7 +19,7 @@ program mf5to6 use SimFileWriterModule, only: SimFileWriterType use SimModule, only: ustop use SimListVariablesModule, only: SimMovers - use UtilitiesModule, only: GetArgs, ReadMf5to6Options, PhmfOption + use UtilitiesModule, only: GetArgs, PhmfOption ! implicit none integer :: iexg, igrid, ispw, iu @@ -69,7 +69,6 @@ program mf5to6 ! provide a command-prompt instruction that will run PostObsMF, or maybe ! generate a batch or python file (could also be an option) that would ! run PostObsMF (twice, if there are multilayer head observations). - if (SupportPreproc) call ReadMf5to6Options() SimFileWriter%BaseName = basnam if (ilgr > 0) then ! LGR is active; read and initialize parent and all children. diff --git a/utils/zonebudget/make/makedefaults b/utils/zonebudget/make/makedefaults index 919f5ed9b06..e27dfca39de 100644 --- a/utils/zonebudget/make/makedefaults +++ b/utils/zonebudget/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.7) for the 'zbud6' executable. +# makedefaults created by pymake (version 1.2.9.dev0) for the 'zbud6' executable. # determine OS ifeq ($(OS), Windows_NT) diff --git a/utils/zonebudget/make/makefile b/utils/zonebudget/make/makefile index 092dc3b0294..1918bd8fee2 100644 --- a/utils/zonebudget/make/makefile +++ b/utils/zonebudget/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.7) for the 'zbud6' executable. +# makefile created by pymake (version 1.2.9.dev0) for the 'zbud6' executable. include ./makedefaults @@ -26,6 +26,7 @@ $(OBJDIR)/Message.o \ $(OBJDIR)/Sim.o \ $(OBJDIR)/OpenSpec.o \ $(OBJDIR)/InputOutput.o \ +$(OBJDIR)/LongLineReader.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/BlockParser.o \ $(OBJDIR)/ArrayReaders.o \ diff --git a/utils/zonebudget/msvs/zonebudget.vfproj b/utils/zonebudget/msvs/zonebudget.vfproj index 682849e3f29..919ef4c8552 100644 --- a/utils/zonebudget/msvs/zonebudget.vfproj +++ b/utils/zonebudget/msvs/zonebudget.vfproj @@ -1,28 +1,32 @@ - + + - - - - - - - - - + + + + + + + + + + - - - - - - - - - + + + + + + + + + + + @@ -34,14 +38,15 @@ - + - + + @@ -52,5 +57,7 @@ - - + + + + diff --git a/utils/zonebudget/pymake/extrafiles.txt b/utils/zonebudget/pymake/extrafiles.txt index c4cfdf23967..0848ab0c086 100644 --- a/utils/zonebudget/pymake/extrafiles.txt +++ b/utils/zonebudget/pymake/extrafiles.txt @@ -7,6 +7,7 @@ ../../../src/Utilities/genericutils.f90 ../../../src/Utilities/InputOutput.f90 ../../../src/Utilities/kind.f90 +../../../src/Utilities/LongLineReader.f90 ../../../src/Utilities/OpenSpec.f90 ../../../src/Utilities/sort.f90 ../../../src/Utilities/Message.f90