SimpleTextColumn.F90 Source File


This file depends on

sourcefile~~simpletextcolumn.f90~~EfferentGraph sourcefile~simpletextcolumn.f90 SimpleTextColumn.F90 sourcefile~abstractmeternode.f90 AbstractMeterNode.F90 sourcefile~simpletextcolumn.f90->sourcefile~abstractmeternode.f90 sourcefile~textcolumn.f90 TextColumn.F90 sourcefile~simpletextcolumn.f90->sourcefile~textcolumn.f90 sourcefile~abstractmeter.f90 AbstractMeter.F90 sourcefile~abstractmeternode.f90->sourcefile~abstractmeter.f90 sourcefile~textcolumn.f90->sourcefile~abstractmeternode.f90 sourcefile~mapl_errorhandling.f90 MAPL_ErrorHandling.F90 sourcefile~abstractmeter.f90->sourcefile~mapl_errorhandling.f90 sourcefile~mapl_throw.f90 MAPL_Throw.F90 sourcefile~mapl_errorhandling.f90->sourcefile~mapl_throw.f90

Files dependent on this one

sourcefile~~simpletextcolumn.f90~~AfferentGraph sourcefile~simpletextcolumn.f90 SimpleTextColumn.F90 sourcefile~mapl_profiler.f90~2 MAPL_Profiler.F90 sourcefile~mapl_profiler.f90~2->sourcefile~simpletextcolumn.f90 sourcefile~namecolumn.f90 NameColumn.F90 sourcefile~mapl_profiler.f90~2->sourcefile~namecolumn.f90 sourcefile~separatorcolumn.f90 SeparatorColumn.F90 sourcefile~mapl_profiler.f90~2->sourcefile~separatorcolumn.f90 sourcefile~namecolumn.f90->sourcefile~simpletextcolumn.f90 sourcefile~separatorcolumn.f90->sourcefile~simpletextcolumn.f90 sourcefile~abstractserver.f90 AbstractServer.F90 sourcefile~abstractserver.f90->sourcefile~mapl_profiler.f90~2 sourcefile~applicationsupport.f90 ApplicationSupport.F90 sourcefile~applicationsupport.f90->sourcefile~mapl_profiler.f90~2 sourcefile~demo.f90 demo.F90 sourcefile~demo.f90->sourcefile~mapl_profiler.f90~2 sourcefile~extdatadrivergridcomp.f90 ExtDataDriverGridComp.F90 sourcefile~extdatadrivergridcomp.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mapl.f90 MAPL.F90 sourcefile~mapl.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mapl_bundleio_test.f90 mapl_bundleio_test.F90 sourcefile~mapl_bundleio_test.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mapl_capgridcomp.f90 MAPL_CapGridComp.F90 sourcefile~mapl_capgridcomp.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mapl_generic.f90 MAPL_Generic.F90 sourcefile~mapl_generic.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mapl_nuopcwrappermod.f90 MAPL_NUOPCWrapperMod.F90 sourcefile~mapl_nuopcwrappermod.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mapl_verticalmethods.f90 MAPL_VerticalMethods.F90 sourcefile~mapl_verticalmethods.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mpi_demo.f90 mpi_demo.F90 sourcefile~mpi_demo.f90->sourcefile~mapl_profiler.f90~2 sourcefile~mpiserver.f90 MpiServer.F90 sourcefile~mpiserver.f90->sourcefile~mapl_profiler.f90~2 sourcefile~multicolumn.f90 MultiColumn.F90 sourcefile~multicolumn.f90->sourcefile~separatorcolumn.f90 sourcefile~multigroupserver.f90 MultiGroupServer.F90 sourcefile~multigroupserver.f90->sourcefile~mapl_profiler.f90~2 sourcefile~profilereporter.f90 ProfileReporter.F90 sourcefile~profilereporter.f90->sourcefile~separatorcolumn.f90 sourcefile~regrid_util.f90 Regrid_Util.F90 sourcefile~regrid_util.f90->sourcefile~mapl_profiler.f90~2 sourcefile~serverthread.f90 ServerThread.F90 sourcefile~serverthread.f90->sourcefile~mapl_profiler.f90~2 sourcefile~test_advancedmeter.pf test_AdvancedMeter.pf sourcefile~test_advancedmeter.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_column.pf test_Column.pf sourcefile~test_column.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_distributedmeter.pf test_DistributedMeter.pf sourcefile~test_distributedmeter.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_exclusivecolumn.pf test_ExclusiveColumn.pf sourcefile~test_exclusivecolumn.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_meternode.pf test_MeterNode.pf sourcefile~test_meternode.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_meternodeiterator.pf test_MeterNodeIterator.pf sourcefile~test_meternodeiterator.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_namecolumn.pf test_NameColumn.pf sourcefile~test_namecolumn.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_percentagecolumn.pf test_PercentageColumn.pf sourcefile~test_percentagecolumn.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_profilereporter.pf test_ProfileReporter.pf sourcefile~test_profilereporter.pf->sourcefile~mapl_profiler.f90~2 sourcefile~test_timeprofiler.pf test_TimeProfiler.pf sourcefile~test_timeprofiler.pf->sourcefile~mapl_profiler.f90~2

Source Code

module MAPL_SimpleTextColumn
   use MAPL_TextColumn
   use MAPL_AbstractMeterNode
   implicit none
   private

   public :: SimpleTextColumn

   type, abstract, extends(TextColumn) :: SimpleTextColumn
      private
   contains
      procedure :: get_rows_range
      procedure :: get_rows
      procedure(i_get_row), deferred :: get_row
   end type SimpleTextColumn

   abstract interface

      function i_get_row(this, node) result(row)
         use MAPL_AbstractMeterNode
         import SimpleTextColumn
         character(:), allocatable :: row
         class (SimpleTextColumn), intent(in) :: this
         class (AbstractMeterNode), intent(in) :: node
      end function i_get_row

   end interface


contains


   ! Using subroutines instead of functions as a workaround for gfortran 8.2
   ! Reproducer being submitted by Damian Rouson (10/12/2018)
   subroutine get_rows_range(this, begin, end, rows)
      class (SimpleTextColumn), target, intent(in) :: this
      class (AbstractMeterNodeIterator), intent(in) :: begin
      class (AbstractMeterNodeIterator), intent(in) :: end
      character(:), allocatable, intent(inout) :: rows(:)

      class (AbstractMeterNodeIterator), allocatable :: iter
      integer :: i
      integer :: width
      class (AbstractMeterNode), pointer :: subnode

      ! count_nodes
      iter = begin
      i = 0
      do while (iter /= end)
         i = i + 1
         call iter%next()
      end do

      width = this%get_width()
      allocate(character(width) :: rows(i))

      ! Fill rows
      iter = begin
      i = 0
      do while (iter /= end)
         i = i + 1
         subnode => iter%get()
         rows(i) = this%get_row(subnode)
         call iter%next()
      end do
      
   end subroutine get_rows_range


  subroutine get_rows(this, node, rows)
      class (SimpleTextColumn), intent(in) :: this
      class (AbstractMeterNode), target, intent(in) :: node
      character(:), allocatable, intent(out) :: rows(:)

      class (AbstractMeterNodeIterator), allocatable :: b, e

      b = node%begin()
      e = node%end()

      call this%get_rows_range(b, e, rows)

   end subroutine get_rows
   
end module MAPL_SimpleTextColumn