program Reformat

  ! Read an ALDgen file. Convert the notation for dots to use
  ! 1[A-HJ].[2-7].v [2-5][A-HJ].[1-7].v and 6[A-HJ].[1-6].v

  ! Assume the labels of dots are of the form d#A_#_#.

  use ISO_Fortran_Env, only: E => Error_Unit

  implicit NONE

  character(2) :: Coord     ! [2-6][A-HJ]
  integer :: Begin
  integer :: C, D, J, K, L, N
  integer :: H, V           ! Horz and vert
  character(127) :: Line, U ! Input, input in upper case
  character(10) :: New      ! Revised [1-6][A-HJ][_.]H[_.]V

  n = 0
o:do
    read ( *, '(a)', end=9 ) Line
    n = n + 1
    u = upper_case(line)
    d = index(u,'D')
    if ( d == 0 ) then ! Not a "dot" statement and no dot label
      write ( *, '(a)' ) trim(line)
      cycle
    end if
    if ( index(u,'LINE,') + index(u,'DOT') == 0 ) then
      ! Not a "line" or "dot" statement
      write ( *, '(a)' ) trim(line)
      cycle
    end if
    l = len_trim(line)
    do
      d = d + 1
      begin = d
      call do_dfa ( d )
      if ( h /= 0 ) then
        if ( h > 7 ) then
          h = h - 17
        else
          read ( coord(1:1), * ) c ! Coordinate column 2:6
          write ( coord(1:1), '(i1)' ) c - 1
        end if
        write ( new, '(a2,"_",i0,"_",i0)' ) coord, h, v
        line(begin:d-1) = trim(new) ! It cannot be longer than the old text
      else if ( d > l ) then
        exit
      end if
      j = index(u(d:),'D')
      if ( j == 0 ) exit
      d = d + j - 1
    end do
    d = index(u,'DOT,')
    if ( d == 0 ) then ! Not a "dot" statement
      write ( *, '(a)' ) trim(line)
      cycle
    end if
    k = 0
    d = index(u, '=') + 1
    if ( d < 4 ) then ! Some kind of error
      write ( e, '(*(a,i0))' ) 'Dot statement at line ', n, ' has no at= field'
      write ( *, '(a)' ) trim(line)
      cycle
    end if
    begin = d
    call do_dfa ( d )
    if ( h == 0 ) then ! defective field
      write ( e, '(*(a,i0))' ) 'Dot statement at line ', n, ' has no at= field'
      write ( *, '(a)' ) trim(line)
      cycle
    end if
    if ( h > 7 ) then
      h = h - 17
    else
      read ( coord(1:1), * ) c ! Coordinate column 2:6
      write ( coord(1:1), '(i1)' ) c - 1
    end if
    write ( new, '(a2,".",i0,".",i0)' ) coord, h, v
    line(begin:d-1) = trim(new) ! It cannot be longer than the old text
    d = index(line, ' :')
    if ( d /= 0 ) line(d:d+1) = ': '
    write ( *, '(a)' ) trim(line)
  end do o

9 continue

contains

  subroutine Do_DFA ( D )
    ! Recognize #A_#_# or #A.#.#
    ! 
    integer, intent(inout) :: D ! Character position

    integer :: Action ! 0 => nothing, 1 => store H, 2 => store V and finish
    integer :: Class  ! Of character, column subscript of the DFA
    integer :: Field  ! Field number
    integer :: State  ! Row subscript of the DFA
    integer :: UD(3)  ! Position+1 of underscore or dot

    ! DFA to recognize coordinates [2-6][A-HJ][_.][0-9]+[_.][0-9]+

    integer, parameter :: DFA(7,4) = transpose(reshape( [ &
      !   A-HJ digit under/dot other
      &    1,    2,    1,        0,  &   ! 1 Start first character after D or =
      &    3,    0,    0,        0,  &   ! 2 #
      &    0,    0,    4,        0,  &   ! 3 #A
      &    0,    5,    0,        0,  &   ! 4 #A_
      &    0,    5,   16,        0,  &   ! 5 #A_#
      &    0,    7,    0,        0,  &   ! 6 #A_#_
      &    0,    7,   20,       20 ] , & ! 7 #A_#_#
      &    [ 4, 7 ] ) )
    state = 1
    field = 0
    coord = line(d:d+1)
    do
      select case ( u(d:d) )
      case ( 'A':'H', 'J' )
        class = 1
      case ( '0':'9' )
        class = 2
      case ( '_', '.' )
        class = 3
        field = field + 1
        ud(field) = d + 1
      case default
        class = 4
      end select
      if ( dfa(state,class) == 0 ) then
        coord=' '
        h = 0
        v = 0
        return
      end if
      action = dfa(state,class) / 10
      if ( field > 2 ) action = 2 ! In case of d#a_#_#.route
      select case ( action )
      case ( 1 ) ! Store H
        read ( u(ud(1):d-1), * ) h
      case ( 2 ) ! Store V and finish
        read ( u(ud(2):d-1), * ) v
        return
      end select
      if ( d > l ) then
        coord=' '
        h = 0
        v = 0
        return
      end if
      state = mod(dfa(state,class), 10 )
      d = d + 1
    end do
  end subroutine Do_DFA

  integer function Next_D ( I )
    integer, intent(in) :: I
    next_d = index(u(i:),'D')
    if ( next_d /= 0 ) next_d = next_d + i - 1
  end function Next_D
    
  function Upper_Case ( C ) result ( R )
    character(*), intent(in) :: C
    character(len(c)) :: R
    integer :: I
    do i = 1, len(c)
      r(i:i) = c(i:i)
      if ( r(i:i) >= 'a' .and. r(i:i) <= 'z' ) &
        & r(i:i) = achar(iachar(r(i:i)) + iachar('A') - iachar('a'))
    end do
  end function Upper_Case

end program Reformat
