refactor(logging): consolidate logging routines in Message.f90

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

autotest/meson.build

@@ -6,6 +6,7 @@ if test_drive.found() and not fc_id.contains('intel')
     'GeomUtil',
     'InputOutput',
     'MathUtil',
+    'Message',
     'Sim'
   ]
 

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) &
                ]
 

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 \

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))// &

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

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

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

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

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

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, &

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
 

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

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)

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