diff --git a/autotest/TestMessage.f90 b/autotest/TestMessage.f90 new file mode 100644 index 00000000000..b78d490df5b --- /dev/null +++ b/autotest/TestMessage.f90 @@ -0,0 +1,41 @@ +module TestMessage + use testdrive, only: error_type, unittest_type, new_unittest, check + use MessageModule, only: MessagesType + use ConstantsModule, only: LINELENGTH + + implicit none + private + public :: collect_message + +contains + + subroutine collect_message(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("init_and_count", test_init_and_count), & + new_unittest("store_count_and_write_all", & + test_store_count_and_write_all) & + ] + end subroutine collect_message + + subroutine test_init_and_count(error) + type(error_type), allocatable, intent(out) :: error + type(MessagesType) :: messages + messages = MessagesType() + call messages%init() + call check(error, messages%count() == 0) + end subroutine test_init_and_count + + subroutine test_store_count_and_write_all(error) + type(error_type), allocatable, intent(out) :: error + type(MessagesType) :: messages + messages = MessagesType() + call messages%init() + call messages%store("1") + call messages%store("2") + call check(error, messages%count() == 2) + ! debug visually with e.g. `meson test --no-rebuild -C builddir --verbose Message` + call messages%write_all() + end subroutine test_store_count_and_write_all + +end module TestMessage diff --git a/autotest/meson.build b/autotest/meson.build index 9df73ae0a2e..c10ea05b3ab 100644 --- a/autotest/meson.build +++ b/autotest/meson.build @@ -6,6 +6,7 @@ if test_drive.found() and not fc_id.contains('intel') 'GeomUtil', 'InputOutput', 'MathUtil', + 'Message', 'Sim' ] diff --git a/autotest/tester.f90 b/autotest/tester.f90 index 714a88a36d4..4984b8ed3a8 100644 --- a/autotest/tester.f90 +++ b/autotest/tester.f90 @@ -7,6 +7,7 @@ program tester use TestGeomUtil, only: collect_geomutil use TestInputOutput, only: collect_inputoutput use TestMathUtil, only: collect_mathutil + use TestMessage, only: collect_message use TestSim, only: collect_sim implicit none integer :: stat, is @@ -21,6 +22,7 @@ program tester new_testsuite("GeomUtil", collect_geomutil), & new_testsuite("InputOutput", collect_inputoutput), & new_testsuite("MathUtil", collect_mathutil), & + new_testsuite("Message", collect_message), & new_testsuite("Sim", collect_sim) & ] diff --git a/make/makefile b/make/makefile index 3ab9a570ea9..cd2e35d8612 100644 --- a/make/makefile +++ b/make/makefile @@ -76,17 +76,16 @@ ${SOURCEDIR32} OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ -$(OBJDIR)/SimVariables.o \ $(OBJDIR)/ErrorUtil.o \ -$(OBJDIR)/genericutils.o \ +$(OBJDIR)/SimVariables.o \ +$(OBJDIR)/ArrayHandlers.o \ +$(OBJDIR)/Message.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ -$(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/version.o \ -$(OBJDIR)/Message.o \ $(OBJDIR)/Sim.o \ $(OBJDIR)/OpenSpec.o \ -$(OBJDIR)/MathUtil.o \ +$(OBJDIR)/genericutils.o \ $(OBJDIR)/InputOutput.o \ $(OBJDIR)/TableTerm.o \ $(OBJDIR)/Table.o \ @@ -325,6 +324,7 @@ $(OBJDIR)/BaseGeometry.o \ $(OBJDIR)/mf6.o \ $(OBJDIR)/StringList.o \ $(OBJDIR)/MemorySetHandler.o \ +$(OBJDIR)/MathUtil.o \ $(OBJDIR)/ilut.o \ $(OBJDIR)/sparsekit.o \ $(OBJDIR)/rcm.o \ diff --git a/src/Model/GroundWaterFlow/gwf3csub8.f90 b/src/Model/GroundWaterFlow/gwf3csub8.f90 index 28fbb247d79..73029f582db 100644 --- a/src/Model/GroundWaterFlow/gwf3csub8.f90 +++ b/src/Model/GroundWaterFlow/gwf3csub8.f90 @@ -18,7 +18,8 @@ module GwfCsubModule TABLEFT, TABCENTER, TABRIGHT, & TABSTRING, TABUCSTRING, TABINTEGER, TABREAL use MemoryHelperModule, only: create_mem_path - use GenericUtilitiesModule, only: is_same, sim_message + use GenericUtilitiesModule, only: is_same + use MessageModule, only: write_message use SmoothingModule, only: sQuadraticSaturation, & sQuadraticSaturationDerivative, & sQuadratic0sp, & @@ -1924,7 +1925,7 @@ subroutine csub_fp(this) write (msg, '(1x,a,1x,i0,1x,a,1x,i0,1x,a)') & 'LARGEST', (i1 - i0 + 1), 'OF', this%ninterbeds, & 'INTERBED STRAIN VALUES SHOWN' - call sim_message(msg, this%iout, skipbefore=1) + call write_message(msg, this%iout, skipbefore=1) ! ! -- interbed strain data ! -- set title @@ -2114,7 +2115,7 @@ subroutine csub_fp(this) write (msg, '(a,1x,i0,1x,a,1x,i0,1x,a)') & 'LARGEST ', (i1 - i0 + 1), 'OF', this%dis%nodes, & 'CELL COARSE-GRAINED VALUES SHOWN' - call sim_message(msg, this%iout, skipbefore=1) + call write_message(msg, this%iout, skipbefore=1) ! ! -- set title title = trim(adjustl(this%packName))// & diff --git a/src/Model/GroundWaterFlow/gwf3lak8.f90 b/src/Model/GroundWaterFlow/gwf3lak8.f90 index cd5e43a6b46..52ffc9e2916 100644 --- a/src/Model/GroundWaterFlow/gwf3lak8.f90 +++ b/src/Model/GroundWaterFlow/gwf3lak8.f90 @@ -28,7 +28,7 @@ module LakModule use BaseDisModule, only: DisBaseType use SimModule, only: count_errors, store_error, store_error_unit, & deprecation_warning - use GenericUtilitiesModule, only: sim_message, is_same + use GenericUtilitiesModule, only: is_same use BlockParserModule, only: BlockParserType use BaseDisModule, only: DisBaseType use SimVariablesModule, only: errmsg, warnmsg diff --git a/src/Model/GroundWaterFlow/gwf3uzf8.f90 b/src/Model/GroundWaterFlow/gwf3uzf8.f90 index 5a89041cb39..d8b7019fc6a 100644 --- a/src/Model/GroundWaterFlow/gwf3uzf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3uzf8.f90 @@ -10,7 +10,6 @@ module UzfModule DHNOFLO, DHDRY, & TABLEFT, TABCENTER, TABRIGHT, & TABSTRING, TABUCSTRING, TABINTEGER, TABREAL - use GenericUtilitiesModule, only: sim_message use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr, & mem_deallocate use MemoryHelperModule, only: create_mem_path diff --git a/src/Model/ModelUtilities/Connections.f90 b/src/Model/ModelUtilities/Connections.f90 index e6e0ba44cee..43e31abd8ba 100644 --- a/src/Model/ModelUtilities/Connections.f90 +++ b/src/Model/ModelUtilities/Connections.f90 @@ -3,7 +3,7 @@ module ConnectionsModule use ArrayReadersModule, only: ReadArray use KindModule, only: DP, I4B use ConstantsModule, only: LENMODELNAME, LENMEMPATH - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use SimVariablesModule, only: errmsg use BlockParserModule, only: BlockParserType use GeomUtilModule, only: get_node @@ -457,7 +457,7 @@ subroutine read_connectivity_from_block(this, name_model, nodes, nja, iout) m = this%ja(ii) if (n /= this%ja(this%isym(ii))) then write (line, fmtsymerr) aname(2), ii, this%isym(ii) - call sim_message(line) + call write_message(line) call this%parser%StoreErrorUnit() end if end do diff --git a/src/SimulationCreate.f90 b/src/SimulationCreate.f90 index 0c0b22e78e2..8607cdb1967 100644 --- a/src/SimulationCreate.f90 +++ b/src/SimulationCreate.f90 @@ -8,7 +8,6 @@ module SimulationCreateModule use SimVariablesModule, only: iout, simulation_mode, proc_id, & nr_procs, model_names, model_ranks, & model_loc_idx - use GenericUtilitiesModule, only: sim_message, write_centered use SimModule, only: store_error, count_errors, & store_error_filename, MaxErrors use VersionModule, only: write_listfile_header diff --git a/src/Solution/LinearMethods/ims8base.f90 b/src/Solution/LinearMethods/ims8base.f90 index 353c176be8c..72bc98eb32b 100644 --- a/src/Solution/LinearMethods/ims8base.f90 +++ b/src/Solution/LinearMethods/ims8base.f90 @@ -9,7 +9,7 @@ MODULE IMSLinearBaseModule use KindModule, only: DP, I4B use ConstantsModule, only: LINELENGTH, IZERO, & DZERO, DPREC, DEM6, DEM3, DHALF, DONE - use GenericUtilitiesModule, only: sim_message, is_same + use GenericUtilitiesModule, only: is_same use BlockParserModule, only: BlockParserType use IMSReorderingModule, only: ims_odrv use ConvergenceSummaryModule diff --git a/src/Solution/LinearMethods/ims8linear.f90 b/src/Solution/LinearMethods/ims8linear.f90 index 043602fbde5..4838ff1cd88 100644 --- a/src/Solution/LinearMethods/ims8linear.f90 +++ b/src/Solution/LinearMethods/ims8linear.f90 @@ -6,7 +6,6 @@ MODULE IMSLinearModule DEM8, DEM6, DEM5, DEM4, DEM3, DEM2, DEM1, & DHALF, DONE, DTWO, & VDEBUG - use GenericUtilitiesModule, only: sim_message use IMSLinearBaseModule, only: ims_base_cg, ims_base_bcgs, & ims_base_pccrs, ims_base_calc_order, & ims_base_scale, ims_base_pcu, & diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index 6670e416f47..456b58d54bd 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -13,7 +13,8 @@ module NumericalSolutionModule LENMEMPATH use MemoryHelperModule, only: create_mem_path use TableModule, only: TableType, table_cr - use GenericUtilitiesModule, only: is_same, sim_message + use GenericUtilitiesModule, only: is_same + Use MessageModule, only: write_message use VersionModule, only: IDEVELOPMODE use BaseModelModule, only: BaseModelType use BaseExchangeModule, only: BaseExchangeType @@ -3147,7 +3148,7 @@ function sln_package_convergence(this, dpak, cpakout, iend) result(ivalue) if (iend /= 0) then write (errmsg, '(3a)') & 'PACKAGE (', trim(cpakout), ') CAUSED CONVERGENCE FAILURE' - call sim_message(errmsg) + call write_message(errmsg) end if end if diff --git a/src/Timing/tdis.f90 b/src/Timing/tdis.f90 index b1dee473e7a..44bf93a4b97 100644 --- a/src/Timing/tdis.f90 +++ b/src/Timing/tdis.f90 @@ -5,7 +5,7 @@ module TdisModule use KindModule, only: DP, I4B, LGP - use SimVariablesModule, only: iout + use SimVariablesModule, only: iout, isim_level use BlockParserModule, only: BlockParserType use ConstantsModule, only: LINELENGTH, LENDATETIME, VALL ! @@ -113,7 +113,7 @@ subroutine tdis_set_counters() ! -- modules use ConstantsModule, only: DONE, DZERO, MNORMAL, MVALIDATE, DNODATA use SimVariablesModule, only: isim_mode - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use AdaptiveTimeStepModule, only: isAdaptivePeriod, dtstable, & ats_period_message ! -- local @@ -155,8 +155,9 @@ subroutine tdis_set_counters() case (MNORMAL) write (line, fmtspts) cpref, kper, kstp, trim(cend) end select - call sim_message(line, level=VALL) - call sim_message(line, iunit=iout, skipbefore=1, skipafter=1) + if (isim_level >= VALL) & + call write_message(line) + call write_message(line, iunit=iout, skipbefore=1, skipafter=1) ! ! -- Write message if first time step if (kstp == 1) then diff --git a/src/Utilities/Idm/SourceLoad.F90 b/src/Utilities/Idm/SourceLoad.F90 index 236607806c7..f37a912132a 100644 --- a/src/Utilities/Idm/SourceLoad.F90 +++ b/src/Utilities/Idm/SourceLoad.F90 @@ -145,7 +145,7 @@ end subroutine load_modelnam subroutine load_simnam() use SimVariablesModule, only: simfile, iout - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use IdmMf6FileModule, only: input_load type(ModflowInputType) :: mf6_input character(len=LINELENGTH) :: line @@ -159,7 +159,7 @@ subroutine load_simnam() ! -- write name of namfile to stdout write (line, '(2(1x,a))') 'Using Simulation name file:', & trim(adjustl(simfile)) - call sim_message(line, skipafter=1) + call write_message(line, skipafter=1) ! ! -- create description of input mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', simfile) diff --git a/src/Utilities/InputOutput.f90 b/src/Utilities/InputOutput.f90 index 8c6296d7bc5..7253b996f3e 100644 --- a/src/Utilities/InputOutput.f90 +++ b/src/Utilities/InputOutput.f90 @@ -11,7 +11,8 @@ module InputOutputModule TABLEFT, TABCENTER, TABRIGHT, & TABSTRING, TABUCSTRING, TABINTEGER, TABREAL, & DZERO - use GenericUtilitiesModule, only: is_same, sim_message + use GenericUtilitiesModule, only: is_same + use MessageModule, only: write_message private public :: GetUnit, & UPCASE, URWORD, ULSTLB, UBDSV4, & @@ -567,8 +568,8 @@ SUBROUTINE URWORD(LINE,ICOL,ISTART,ISTOP,NCODE,N,R,IOUT,IN) ELSE WRITE(msg_line,202) LINE(ISTART:ISTOP),STRING(1:L) END IF - call sim_message(msg_line, iunit=IOUT, skipbefore=1) - call sim_message(LINE, iunit=IOUT, fmt='(1x,a)') + call write_message(msg_line, iunit=IOUT, skipbefore=1) + call write_message(LINE, iunit=IOUT, fmt='(1x,a)') 201 FORMAT(1X,'FILE UNIT ',I4,' : ERROR CONVERTING "',A, & '" TO ',A,' IN LINE:') 202 FORMAT(1X,'KEYBOARD INPUT : ERROR CONVERTING "',A, & @@ -581,8 +582,8 @@ SUBROUTINE URWORD(LINE,ICOL,ISTART,ISTOP,NCODE,N,R,IOUT,IN) ELSE WRITE(msg_line,202) LINE(ISTART:ISTOP),STRING(1:L) END IF - call sim_message(msg_line, iunit=IOUT, skipbefore=1) - call sim_message(LINE, iunit=IOUT, fmt='(1x,a)') + call write_message(msg_line, iunit=IOUT, skipbefore=1) + call write_message(LINE, iunit=IOUT, fmt='(1x,a)') END IF ! ! -- STOP after storing error message. @@ -1179,9 +1180,9 @@ subroutine unitinquire(iu) ! ! -- write the results of the inquire statement write(line,fmta) iu, trim(fname), trim(ac), trim(act) - call sim_message(line) + call write_message(line) write(line,fmtb) trim(fm), trim(seq), trim(unf), trim(frm) - call sim_message(line) + call write_message(line) ! ! -- return return diff --git a/src/Utilities/Message.f90 b/src/Utilities/Message.f90 index c4f40740dcb..1e97db078fb 100644 --- a/src/Utilities/Message.f90 +++ b/src/Utilities/Message.f90 @@ -1,266 +1,481 @@ -!> @brief This module contains message methods -!! -!! This module contains generic message methods that are used to -!! create warning and error messages and notes. This module also has methods -!! for counting messages. The module does not have any dependencies on -!! models, exchanges, or solutions in a simulation. -!! -!< +!> @brief Store and issue logging messages to output units. module MessageModule use KindModule, only: LGP, I4B, DP use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DONE, & - VSUMMARY - use GenericUtilitiesModule, only: sim_message, write_message - use SimVariablesModule, only: istdout + VSUMMARY, LENHUGELINE use ArrayHandlersModule, only: ExpandArray + use SimVariablesModule, only: istdout implicit none + public :: MessagesType + public :: write_message + public :: write_message_counter + public :: write_message_centered - public :: MessageType - - type :: MessageType - - character(len=LINELENGTH) :: title !< title of the message - character(len=LINELENGTH) :: name !< message name - integer(I4B) :: nmessage = 0 !< number of messages stored - integer(I4B) :: max_message = 1000 !< default maximum number of messages that can be stored - integer(I4B) :: max_exceeded = 0 !< flag indicating if the maximum number of messages has exceed the maximum number - integer(I4B) :: inc_message = 100 !< amount to increment message array by when calling ExpandArray - character(len=MAXCHARLEN), allocatable, dimension(:) :: message !< message array - + !> @brief Container for related messages. + !! + !! A maximum capacity can be configured. Message storage + !! is dynamically resized up to the configured capacity. + !< + type :: MessagesType + integer(I4B) :: num_messages = 0 !< number of messages currently stored + integer(I4B) :: max_messages = 1000 !< default max message storage capacity + integer(I4B) :: max_exceeded = 0 !< number of messages in excess of maximum + integer(I4B) :: exp_messages = 100 !< number of slots to expand message array + character(len=MAXCHARLEN), allocatable, dimension(:) :: messages !< message array contains - - procedure :: init_message - procedure :: count_message - procedure :: set_max_message - procedure :: store_message - procedure :: print_message - procedure :: deallocate_message - - end type MessageType + procedure :: init + procedure :: count + procedure :: set_max + procedure :: store + procedure :: write_all + procedure :: deallocate + end type MessagesType contains - !> @brief Always initialize the message object - !! - !! Subroutine that initializes the message object. Allocation of message - !! array occurs on-the-fly. - !! - !< - subroutine init_message(this) - ! -- dummy variables - class(MessageType) :: this !< MessageType object - ! - ! -- initialize message variables - this%nmessage = 0 - this%max_message = 1000 + !> @brief Initialize message storage. + subroutine init(this) + class(MessagesType) :: this !< MessageType object + + this%num_messages = 0 + this%max_messages = 1000 this%max_exceeded = 0 - this%inc_message = 100 - ! - ! -- return - return - end subroutine init_message - - !> @brief Return number of messages - !! - !! Function to return the number of messages that have been stored. - !! - !! @return ncount number of messages stored - !! - !< - function count_message(this) result(nmessage) - ! -- dummy variables - class(MessageType) :: this !< MessageType object - ! -- return variable + this%exp_messages = 100 + end subroutine init + + !> @brief Return the number of messages currently stored. + function count(this) result(nmessage) + class(MessagesType) :: this !< MessageType object integer(I4B) :: nmessage - ! - ! -- set nmessage - if (allocated(this%message)) then - nmessage = this%nmessage + + if (allocated(this%messages)) then + nmessage = this%num_messages else nmessage = 0 end if - ! - ! -- return - return - end function count_message - - !> @brief Set the maximum number of messages stored - !! - !! Subroutine to set the maximum number of messages that will be stored - !! in a simulation. - !! - !< - subroutine set_max_message(this, imax) - ! -- dummy variables - class(MessageType) :: this !< MessageType object + end function count + + !> @brief Set the maximum number of messages. + subroutine set_max(this, imax) + class(MessagesType) :: this !< MessageType object integer(I4B), intent(in) :: imax !< maximum number of messages that will be stored - ! - ! -- set max_message - this%max_message = imax - ! - ! -- return - return - end subroutine set_max_message - - !> @brief Store message - !! - !! Subroutine to store a message for printing at the end of - !! the simulation. - !! + + this%max_messages = imax + end subroutine set_max + + !> @brief Add a message to storage. + !! + !! An optional string may be provided to filter out duplicate messages. + !! If any stored messages contain the string the message is not stored. !< - subroutine store_message(this, msg, substring) + subroutine store(this, msg, substring) ! -- dummy variables - class(MessageType) :: this !< MessageType object + class(MessagesType) :: this !< MessageType object character(len=*), intent(in) :: msg !< message - character(len=*), intent(in), optional :: substring !< optional string that can be used - !! to prevent storing duplicate messages + character(len=*), intent(in), optional :: substring !< duplicate pattern ! -- local variables logical(LGP) :: inc_array - logical(LGP) :: increment_message - integer(I4B) :: i - integer(I4B) :: idx - ! - ! -- determine if messages should be expanded - inc_array = .TRUE. - if (allocated(this%message)) then - i = this%nmessage - if (i < size(this%message)) then - inc_array = .FALSE. + integer(I4B) :: i, n + + ! -- resize message array if needed + inc_array = .true. + if (allocated(this%messages)) then + if (this%num_messages < size(this%messages)) then + inc_array = .false. end if end if - ! - ! -- resize message if (inc_array) then - call ExpandArray(this%message, increment=this%inc_message) - this%inc_message = int(this%inc_message * 1.1) + call ExpandArray(this%messages, increment=this%exp_messages) + this%exp_messages = int(this%exp_messages * 1.1) end if - ! - ! -- Determine if the substring exists in the passed message. - ! If substring is in passed message, do not add the duplicate - ! passed message. - increment_message = .TRUE. + + ! -- don't store duplicate messages if (present(substring)) then - do i = 1, this%nmessage - idx = index(this%message(i), substring) - if (idx > 0) then - increment_message = .FALSE. - exit - end if + do i = 1, this%num_messages + if (index(this%messages(i), substring) > 0) return end do end if - ! - ! -- store this message and calculate nmessage - if (increment_message) then - i = this%nmessage + 1 - if (i <= this%max_message) then - this%nmessage = i - this%message(i) = msg - else - this%max_exceeded = this%max_exceeded + 1 - end if + + ! -- store message and update count unless + ! at capacity, then update excess count + n = this%num_messages + 1 + if (n <= this%max_messages) then + this%num_messages = n + this%messages(n) = msg + else + this%max_exceeded = this%max_exceeded + 1 end if - ! - ! -- return - return - end subroutine store_message - - !> @brief Print messages - !! - !! Subroutine to print stored messages. - !! + end subroutine store + + !> @brief Write all stored messages to standard output. + !! + !! An optional title to precede the messages may be provided. + !! The title is printed on a separate line. An arbitrary kind + !! may be specified, e.g. 'note', 'warning' or 'error. A file + !! unit can also be specified to write in addition to stdout. !< - subroutine print_message(this, title, name, iunit, level) + subroutine write_all(this, title, kind, iunit) ! -- dummy variables - class(MessageType) :: this !< MessageType object - character(len=*), intent(in) :: title !< message title - character(len=*), intent(in) :: name !< message name - integer(I4B), intent(in), optional :: iunit !< optional file unit to save messages to - integer(I4B), intent(in), optional :: level !< optional level of messages to print + class(MessagesType) :: this !< MessageType object + character(len=*), intent(in), optional :: title !< message title + character(len=*), intent(in), optional :: kind !< message kind + integer(I4B), intent(in), optional :: iunit !< file unit ! -- local + character(len=LINELENGTH) :: ltitle + character(len=LINELENGTH) :: lkind character(len=LINELENGTH) :: errmsg character(len=LINELENGTH) :: cerr integer(I4B) :: iu - integer(I4B) :: ilevel integer(I4B) :: i integer(I4B) :: isize integer(I4B) :: iwidth ! -- formats character(len=*), parameter :: stdfmt = "(/,A,/)" - ! + ! -- process optional variables + if (present(title)) then + ltitle = title + else + ltitle = '' + end if + if (present(kind)) then + lkind = kind + else + lkind = '' + end if if (present(iunit)) then iu = iunit else iu = 0 end if - if (present(level)) then - ilevel = level - else - ilevel = VSUMMARY - end if - ! - ! -- write the title and all message entries - if (allocated(this%message)) then - isize = this%nmessage + + ! -- write messages, if any + if (allocated(this%messages)) then + isize = this%num_messages if (isize > 0) then - ! ! -- calculate the maximum width of the prepended string ! for the counter write (cerr, '(i0)') isize iwidth = len_trim(cerr) + 1 - ! + ! -- write title for message - if (iu > 0) then - call sim_message(title, iunit=iu, fmt=stdfmt, level=ilevel) + if (trim(ltitle) /= '') then + if (iu > 0) & + call write_message(iunit=iu, text=ltitle, fmt=stdfmt) + call write_message(text=ltitle, fmt=stdfmt) end if - call sim_message(title, fmt=stdfmt, level=ilevel) - ! + ! -- write each message do i = 1, isize - call write_message(this%message(i), icount=i, iwidth=iwidth, & - level=ilevel) - if (iu > 0) then - call write_message(this%message(i), icount=i, iwidth=iwidth, & - iunit=iu, level=ilevel) - end if + if (iu > 0) & + call write_message_counter( & + iunit=iu, & + text=this%messages(i), & + icount=i, & + iwidth=iwidth) + call write_message_counter( & + text=this%messages(i), & + icount=i, & + iwidth=iwidth) end do - ! + ! -- write the number of additional messages if (this%max_exceeded > 0) then write (errmsg, '(i0,3(1x,a))') & - this%max_exceeded, 'additional', trim(name), & + this%max_exceeded, 'additional', trim(kind), & 'detected but not printed.' - call sim_message(trim(errmsg), fmt='(/,1x,a)', level=ilevel) - if (iu > 0) then - call sim_message(trim(errmsg), iunit=iu, fmt='(/,1x,a)', & - level=ilevel) - end if + if (iu > 0) & + call write_message(iunit=iu, text=trim(errmsg), fmt='(/,1x,a)') + call write_message(text=trim(errmsg), fmt='(/,1x,a)') end if end if end if - ! - ! -- return - return - end subroutine print_message + end subroutine write_all + + !> @ brief Deallocate message storage. + subroutine deallocate (this) + class(MessagesType) :: this + if (allocated(this%messages)) deallocate (this%messages) + end subroutine deallocate - !> @ brief Deallocate message + !> @brief Write a message to an output unit. !! - !! Subroutine that deallocate the array of strings if it was allocated + !! Use `advance` to toggle advancing output. Use `skipbefore/after` to + !! configure the number of whitespace lines before/after the message. + !< + subroutine write_message(text, iunit, fmt, & + skipbefore, skipafter, advance) + ! -- dummy + character(len=*), intent(in) :: text !< message to write + integer(I4B), intent(in), optional :: iunit !< output unit to write the message to + character(len=*), intent(in), optional :: fmt !< format to write the message (default='(a)') + integer(I4B), intent(in), optional :: skipbefore !< number of empty lines before message (default=0) + integer(I4B), intent(in), optional :: skipafter !< number of empty lines after message (default=0) + logical(LGP), intent(in), optional :: advance !< whether to use advancing output (default is .true.) + ! -- local + character(len=3) :: cadvance + integer(I4B) :: i + integer(I4B) :: ilen + integer(I4B) :: iu + character(len=LENHUGELINE) :: simfmt + character(len=*), parameter :: stdfmt = '(a)' + character(len=*), parameter :: emptyfmt = '()' + + if (present(iunit)) then + iu = iunit + else + iu = istdout + end if + + ! -- get message length + ilen = len_trim(text) + + ! -- process optional arguments + if (present(fmt)) then + simfmt = fmt + else + if (ilen > 0) then + simfmt = stdfmt + else + simfmt = emptyfmt + end if + end if + if (present(advance)) then + if (advance) then + cadvance = 'YES' + else + cadvance = 'NO' + end if + else + cadvance = 'YES' + end if + + ! -- write empty line before message, if enabled + if (present(skipbefore)) then + do i = 1, skipbefore + write (iu, *) + end do + end if + + ! -- write message if it isn't empty + if (ilen > 0) then + write (iu, trim(simfmt), advance=cadvance) text(1:ilen) + else + write (iu, trim(simfmt), advance=cadvance) + end if + + ! -- write empty line after message, if enabled + if (present(skipafter)) then + do i = 1, skipafter + write (iu, *) + end do + end if + end subroutine write_message + + !> @brief Write a message with configurable indentation and numbering. !! + !! The message may exceed 78 characters in length. Messages longer than + !! 78 characters are written across multiple lines. After icount lines, + !! subsequent lines are indented and numbered. Use skipbefore/after to + !! configure the number of empty lines before/after the message. !< - subroutine deallocate_message(this) - ! -- dummy variables - class(MessageType) :: this !< MessageType object - ! - ! -- deallocate the message - if (allocated(this%message)) then - deallocate (this%message) + subroutine write_message_counter(text, iunit, icount, iwidth, & + skipbefore, skipafter) + ! -- dummy + character(len=*), intent(in) :: text !< message to be written + integer(I4B), intent(in), optional :: iunit !< the unit number to which the message is written + integer(I4B), intent(in), optional :: icount !< counter to prepended to the message + integer(I4B), intent(in), optional :: iwidth !< maximum width of the prepended counter + integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0) + integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0) + ! -- local + integer(I4B), parameter :: len_line = 78 + character(len=LENHUGELINE) :: amessage + character(len=len_line) :: line + character(len=16) :: cfmt + character(len=10) :: counter + character(len=5) :: fmt_first + character(len=20) :: fmt_cont + logical(LGP) :: include_counter + integer(I4B) :: isb + integer(I4B) :: isa + integer(I4B) :: jend + integer(I4B) :: len_str1 + integer(I4B) :: len_str2 + integer(I4B) :: len_message + integer(I4B) :: i + integer(I4B) :: j + integer(I4B) :: iu + + if (present(iunit)) then + iu = iunit + else + iu = istdout + end if + + ! -- abort if message is empty + if (len_trim(text) < 1) return + + ! -- initialize local variables + amessage = text + counter = '' + fmt_first = '(A)' + fmt_cont = '(A)' + len_str1 = 0 + len_str2 = len_line + include_counter = .false. + j = 0 + + ! -- process optional arguments + if (present(skipbefore)) then + isb = skipbefore + else + isb = 0 + end if + if (present(skipafter)) then + isa = skipafter + else + isa = 0 + end if + + ! -- create the counter to prepend to the start of the message, + ! formats, and variables used to create strings + if (present(iwidth) .and. present(icount)) then + include_counter = .true. + + ! -- write counter + write (cfmt, '(A,I0,A)') '(1x,i', iwidth, ',".",1x)' + write (counter, cfmt) icount + + ! -- calculate the length of the first and second string on a line + len_str1 = len(trim(counter)) + 1 + len_str2 = len_line - len_str1 + + ! -- write format for the continuation lines + write (fmt_cont, '(a,i0,a)') & + '(', len(trim(counter)) + 1, 'x,a)' + end if + + ! -- calculate the length of the message + len_message = len_trim(amessage) + + ! -- parse the message into multiple lines +5 continue + jend = j + len_str2 + if (jend >= len_message) go to 100 + do i = jend, j + 1, -1 + if (amessage(i:i) .eq. ' ') then + if (j == 0) then + if (include_counter) then + line = counter(1:len_str1)//amessage(j + 1:i) + else + line = amessage(j + 1:i) + end if + call write_message(text=line, iunit=iu, & + fmt=fmt_first, & + skipbefore=isb) + else + line = adjustl(amessage(j + 1:i)) + call write_message(text=line, iunit=iu, & + fmt=fmt_cont) + end if + j = i + go to 5 + end if + end do + if (j == 0) then + if (include_counter) then + line = counter(1:len_str1)//amessage(j + 1:jend) + else + line = amessage(j + 1:jend) + end if + call write_message(text=line, iunit=iu, & + fmt=fmt_first, & + skipbefore=isb) + else + line = amessage(j + 1:jend) + call write_message(text=line, iunit=iu, & + fmt=fmt_cont) + end if + j = jend + go to 5 + + ! -- last piece of amessage to write to a line +100 continue + jend = len_message + if (j == 0) then + if (include_counter) then + line = counter(1:len_str1)//amessage(j + 1:jend) + else + line = amessage(j + 1:jend) + end if + call write_message(text=line, iunit=iu, & + fmt=fmt_first, & + skipbefore=isb, skipafter=isa) + else + line = amessage(j + 1:jend) + call write_message(text=line, iunit=iu, fmt=fmt_cont, & + skipafter=isa) end if - ! - ! -- return - return - end subroutine deallocate_message + end subroutine write_message_counter + + !> @brief Write horizontally centered text, left-padding as needed. + subroutine write_message_centered(text, linelen, iunit) + ! -- dummy + character(len=*), intent(in) :: text !< message to write to iunit + integer(I4B), intent(in) :: linelen !< length of line to center text in + integer(I4B), intent(in), optional :: iunit !< output unit to write text + ! -- local + character(len=linelen) :: line + character(len=linelen) :: blank + integer(I4B) :: iu + integer(I4B) :: len_message + integer(I4B) :: jend + integer(I4B) :: ipad + integer(I4B) :: i + integer(I4B) :: j + + if (present(iunit)) then + iu = iunit + else + iu = istdout + end if + + ! -- initialize local variables + blank = '' + len_message = len_trim(adjustl(text)) + j = 0 + + ! -- parse the amessage into multiple lines + outer: do while (.true.) + jend = j + linelen + + ! last line + if (jend >= len_message) then + jend = len_message + line = text(j + 1:jend) + ipad = ((linelen - len_trim(line)) / 2) + call write_message(text=blank(1:ipad)//line, iunit=iunit) + exit outer + end if + + do i = jend, j + 1, -1 + if (text(i:i) .eq. ' ') then + line = text(j + 1:i) + ipad = ((linelen - len_trim(line)) / 2) + call write_message(text=blank(1:ipad)//line, iunit=iunit) + j = i + cycle outer + end if + end do + + line = text(j + 1:jend) + ipad = ((linelen - len_trim(line)) / 2) + call write_message(text=blank(1:ipad)//line, iunit=iunit) + j = jend + end do outer + end subroutine write_message_centered end module MessageModule diff --git a/src/Utilities/Sim.f90 b/src/Utilities/Sim.f90 index 3535296d972..14d5a0103fa 100644 --- a/src/Utilities/Sim.f90 +++ b/src/Utilities/Sim.f90 @@ -20,8 +20,7 @@ module SimModule use SimVariablesModule, only: istdout, iout, isim_level, ireturnerr, & iforcestop, iunext, & warnmsg - use GenericUtilitiesModule, only: sim_message - use MessageModule, only: MessageType + use MessageModule, only: MessagesType, write_message implicit none @@ -42,89 +41,52 @@ module SimModule public :: store_error_filename public :: MaxErrors - type(MessageType) :: sim_errors - type(MessageType) :: sim_uniterrors - type(MessageType) :: sim_warnings - type(MessageType) :: sim_notes + type(MessagesType) :: sim_errors + type(MessagesType) :: sim_uniterrors + type(MessagesType) :: sim_warnings + type(MessagesType) :: sim_notes contains !> @brief Return number of errors - !! - !! Function to return the number of errors messages that have been stored. - !! - !! @return ncount number of error messages stored - !! + !! + !! Function to return the number of errors messages that have been stored. + !! + !! @return ncount number of error messages stored + !! !< function count_errors() result(ncount) - ! -- return variable integer(I4B) :: ncount - ! - ! -- set ncount - ncount = sim_errors%count_message() - ! - ! -- return - return + ncount = sim_errors%count() end function count_errors !> @brief Return number of warnings - !! - !! Function to return the number of warning messages that have been stored. - !! - !! @return ncount number of warning messages stored - !! + !! + !! Function to return the number of warning messages that have been stored. + !! + !! @return ncount number of warning messages stored + !! !< function count_warnings() result(ncount) - ! -- return variable integer(I4B) :: ncount - ! - ! -- set ncount - ncount = sim_warnings%count_message() - ! - ! -- return - return + ncount = sim_warnings%count() end function count_warnings - !> @brief Return number of notes - !! - !! Function to return the number of notes that have been stored. - !! - !! @return ncount number of notes stored - !! + !> @brief Return the number of notes stored. !< function count_notes() result(ncount) - ! -- return variable integer(I4B) :: ncount - ! - ! -- set ncount - ncount = sim_notes%count_message() - ! - ! -- return - return + ncount = sim_notes%count() end function count_notes - !> @brief Set the maximum number of errors stored - !! - !! Subroutine to set the maximum number of error messages that will be stored - !! in a simulation. - !! + !> @brief Set the maximum number of errors to be stored. !< subroutine MaxErrors(imax) - ! -- dummy variables integer(I4B), intent(in) :: imax !< maximum number of error messages that will be stored - ! - ! -- set the maximum number of error messages that will be saved - call sim_errors%set_max_message(imax) - ! - ! -- return - return + call sim_errors%set_max(imax) end subroutine MaxErrors - !> @brief Store error message - !! - !! Subroutine to store a error message for printing at the end of - !! the simulation. - !! + !> @brief Store an error message. !< subroutine store_error(msg, terminate) ! -- dummy variable @@ -141,24 +103,22 @@ subroutine store_error(msg, terminate) end if ! ! -- store error - call sim_errors%store_message(msg) + call sim_errors%store(msg) ! ! -- terminate the simulation if (lterminate) then call ustop() end if - ! - ! -- return - return + end subroutine store_error !> @brief Get the file name - !! - !! Subroutine to get the file name from the unit number for a open file. - !! If the INQUIRE function returns the full path (for example, the INTEL - !! compiler) then the returned file name (fname) is limited to the filename - !! without the path. - !! + !! + !! Subroutine to get the file name from the unit number for a open file. + !! If the INQUIRE function returns the full path (for example, the INTEL + !! compiler) then the returned file name (fname) is limited to the filename + !! without the path. + !! !< subroutine get_filename(iunit, fname) ! -- dummy variables @@ -194,17 +154,15 @@ subroutine get_filename(iunit, fname) ilen = len_trim(fname) write (fname, '(a)') fname(ipos + 1:ilen)//' ' end if - ! - ! -- return - return + end subroutine get_filename !> @brief Store the file unit number - !! - !! Subroutine to convert the unit number for a open file to a file name - !! and indicate that there is an error reading from the file. By default, - !! the simulation is terminated when this subroutine is called. - !! + !! + !! Subroutine to convert the unit number for a open file to a file name + !! and indicate that there is an error reading from the file. By default, + !! the simulation is terminated when this subroutine is called. + !! !< subroutine store_error_unit(iunit, terminate) ! -- dummy variables @@ -226,22 +184,20 @@ subroutine store_error_unit(iunit, terminate) inquire (unit=iunit, name=fname) write (errmsg, '(3a)') & "Error occurred while reading file '", trim(adjustl(fname)), "'" - call sim_uniterrors%store_message(errmsg) + call sim_uniterrors%store(errmsg) ! ! -- terminate the simulation if (lterminate) then call ustop() end if - ! - ! -- return - return + end subroutine store_error_unit !> @brief Store the erroring file name - !! - !! Subroutine to store the file name issuing an error. By default, - !! the simulation is terminated when this subroutine is called - !! + !! + !! Subroutine to store the file name issuing an error. By default, + !! the simulation is terminated when this subroutine is called + !! !< subroutine store_error_filename(filename, terminate) ! -- dummy variables @@ -261,22 +217,20 @@ subroutine store_error_filename(filename, terminate) ! -- store error unit write (errmsg, '(3a)') & "ERROR OCCURRED WHILE READING FILE '", trim(adjustl(filename)), "'" - call sim_uniterrors%store_message(errmsg) + call sim_uniterrors%store(errmsg) ! ! -- terminate the simulation if (lterminate) then call ustop() end if - ! - ! -- return - return + end subroutine store_error_filename !> @brief Store warning message - !! - !! Subroutine to store a warning message for printing at the end of - !! the simulation. - !! + !! + !! Subroutine to store a warning message for printing at the end of + !! the simulation. + !! !< subroutine store_warning(msg, substring) ! -- dummy variables @@ -286,9 +240,9 @@ subroutine store_warning(msg, substring) ! ! -- store warning if (present(substring)) then - call sim_warnings%store_message(msg, substring) + call sim_warnings%store(msg, substring) else - call sim_warnings%store_message(msg) + call sim_warnings%store(msg) end if ! ! -- return @@ -296,10 +250,10 @@ subroutine store_warning(msg, substring) end subroutine store_warning !> @brief Store deprecation warning message - !! - !! Subroutine to store a warning message for deprecated variables - !! and printing at the end of simulation. - !! + !! + !! Subroutine to store a warning message for deprecated variables + !! and printing at the end of simulation. + !! !< subroutine deprecation_warning(cblock, cvar, cver, endmsg, iunit) ! -- modules @@ -331,16 +285,14 @@ subroutine deprecation_warning(cblock, cvar, cver, endmsg, iunit) end if ! ! -- store warning - call sim_warnings%store_message(message) - ! - ! -- return - return + call sim_warnings%store(message) + end subroutine deprecation_warning !> @brief Store note - !! - !! Subroutine to store a note for printing at the end of the simulation. - !! + !! + !! Subroutine to store a note for printing at the end of the simulation. + !! !< subroutine store_note(note) ! -- modules @@ -349,17 +301,15 @@ subroutine store_note(note) character(len=*), intent(in) :: note !< note ! ! -- store note - call sim_notes%store_message(note) - ! - ! -- return - return + call sim_notes%store(note) + end subroutine store_note !> @brief Stop the simulation. - !! - !! Subroutine to stop the simulations with option to print message - !! before stopping with the active error code. - !! + !! + !! Subroutine to stop the simulations with option to print message + !! before stopping with the active error code. + !! !< subroutine ustop(stopmess, ioutlocal) ! -- dummy variables @@ -377,10 +327,10 @@ subroutine ustop(stopmess, ioutlocal) end subroutine ustop !> @brief Print the final messages - !! - !! Subroutine to print the notes, warnings, errors and the final message (if passed). - !! The subroutine also closes all open files. - !! + !! + !! Subroutine to print the notes, warnings, errors and the final message (if passed). + !! The subroutine also closes all open files. + !! !< subroutine print_final_message(stopmess, ioutlocal) ! -- dummy variables @@ -393,19 +343,21 @@ subroutine print_final_message(stopmess, ioutlocal) character(len=*), parameter :: msg = 'Stopping due to error(s)' ! ! -- print the accumulated messages - call sim_notes%print_message('NOTES:', 'note(s)', & - iunit=iout, level=VALL) - call sim_warnings%print_message('WARNING REPORT:', 'warning(s)', & - iunit=iout, level=VALL) - call sim_errors%print_message('ERROR REPORT:', 'error(s)', iunit=iout) - call sim_uniterrors%print_message('UNIT ERROR REPORT:', & - 'file unit error(s)', iunit=iout) + if (isim_level >= VALL) then + call sim_notes%write_all('NOTES:', 'note(s)', & + iunit=iout) + call sim_warnings%write_all('WARNING REPORT:', 'warning(s)', & + iunit=iout) + end if + call sim_errors%write_all('ERROR REPORT:', 'error(s)', iunit=iout) + call sim_uniterrors%write_all('UNIT ERROR REPORT:', & + 'file unit error(s)', iunit=iout) ! ! -- write a stop message, if one is passed if (present(stopmess)) then if (stopmess .ne. ' ') then - call sim_message(stopmess, fmt=fmt, iunit=iout) - call sim_message(stopmess, fmt=fmt) + call write_message(stopmess, fmt=fmt, iunit=iout) + call write_message(stopmess, fmt=fmt) if (present(ioutlocal)) then if (ioutlocal > 0 .and. ioutlocal /= iout) then write (ioutlocal, fmt) trim(stopmess) @@ -419,7 +371,7 @@ subroutine print_final_message(stopmess, ioutlocal) flush (istdout) ! ! -- determine if an error condition has occurred - if (sim_errors%count_message() > 0) then + if (sim_errors%count() > 0) then ireturnerr = 2 if (present(ioutlocal)) then if (ioutlocal > 0 .and. ioutlocal /= iout) write (ioutlocal, fmt) msg @@ -428,34 +380,26 @@ subroutine print_final_message(stopmess, ioutlocal) ! ! -- close all open files call sim_closefiles() - ! - ! -- return - return + end subroutine print_final_message !> @brief Reset the simulation convergence flag - !! - !! Subroutine to reset the simulation convergence flag. - !! + !! + !! Subroutine to reset the simulation convergence flag. + !! !< subroutine converge_reset() - ! -- modules use SimVariablesModule, only: isimcnvg - ! - ! -- reset simulation convergence flag isimcnvg = 1 - ! - ! -- return - return end subroutine converge_reset !> @brief Simulation convergence check - !! - !! Subroutine to check simulation convergence. If the continue option is - !! set the simulation convergence flag is set to True if the simulation - !! did not actually converge for a time step and the non-convergence counter - !! is incremented. - !! + !! + !! Subroutine to check simulation convergence. If the continue option is + !! set the simulation convergence flag is set to True if the simulation + !! did not actually converge for a time step and the non-convergence counter + !! is incremented. + !! !< subroutine converge_check(hasConverged) ! -- modules @@ -485,19 +429,17 @@ subroutine converge_check(hasConverged) ! ! -- save simulation failure message if (isimcnvg == 0) then - call sim_message('', fmt=fmtfail, iunit=iout) + call write_message('', fmt=fmtfail, iunit=iout) hasConverged = .false. end if - ! - ! -- return - return + end subroutine converge_check !> @brief Print the header and initializes messaging - !! - !! Subroutine that prints the initial message and initializes the notes, - !! warning messages, unit errors, and error messages. - !! + !! + !! Subroutine that prints the initial message and initializes the notes, + !! warning messages, unit errors, and error messages. + !! !< subroutine initial_message() ! -- modules @@ -505,27 +447,27 @@ subroutine initial_message() use SimVariablesModule, only: simulation_mode ! ! -- initialize message lists - call sim_errors%init_message() - call sim_uniterrors%init_message() - call sim_warnings%init_message() - call sim_notes%init_message() + call sim_errors%init() + call sim_uniterrors%init() + call sim_warnings%init() + call sim_notes%init() ! ! -- Write banner to screen (unit stdout) call write_listfile_header(istdout, write_kind_info=.false., & write_sys_command=.false.) ! if (simulation_mode == 'PARALLEL') then - call sim_message('(MODFLOW runs in '//trim(simulation_mode)//' mode)', & - skipafter=1) + call write_message('(MODFLOW runs in '//trim(simulation_mode)//' mode)', & + skipafter=1) end if ! end subroutine initial_message !> @brief Create final message - !! - !! Subroutine that creates the appropriate final message and - !! terminates the program with an error message, if necessary. - !! + !! + !! Subroutine that creates the appropriate final message and + !! terminates the program with an error message, if necessary. + !! !< subroutine final_message() ! -- modules @@ -539,9 +481,9 @@ subroutine final_message() if (numnoconverge > 0) then write (warnmsg, fmtnocnvg) numnoconverge if (isimcontinue == 0) then - call sim_errors%store_message(warnmsg) + call sim_errors%store(warnmsg) else - call sim_warnings%store_message(warnmsg) + call sim_warnings%store(warnmsg) end if end if ! @@ -563,10 +505,10 @@ subroutine final_message() end if ! ! -- destroy messages - call sim_errors%deallocate_message() - call sim_uniterrors%deallocate_message() - call sim_warnings%deallocate_message() - call sim_notes%deallocate_message() + call sim_errors%deallocate() + call sim_uniterrors%deallocate() + call sim_warnings%deallocate() + call sim_notes%deallocate() ! ! -- return or halt if (iforcestop == 1) then @@ -576,13 +518,11 @@ subroutine final_message() end subroutine final_message !> @brief Close all open files - !! - !! Subroutine that closes all open files at the end of the simulation. - !! + !! + !! Subroutine that closes all open files at the end of the simulation. + !! !< subroutine sim_closefiles() - ! -- modules - ! -- dummy ! -- local variables integer(I4B) :: i logical :: opened @@ -608,9 +548,7 @@ subroutine sim_closefiles() ! -- close file unit i close (i) end do - ! - ! -- return - return + end subroutine sim_closefiles end module SimModule diff --git a/src/Utilities/Timer.f90 b/src/Utilities/Timer.f90 index bac77230997..55c92761d17 100644 --- a/src/Utilities/Timer.f90 +++ b/src/Utilities/Timer.f90 @@ -2,7 +2,7 @@ module TimerModule use KindModule, only: DP, I4B use ConstantsModule, only: LINELENGTH, DZERO - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message implicit none private public :: print_start_time @@ -32,7 +32,7 @@ subroutine print_start_time() ! -- Get current date and time, assign to IBDT, and write to screen call date_and_time(values=ibdt) write (line, fmtdt) (ibdt(i), i=1, 3), (ibdt(i), i=5, 7) - call sim_message(line, skipafter=1) + call write_message(line, skipafter=1) ! ! -- return return @@ -69,11 +69,11 @@ SUBROUTINE elapsed_time(iout, iprtim) ! ! -- write elapsed time to stdout write (line, fmtdt) (IEDT(I), I=1, 3), (IEDT(I), I=5, 7) - call sim_message(line, skipbefore=1) + call write_message(line, skipbefore=1) ! ! -- write elapsted time to iout IF (IPRTIM .GT. 0) THEN - call sim_message(line, iunit=iout, skipbefore=1) + call write_message(line, iunit=iout, skipbefore=1) END IF ! ! Calculate elapsed time in days and seconds @@ -145,7 +145,7 @@ SUBROUTINE elapsed_time(iout, iprtim) WRITE (line, 1040) NSECS, MSECS 1040 FORMAT(1X, 'Elapsed run time: ', I2, '.', I3.3, ' Seconds') END IF - call sim_message(line, skipafter=1) + call write_message(line, skipafter=1) ! ! Write times to file if requested IF (IPRTIM .GT. 0) THEN diff --git a/src/Utilities/comarg.f90 b/src/Utilities/comarg.f90 index d8379d8888c..eaab198aab5 100644 --- a/src/Utilities/comarg.f90 +++ b/src/Utilities/comarg.f90 @@ -9,8 +9,8 @@ module CommandArguments use SimVariablesModule, only: istdout, isim_level, & simfile, simlstfile, simstdout, & isim_mode, simulation_mode - use GenericUtilitiesModule, only: sim_message, write_message use SimModule, only: store_error, ustop + use MessageModule, only: write_message, write_message_counter use InputOutputModule, only: upcase, getunit ! implicit none @@ -144,25 +144,25 @@ subroutine GetCommandLineArguments() lstop = .TRUE. write (line, '(2a,2(1x,a))') & trim(adjustl(cexe)), ':', trim(adjustl(VERSION)) - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-DEV', '--DEVELOP') lstop = .TRUE. write (line, '(2a,g0)') & trim(adjustl(cexe)), ': develop version ', ltyp - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-C', '--COMPILER') lstop = .TRUE. call get_compiler(compiler) write (line, '(2a,1x,a)') & trim(adjustl(cexe)), ':', trim(adjustl(compiler)) - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-S', '--SILENT') write (line, '(2a,1x,a)') & trim(adjustl(cexe)), ':', 'all screen output sent to mfsim.stdout' - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-D', '--DISCLAIMER') lstop = .TRUE. - call sim_message('', fmt=FMTDISCLAIMER) + call write_message('', fmt=FMTDISCLAIMER) case ('-P', '--PARALLEL') simulation_mode = 'PARALLEL' case ('-LIC', '--LICENSE') @@ -171,7 +171,7 @@ subroutine GetCommandLineArguments() case ('-CO', '--COMPILER-OPT') lstop = .TRUE. call get_compile_options(coptions) - call write_message(coptions, skipbefore=1, skipafter=1) + call write_message_counter(coptions, skipbefore=1, skipafter=1) case ('-L', '--LEVEL') if (len_trim(clevel) < 1) then iarg = iarg + 1 @@ -195,7 +195,7 @@ subroutine GetCommandLineArguments() write (line, '(2a,2(1x,a))') & trim(adjustl(cexe)), ':', 'stdout output level', & trim(adjustl(clevel)) - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-M', '--MODE') if (len_trim(cmode) < 1) then iarg = iarg + 1 @@ -217,7 +217,7 @@ subroutine GetCommandLineArguments() trim(adjustl(cmode))//'. Model input will be checked for all '// & 'stress periods but the matrix equations will not be '// & 'assembled or solved.' - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case default lstop = .TRUE. call write_usage(trim(adjustl(header)), trim(adjustl(cexe))) @@ -246,7 +246,7 @@ subroutine GetCommandLineArguments() ! ! -- write blank line to stdout if (icountcmd > 0) then - call sim_message('') + call write_message('') end if ! ! -- return @@ -296,16 +296,16 @@ subroutine write_usage(header, cexe) &'[1] https://github.com/MODFLOW-USGS/modflow6/issues',/)" ! ! -- write command line usage information to the screen - call sim_message(header) + call write_message(header) write (line, '(a,1x,a,15x,a,2(1x,a),2a)') & 'usage:', cexe, 'run MODFLOW', trim(adjustl(MFVNAM)), & 'using "', trim(adjustl(simfile)), '"' - call sim_message(line) + call write_message(line) write (line, '(a,1x,a,1x,a,5x,a)') & ' or:', cexe, '[options]', & 'retrieve program information' - call sim_message(line) - call sim_message('', fmt=OPTIONSFMT) + call write_message(line) + call write_message('', fmt=OPTIONSFMT) ! ! -- return return diff --git a/src/Utilities/genericutils.f90 b/src/Utilities/genericutils.f90 index 70cc58bb75c..e6921da9dd6 100644 --- a/src/Utilities/genericutils.f90 +++ b/src/Utilities/genericutils.f90 @@ -15,331 +15,10 @@ module GenericUtilitiesModule private - public :: sim_message - public :: write_message - public :: write_centered public :: is_same contains - !> @brief Write simulation message - !! - !! Subroutine to print message to user specified iunit or STDOUT based on level. - !! - !< - subroutine sim_message(message, iunit, fmt, level, & - skipbefore, skipafter, advance) - ! -- dummy variables - character(len=*), intent(in) :: message !< message to write to iunit - integer(I4B), intent(in), optional :: iunit !< optional file unit to write the message to (default=stdout) - character(len=*), intent(in), optional :: fmt !< optional format to write the message (default='(a)') - integer(I4B), intent(in), optional :: level !< optional level for the message (default=summary) - integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0) - integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0) - logical(LGP), intent(in), optional :: advance !< optional boolean indicating if advancing output (default is .TRUE.) - ! -- local variables - character(len=3) :: cadvance - integer(I4B) :: i - integer(I4B) :: ilen - integer(I4B) :: iu - integer(I4B) :: ilevel - character(len=LENHUGELINE) :: simfmt - character(len=*), parameter :: stdfmt = '(a)' - character(len=*), parameter :: emptyfmt = '()' - ! - ! -- initialize local variables - ilen = len_trim(message) - ! - ! -- process optional dummy variables - if (present(iunit)) then - iu = iunit - else - iu = istdout - end if - if (present(fmt)) then - simfmt = fmt - else - if (ilen > 0) then - simfmt = stdfmt - else - simfmt = emptyfmt - end if - end if - if (present(level)) then - ilevel = level - else - ilevel = VSUMMARY - end if - if (present(advance)) then - if (advance) then - cadvance = 'YES' - else - cadvance = 'NO' - end if - else - cadvance = 'YES' - end if - ! - ! -- write empty line before message - if (present(skipbefore)) then - do i = 1, skipbefore - write (iu, *) - end do - end if - ! - ! -- write message if the level of the message is less than - ! or equal the isim_level for the simulation - if (ilevel <= isim_level) then - if (ilen > 0) then - write (iu, trim(simfmt), advance=cadvance) message(1:ilen) - else - write (iu, trim(simfmt), advance=cadvance) - end if - end if - ! - ! -- write empty line after message - if (present(skipafter)) then - do i = 1, skipafter - write (iu, *) - end do - end if - ! - ! -- return - return - end subroutine sim_message - - !> @brief Write messages - !! - !! Subroutine that formats and writes a single message that - !! may exceeed 78 characters in length. Messages longer than - !! 78 characters are written across multiple lines. When a - !! counter is passed in subsequent lines are indented. - !! - !< - subroutine write_message(message, icount, iwidth, iunit, level, & - skipbefore, skipafter) - ! -- dummy variables - character(len=*), intent(in) :: message !< message to be written - integer(I4B), intent(in), optional :: icount !< counter to prepended to the message - integer(I4B), intent(in), optional :: iwidth !< maximum width of the prepended counter - integer(I4B), intent(in), optional :: iunit !< the unit number to which the message is written - integer(I4B), intent(in), optional :: level !< level of message (VSUMMARY, VALL, VDEBUG) - integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0) - integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0) - ! -- local variables - integer(I4B), parameter :: len_line = 78 - character(len=LENHUGELINE) :: amessage - character(len=len_line) :: line - character(len=16) :: cfmt - character(len=10) :: counter - character(len=5) :: fmt_first - character(len=20) :: fmt_cont - logical(LGP) :: include_counter - integer(I4B) :: isb - integer(I4B) :: isa - integer(I4B) :: jend - integer(I4B) :: len_str1 - integer(I4B) :: len_str2 - integer(I4B) :: len_message - integer(I4B) :: junit - integer(I4B) :: ilevel - integer(I4B) :: i - integer(I4B) :: j - ! - ! -- return if no message is passed - if (len_trim(message) < 1) then - return - end if - ! - ! -- initialize local variables - amessage = message - counter = '' - fmt_first = '(A)' - fmt_cont = '(A)' - len_str1 = 0 - len_str2 = len_line - include_counter = .FALSE. - junit = istdout - j = 0 - ! - ! -- process optional dummy variables - ! -- set the unit number - if (present(iunit)) then - if (iunit > 0) then - junit = iunit - end if - end if - ! - ! -- set the message level - if (present(level)) then - ilevel = level - else - ilevel = VSUMMARY - end if - ! - ! -- set skip before - if (present(skipbefore)) then - isb = skipbefore - else - isb = 0 - end if - ! - ! -- set skip after - if (present(skipafter)) then - isa = skipafter - else - isa = 0 - end if - ! - ! -- create the counter to prepend to the start of the message, - ! formats, and variables used to create strings - if (present(iwidth) .and. present(icount)) then - include_counter = .TRUE. - ! -- write counter - write (cfmt, '(A,I0,A)') '(1x,i', iwidth, ',".",1x)' - write (counter, cfmt) icount - ! -- calculate the length of the first and second string on a line - len_str1 = len(trim(counter)) + 1 - len_str2 = len_line - len_str1 - ! -- write format for the continuation lines - write (fmt_cont, '(a,i0,a)') & - '(', len(trim(counter)) + 1, 'x,a)' - end if - ! - ! -- calculate the length of the message - len_message = len_trim(amessage) - ! - ! -- parse the amessage into multiple lines -5 continue - jend = j + len_str2 - if (jend >= len_message) go to 100 - do i = jend, j + 1, -1 - if (amessage(i:i) .eq. ' ') then - if (j == 0) then - if (include_counter) then - line = counter(1:len_str1)//amessage(j + 1:i) - else - line = amessage(j + 1:i) - end if - call sim_message(line, iunit=junit, & - fmt=fmt_first, level=ilevel, & - skipbefore=isb) - else - line = adjustl(amessage(j + 1:i)) - call sim_message(line, iunit=junit, & - fmt=fmt_cont, level=ilevel) - end if - j = i - go to 5 - end if - end do - if (j == 0) then - if (include_counter) then - line = counter(1:len_str1)//amessage(j + 1:jend) - else - line = amessage(j + 1:jend) - end if - call sim_message(line, iunit=junit, & - fmt=fmt_first, level=ilevel, & - skipbefore=isb) - else - line = amessage(j + 1:jend) - call sim_message(line, iunit=junit, & - fmt=fmt_cont, level=ilevel) - end if - j = jend - go to 5 - ! - ! -- last piece of amessage to write to a line -100 continue - jend = len_message - if (j == 0) then - if (include_counter) then - line = counter(1:len_str1)//amessage(j + 1:jend) - else - line = amessage(j + 1:jend) - end if - call sim_message(line, iunit=junit, & - fmt=fmt_first, level=ilevel, & - skipbefore=isb, skipafter=isa) - else - line = amessage(j + 1:jend) - call sim_message(line, iunit=junit, fmt=fmt_cont, & - level=ilevel, & - skipafter=isa) - end if - ! - ! -- return - return - end subroutine write_message - - !> @brief Write centered text - !! - !! Subroutine to write text to unit iunit centered in width defined by linelen. - !! Left-pad with blanks as needed. - !! - !< - subroutine write_centered(text, linelen, iunit) - ! -- dummy variables - character(len=*), intent(in) :: text !< message to write to iunit - integer(I4B), intent(in) :: linelen !< length of line to center text in - integer(I4B), intent(in), optional :: iunit !< optional file unit to write text (default=stdout) - ! -- local variables - character(len=linelen) :: line - character(len=linelen) :: blank - integer(I4B) :: iu - integer(I4B) :: len_message - integer(I4B) :: jend - integer(I4B) :: ipad - integer(I4B) :: i - integer(I4B) :: j - ! - ! -- process optional parameters - if (present(iunit)) then - iu = iunit - else - iu = istdout - end if - ! - ! -- process text - if (iu > 0) then - ! - ! -- initialize local variables - blank = '' - len_message = len_trim(adjustl(text)) - j = 0 - ! - ! -- parse the amessage into multiple lines -5 continue - jend = j + linelen - if (jend >= len_message) go to 100 - do i = jend, j + 1, -1 - if (text(i:i) .eq. ' ') then - line = text(j + 1:i) - ipad = ((linelen - len_trim(line)) / 2) - call sim_message(blank(1:ipad)//line, iunit=iu) - j = i - go to 5 - end if - end do - line = text(j + 1:jend) - ipad = ((linelen - len_trim(line)) / 2) - call sim_message(blank(1:ipad)//line, iunit=iu) - j = jend - go to 5 - ! - ! -- last piece of amessage to write to a line -100 continue - jend = len_message - line = text(j + 1:jend) - ipad = ((linelen - len_trim(line)) / 2) - call sim_message(blank(1:ipad)//line, iunit=iu) - end if - ! - ! -- return - return - end subroutine write_centered - !> @brief Function to determine if two reals are the same !! !! Function to evaluate if the difference between a and b are less than eps @@ -381,9 +60,7 @@ function is_same(a, b, eps) result(lvalue) lvalue = .TRUE. end if end if - ! - ! -- return - return + end function is_same end module GenericUtilitiesModule diff --git a/src/Utilities/version.f90 b/src/Utilities/version.f90 index 6659205d182..741c5bed516 100644 --- a/src/Utilities/version.f90 +++ b/src/Utilities/version.f90 @@ -10,7 +10,8 @@ module VersionModule use DefinedMacros, only: is_extended, using_petsc, using_netcdf use ConstantsModule, only: LENBIGLINE, LENHUGELINE, DZERO use SimVariablesModule, only: istdout - use GenericUtilitiesModule, only: write_centered, write_message, sim_message + use MessageModule, only: write_message, write_message_centered, & + write_message_counter use CompilerVersion, only: get_compiler, get_compile_options implicit none public @@ -116,26 +117,33 @@ subroutine write_listfile_header(iout, cmodel_type, write_sys_command, & end if ! ! -- Write title to iout - call write_centered(cheader, iheader_width, iunit=iout) - call write_centered(MFTITLE, iheader_width, iunit=iout) + call write_message_centered(text=cheader, linelen=iheader_width, & + iunit=iout) + call write_message_centered(text=MFTITLE, linelen=iheader_width, & + iunit=iout) ! ! -- Write model type to list file if (present(cmodel_type)) then - call write_centered(cmodel_type, iheader_width, iunit=iout) + call write_message_centered(text=cmodel_type, linelen=iheader_width, & + iunit=iout) end if ! ! -- Write version - call write_centered('VERSION '//VERSION, iheader_width, iunit=iout) + call write_message_centered(text='VERSION '//VERSION, & + linelen=iheader_width, iunit=iout) ! ! -- Write if develop mode if (IDEVELOPMODE == 1) then - call write_centered('***DEVELOP MODE***', iheader_width, iunit=iout) + call write_message_centered(text='***DEVELOP MODE***', & + linelen=iheader_width, iunit=iout) end if ! ! -- Write compiler version call get_compiler(compiler) - call write_centered(' ', iheader_width, iunit=iout) - call write_centered(trim(adjustl(compiler)), iheader_width, iunit=iout) + call write_message_centered(text=' ', linelen=iheader_width, & + iunit=iout) + call write_message_centered(text=trim(adjustl(compiler)), & + linelen=iheader_width, iunit=iout) ! ! -- Write disclaimer write (iout, FMTDISCLAIMER) @@ -148,7 +156,7 @@ subroutine write_listfile_header(iout, cmodel_type, write_sys_command, & ! -- write compiler options if (iout /= istdout) then call get_compile_options(compiler_options) - call write_message(compiler_options, iunit=iout) + call write_message_counter(text=compiler_options, iunit=iout) end if ! ! -- Write the system command used to initiate simulation @@ -168,9 +176,7 @@ subroutine write_listfile_header(iout, cmodel_type, write_sys_command, & call write_kindinfo(iout) end if write (iout, *) - ! - ! -- return - return + end subroutine write_listfile_header !> @ brief Write program license @@ -186,7 +192,7 @@ subroutine write_license(iout) if (present(iout)) then write (iout, FMTLICENSE) else - call sim_message('', fmt=FMTLICENSE) + call write_message('', fmt=FMTLICENSE) end if ! ! -- write NetCDF license @@ -194,7 +200,7 @@ subroutine write_license(iout) if (present(iout)) then write (iout, NETCDFLICENSE) else - call sim_message('', fmt=NETCDFLICENSE) + call write_message('', fmt=NETCDFLICENSE) end if end if ! @@ -203,12 +209,10 @@ subroutine write_license(iout) if (present(iout)) then write (iout, PETSCLICENSE) else - call sim_message('', fmt=PETSCLICENSE) + call write_message('', fmt=PETSCLICENSE) end if end if - ! - ! -- return - return + end subroutine write_license end module VersionModule diff --git a/src/mf6core.f90 b/src/mf6core.f90 index a718496ba3a..3b2b78c3924 100644 --- a/src/mf6core.f90 +++ b/src/mf6core.f90 @@ -235,7 +235,7 @@ subroutine create_lstfile() use ConstantsModule, only: LINELENGTH use SimVariablesModule, only: proc_id, nr_procs, simlstfile, iout use InputOutputModule, only: getunit, openfile, append_processor_id - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use VersionModule, only: write_listfile_header character(len=LINELENGTH) :: line ! @@ -252,7 +252,7 @@ subroutine create_lstfile() write (line, '(2(1x,A))') 'Writing simulation list file:', & trim(adjustl(simlstfile)) ! - call sim_message(line) + call write_message(line) call write_listfile_header(iout) ! ! -- return diff --git a/srcbmi/mf6bmiUtil.f90 b/srcbmi/mf6bmiUtil.f90 index 4a5f1d1945e..f586ed6f79e 100644 --- a/srcbmi/mf6bmiUtil.f90 +++ b/srcbmi/mf6bmiUtil.f90 @@ -8,7 +8,7 @@ module mf6bmiUtil LENMODELNAME, LINELENGTH, LENMEMTYPE, & LENMEMADDRESS, LENCOMPONENTNAME use KindModule, only: DP, I4B, LGP - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use SimVariablesModule, only: istdout use MemoryHelperModule, only: split_mem_address, split_mem_path implicit none @@ -210,7 +210,7 @@ function get_model_name(grid_id) result(model_name) end do write (error_msg, '(a,i0)') 'BMI error: no model for grid id ', grid_id - call sim_message(error_msg, iunit=istdout, skipbefore=1, skipafter=1) + call write_message(error_msg, iunit=istdout, skipbefore=1, skipafter=1) end function get_model_name !> @brief Get the solution object for this index diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index 5fd9b2f1d12..00f87156629 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -28,16 +28,17 @@ ${SOURCEDIR8} OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ +$(OBJDIR)/Global.o \ $(OBJDIR)/SimVariables.o \ -$(OBJDIR)/genericutils.o \ +$(OBJDIR)/ArrayHandlers.o \ +$(OBJDIR)/Message.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ $(OBJDIR)/version.o \ $(OBJDIR)/OpenSpec.o \ -$(OBJDIR)/Global.o \ $(OBJDIR)/GlobalVariables.o \ -$(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/SimPHMF.o \ +$(OBJDIR)/genericutils.o \ $(OBJDIR)/InputOutput.o \ $(OBJDIR)/TableTerm.o \ $(OBJDIR)/Table.o \ diff --git a/utils/mf5to6/msvs/mf5to6.vfproj b/utils/mf5to6/msvs/mf5to6.vfproj index f2f4308ae4f..f206d7d30aa 100644 --- a/utils/mf5to6/msvs/mf5to6.vfproj +++ b/utils/mf5to6/msvs/mf5to6.vfproj @@ -104,6 +104,7 @@ + diff --git a/utils/mf5to6/pymake/extrafiles.txt b/utils/mf5to6/pymake/extrafiles.txt index 0590f14ebf5..6b5a9b976c4 100644 --- a/utils/mf5to6/pymake/extrafiles.txt +++ b/utils/mf5to6/pymake/extrafiles.txt @@ -10,6 +10,7 @@ ../../../src/Utilities/SimVariables.f90 ../../../src/Utilities/compilerversion.F90 ../../../src/Utilities/genericutils.f90 +../../../src/Utilities/Message.f90 ../../../src/Utilities/ErrorUtil.f90 ../../../src/Utilities/GeomUtil.f90 ../../../src/Utilities/InputOutput.f90 diff --git a/utils/mf5to6/src/MF2005/GwfBasSubs.f b/utils/mf5to6/src/MF2005/GwfBasSubs.f index 01b15a2e4da..2e8adcdd710 100644 --- a/utils/mf5to6/src/MF2005/GwfBasSubs.f +++ b/utils/mf5to6/src/MF2005/GwfBasSubs.f @@ -11,7 +11,7 @@ module GwfBasSubs use global, only: iout use GlobalVariablesModule, only: echo use GwfBasModule, only: SGWF2BAS7PNT, SGWF2BAS7PSV - use GenericUtilitiesModule, only: write_centered + use MessageModule, only: write_message_centered use ModelModule, only: ModelType use ObsWriterModule, only: ObsWriterType use OpenSpecModule, only: ACCESS, ACTION, FORM @@ -1051,9 +1051,9 @@ SUBROUTINE SGWF2BAS7OPEN(INUNIT,IUNIT,CUNIT,NIUNIT, model%iulist = iu OPEN(UNIT=IU,FILE=FNAME(1:IFLEN),STATUS='REPLACE', 1 FORM='FORMATTED',ACCESS='SEQUENTIAL') - call write_centered(PROGNAM, 80, iunit=iout) + call write_message_centered(PROGNAM, 80, iunit=iout) msg = 'Conversion Report' - call write_centered(msg, 80, iunit=iout) + call write_message_centered(msg, 80, iunit=iout) write(iout,1)trim(model%NameFile2005) write(iout,2)trim(model%BaseName) if (.not. model%ConversionDone) then diff --git a/utils/mf5to6/src/ModelConverter.f90 b/utils/mf5to6/src/ModelConverter.f90 index 3c1f14555e4..bea004b0de6 100644 --- a/utils/mf5to6/src/ModelConverter.f90 +++ b/utils/mf5to6/src/ModelConverter.f90 @@ -34,8 +34,7 @@ module ModelConverterModule use RivObsWriterModule, only: createRivObsWriter, RivObsWriterType use GhbObsWriterModule, only: createGhbObsWriter, GhbObsWriterType use GlobalVariablesModule, only: echo - use SimModule, only: store_error, store_note, store_warning, ustop, & - write_message + use SimModule, only: store_error, store_note, store_warning, ustop use SimListVariablesModule, only: SimMovers use UpwSubsModule, only: GWF2UPW1AR use UtilitiesModule, only: GetArgs diff --git a/utils/mf5to6/src/Preproc/Preproc.f90 b/utils/mf5to6/src/Preproc/Preproc.f90 index df58ae136e1..d840b84beb6 100644 --- a/utils/mf5to6/src/Preproc/Preproc.f90 +++ b/utils/mf5to6/src/Preproc/Preproc.f90 @@ -20,7 +20,7 @@ module PreprocModule AddObsBlockToList, GetObsBlockFromList use OpenSpecModule, only: ACCESS, ACTION, FORM use SimModule, only: count_errors, print_notes, store_error, & - store_error_unit, ustop, write_message + store_error_unit, ustop use UtilitiesModule, only: get_extension, CalcContribFactors implicit none diff --git a/utils/zonebudget/make/makefile b/utils/zonebudget/make/makefile index 09354769be3..db96d3c3471 100644 --- a/utils/zonebudget/make/makefile +++ b/utils/zonebudget/make/makefile @@ -16,16 +16,16 @@ ${SOURCEDIR2} OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ -$(OBJDIR)/SimVariables.o \ $(OBJDIR)/ErrorUtil.o \ -$(OBJDIR)/genericutils.o \ +$(OBJDIR)/SimVariables.o \ +$(OBJDIR)/ArrayHandlers.o \ +$(OBJDIR)/Message.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ -$(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/version.o \ -$(OBJDIR)/Message.o \ $(OBJDIR)/Sim.o \ $(OBJDIR)/OpenSpec.o \ +$(OBJDIR)/genericutils.o \ $(OBJDIR)/InputOutput.o \ $(OBJDIR)/LongLineReader.o \ $(OBJDIR)/DevFeature.o \ diff --git a/utils/zonebudget/src/zbud6.f90 b/utils/zonebudget/src/zbud6.f90 index fedccae4ee9..29a5c98e85e 100644 --- a/utils/zonebudget/src/zbud6.f90 +++ b/utils/zonebudget/src/zbud6.f90 @@ -4,7 +4,7 @@ program zonbudmf6 use VersionModule, only: VERSION use SimVariablesModule, only: iout, errmsg use SimModule, only: store_error - use GenericUtilitiesModule, only: sim_message, write_centered + use MessageModule, only: write_message, write_message_centered use InputOutputModule, only: openfile implicit none @@ -21,9 +21,9 @@ program zonbudmf6 logical :: exists ! -- Write title to screen - call write_centered('ZONEBUDGET'//mfvnam, 80) - call write_centered('U.S. GEOLOGICAL SURVEY', 80) - call write_centered('VERSION '//VERSION, 80) + call write_message_centered('ZONEBUDGET'//mfvnam, 80) + call write_message_centered('U.S. GEOLOGICAL SURVEY', 80) + call write_message_centered('VERSION '//VERSION, 80) ! ! -- Find name of zone budget name file and lst file fnam = 'zbud.nam' @@ -37,9 +37,9 @@ program zonbudmf6 ! -- Open list file and write title iout = iunit_lst call openfile(iunit_lst, 0, flst, 'LIST', filstat_opt='REPLACE') - call write_centered('ZONEBUDGET'//mfvnam, 80, iunit=iout) - call write_centered('U.S. GEOLOGICAL SURVEY', 80, iunit=iout) - call write_centered('VERSION '//VERSION, 80, iunit=iout) + call write_message_centered('ZONEBUDGET'//mfvnam, 80, iunit=iout) + call write_message_centered('U.S. GEOLOGICAL SURVEY', 80, iunit=iout) + call write_message_centered('VERSION '//VERSION, 80, iunit=iout) ! ! -- Open name file, read name file, and open csv file call openfile(iunit_nam, iout, fnam, 'NAM') @@ -54,7 +54,7 @@ program zonbudmf6 close (iunit_lst) close (iunit_csv) write (line, '(a)') 'Normal Termination' - call sim_message(line, skipbefore=1) + call write_message(line, skipbefore=1) ! ! -- end of program end program zonbudmf6 @@ -144,7 +144,6 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) use KindModule use ConstantsModule, only: LINELENGTH use SimVariablesModule, only: iout, errmsg - use GenericUtilitiesModule, only: sim_message use SimModule, only: store_error use BudgetDataModule, only: budgetdata_init, budgetdata_read, & budgetdata_finalize, & @@ -160,6 +159,7 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) use ZoneOutputModule, only: zoneoutput_init, zoneoutput_write, & zoneoutput_finalize use GrbModule, only: read_grb + use MessageModule, only: write_message, write_message_centered implicit none ! -- dummy integer, intent(in) :: iunit_csv @@ -245,7 +245,7 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) end if ! ! -- write message and check - call sim_message(cdot, advance=.FALSE.) + call write_message(text=cdot, advance=.FALSE.) if (itime == 1) then budtxtarray(ibudterm) = budtxt packagenamearray(ibudterm) = dstpackagename @@ -298,7 +298,7 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) end do timeloop ! ! -- Finalize - call sim_message(cdot) + call write_message(text=cdot) call budgetdata_finalize() call zoneoutput_finalize() call zone_finalize()