module DumpCore_m

  implicit NONE
  private

  public :: DumpCore

contains

  subroutine DumpCore ( Core, WM )
  ! Dump simulated 1401 core memory

    character(16000), intent(in) :: Core, Wm
    integer :: L           ! Subscript and loop inductor
    character(100) :: Line ! of output

    do l = 1, 100, 5
      write ( line(l:l+4), "(i5)" ) l+4
    end do
    do l = 1, 100
      if ( line(l:l) == " " ) line(l:l) = "."
    end do
    print "(/7x,a)", line

    do l = 1, 16000, 100
      if ( core(l:l+99) /= "" .or. wm(l:l+99) /= "" ) then
        print "(i5,': ',a)", l-1, trim(core(l:l+99))
        print "(7x,a)", trim(wm(l:l+99))
      end if
    end do
    print *

  end subroutine DumpCore

end module DumpCore_m
