program BlkGen

  ! Generate Block specs for ALDgen from fixed-form input.
  ! See 223-6875-1_IBM-SMS.pdf page 15.

  ! The Block spec for ALDgen is designed for reading.
  ! A fixed form is more amenable to writing by copying the rows of an
  ! ALD block in order:

  ! Dwg Card
  ! Row Column
  ! 1   1-4   SMS symbol
  ! 2   5-8   Machine function index (e.g. TD=tape drive; two dots or BA for
  !           the basic circuit.
  ! 3   9-12  Mode (signal level) NPRSTUMWXYZV Fig 13 page 15. First two
  !           characters are for inputs and second two are for outputs. If
  !           one of the two is blank, the other applies to all six pins.
  !           Otherwise, the first applies to the top three and the second
  !           to the bottom three.
  ! 4   13-14 Frame 01-99
  ! 4   15    Modular I: Module A or B; Modular II: Gate A-D.
  ! 4   16    Engineeering change level A-Z.
  ! 5   17    Modular I: Gate 1-8;      Modular II: Chassis 1-4
  ! 5   18    Modular I: Column A-F;    Modular II: Row A-K.
  ! 5   19-20 Modular I: Row 01-26;     Modular II: Column 01-28.
  ! 6   21-22 Card Code AA-ZZ.
  ! 6   23-24 Cap connection AA-ZZ or -- or blank if not used
  ! 7   25-26 Block configuration 00-99
  ! 8   27-28 Page coordinate 2-6 A-HJ
  ! 8   29-38 Note

  use ISO_Fortran_Env, only: E => Error_Unit, Input_Unit, Output_Unit

  implicit NONE

  integer :: Modular = 1 ! 1 or 2

  ! Fields
  character(4) :: SMS
  character(4) :: MFI
  character(2) :: Mode(2)
  character(2) :: Frame
  character(1) :: Module
  character(1) :: Gate
  character(1) :: EC
  character(1) :: Chassis
  character(2) :: Row1 ! Modular I
  character(1) :: Row2 ! Modular II
  character(1) :: Column1 ! Modular I
  character(2) :: Column2 ! Modular II
  character(2) :: Code
  character(2) :: Cap
  character(2) :: Block
  character(2) :: Coord
  character(10) :: Note

  integer :: I
  integer :: In = Input_Unit
  character(127) :: IOMsg
  integer :: IOStat
  character(127) :: Line
  integer :: U = Output_Unit

  i = 0
  do
    i = i + 1
    call get_command_argument ( i, line )
    if ( line(1:1) /= '-' ) exit
    if ( line(2:2) == '1' ) then
      modular = 1
    else if ( line(2:2) == '2' ) then
      modular = 2
    else
      call usage
      stop
    end if
  end do

  if ( line /= '' ) then
    open ( newunit=in, file=trim(line), iostat=iostat, iomsg=iomsg, status='old' )
    if ( iostat /= 0 ) then
      write ( e, '(2a)' ) 'Unable to open input file ', trim(line)
      write ( e, '(a,i0/a)' ) 'Status ', iostat, trim(iomsg)
      stop
    end if
  end if

  call get_command_argument ( i + 1, line )
  if ( line /= '' ) then
    open ( newunit=u, file=trim(line), iostat=iostat, iomsg=iomsg )
    if ( iostat /= 0 ) then
      write ( e, '(2a)' ) 'Unable to open output file ', trim(line)
      write ( e, '(a,i0/a)' ) 'Status ', iostat, trim(iomsg)
      stop
    end if
  end if

  if ( modular == 1 ) then
    do
    1 format ( *(a) )
      read ( in, 1, end=9 ) sms, mfi, mode, frame, module, ec, &
        & gate, column1, row1, code, cap, block, coord, note
      if ( any(sms(1:1) == ['!',';','#','%']) ) cycle
      write ( u, 1 ) coord, ': block, title="', trim(adjustl(note)), &
        & '", symbol=', trim(adjustl(sms)), &
        & ', func=', trim(adjustl(mfi)), &
        & ', mode=', trim(adjustl(mode(1))), '.', trim(adjustl(mode(2))), ', &'
      write ( u, 1 ) '     frame=', trim(adjustl(frame)), &
        & ', module=', module, &
        & ', ec=', ec, &
        & ', gate=', gate, &
        & ', column=', column1, &
        & ', row=', trim(adjustl(row1)), ', &'
      write ( u, 1, advance='no' ) '     card=', trim(adjustl(code))
      if ( verify(cap,'ABCDEFGHIJKLMONPQRSTUVWXYZabcdefghijklmonpqrstuvwxyz') &
         & == 0 ) then
        write ( u, 1 ) ', cap=', trim(adjustl(cap)), &
        & ', block=', trim(adjustl(block))
      else
        write ( u, 1 ) ', cap="', trim(adjustl(cap)), '"', &
        & ', block=', trim(adjustl(block))
      end if
    end do
  else
    do
      read ( in, 1, end=9 ) sms, mfi, mode, frame, gate, ec, &
        & chassis, row2, column2, code, cap, block, coord, note
      if ( any(sms(1:1) == ['!',';','#','%']) ) cycle
      write ( u, 1 ) coord, ': block, title="', trim(adjustl(note)), &
        & '", symbol=', trim(adjustl(sms)), &
        & ', func=', trim(adjustl(mfi)), &
        & ', mode=', trim(adjustl(mode(1))), '.', trim(adjustl(mode(2))), ', &'
      write ( u, 1 ) '     frame=', trim(adjustl(frame)), &
        & ', gate=', gate, &
        & ', ec=', ec, &
        & ', chassis=', chassis, &
        & ', row=', row2, &
        & ', column=', trim(adjustl(column2)), ', &'
      write ( u, 1, advance='no' ) '     card=', trim(adjustl(code))
      if ( verify(cap,'ABCDEFGHIJKLMONPQRSTUVWXYZabcdefghijklmonpqrstuvwxyz') &
         & == 0 ) then
        write ( u, 1 ) ', cap=', trim(adjustl(cap)), &
        & ', block=', trim(adjustl(block))
      else
        write ( u, 1 ) ', cap="', trim(adjustl(cap)), '"', &
        & ', block=', trim(adjustl(block))
      end if
    end do
  end if

9 continue

contains

  subroutine Usage
    call get_command_argument ( 0, line )
  1 format ( *(a) )
    write ( e, 1 ) 'Usage: ', trim(line), ' [options] [input [output]]'
    write ( e, 1 ) 'Options: -1 => Format is Modular I (default)'
    write ( e, 1 ) '         -2 => Format is Modular II'
  end subroutine Usage

end program BlkGen
