Fortran Wiki
roach

Printing block letters

Occasionally large fixed-font block letters are useful for generating an eye-catching message. The alphablock(3f) and roach(3f) procedures create messages that are hard to miss.


!NAME
!    alphablock - write out string in large block letters
!SYNOPSIS/USAGE
!
!          SUBROUTINE alphablock(STRING,IOUNIT)
!          CHARACTER*132 STRING
!          INTEGER IOUNIT
!
!DESCRIPTION
!
!    Given a string up to 132 characters long, alphablock() writes out the string
!    left-justified in large (13 lines x 8 columns) block letters starting in
!    column 2.
!
!    IOUNIT is the LUN for the file to write to.
!
!    This can be used to make banners in program output files; it is also handy
!    for making attention-catching notices in interactive programs.
!
!EXAMPLE
!
!          program demo
!          call alphablock('NOTICE',6)
!          END
!
!    would produce:
!
!     XX  XXX   XXX   XXXXXXX  XXXXX    XXXX  XXXXXXX
!      X   X   X   X  X  X  X    X     X    X  X    X
!      XX  X  X     X    X       X    X        X
!      XX  X  X     X    X       X    X        X  X
!      X X X  X     X    X       X    X        XXXX
!      X  XX  X     X    X       X    X        X  X
!      X  XX  X     X    X       X    X        X
!      X   X   X   X     X       X     X    X  X    X
!     XXX  X    XXX     XXX    XXXXX    XXXX  XXXXXXX
!
!  * References: none
!  * Dependencies: none
!  * Legal Restrictions: none. Public Domain
!  * Authors: John S. Urban
! Test Program
! 
! The test program reads strings from the command line. 
! If there are no arguments the supported character set is printed,
! one letter at a time.
!-------------------------------------------------------------------------------
!     Test Program:
program banner
implicit none
   integer           :: i
   character         :: arg*132
   if(command_argument_count() .gt. 0)then ! if arguments are present print them
      do i = 1 , command_argument_count()
         call get_command_argument(i, arg)
         call alphablock(arg(:len_trim(arg)),6)
      enddo
   else ! no arguments so run thru all available letters
      call roach(6)
   endif
end program banner
!-------------------------------------------------------------------------------
subroutine alphablock (STR,IOUT)
implicit none
character(len=:),parameter :: ident="@(#)alphablock:write up to 132 large block letters"
!-------------------------------------------------------------------------------
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!-------------------------------------------------------------------------------
! Copyright (c) 1984, 1996, 2011 John S. Urban. Placed in the public domain
!
!     Write a string up to 132 characters long as large block letters,
!     left justified starting in column 2.
!
!     Letters are 13 lines tall and 8 characters wide..
!
!     alphablock can be used for such tasks as
!       o  making a banner page for output delivery
!       o  for an eye-readable title on a piece of microfiche
!       o  get someone's attention.
!-------------------------------------------------------------------------------
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!-------------------------------------------------------------------------------
!     ******************************************************************
      CHARACTER(LEN=*),INTENT(IN) :: STR       ! string to write
      INTEGER,INTENT(IN)          :: IOUT      ! unit number to write to
!     ******************************************************************
      CHARACTER(LEN=8),SAVE       :: ALF(13,95) ! store block letters
      INTEGER                     :: L(132)     ! alphabet
      INTEGER                     :: I30, K, MM ! loop counters
      INTEGER                     :: IP
      INTEGER                     :: LSTR
      INTEGER                     :: IROW, ILET
!     ******************************************************************
      DATA ((ALF(IROW,ILET),ILET=1,5),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '   XX   ' , ' XXXXXX ' , '   XXXX ' , ' XXXXX  ' , ' XXXXXXX', &
     & '    X   ' , '  X    X' , '  X    X' , '  X   X ' , '  X    X', &
     & '    X   ' , '  X    X' , ' X      ' , '  X    X' , '  X     ', &
     & '   X X  ' , '  X    X' , ' X      ' , '  X    X' , '  X  X  ', &
     & '   X X  ' , '  XXXXX ' , ' X      ' , '  X    X' , '  XXXX  ', &
     & '  X   X ' , '  X    X' , ' X      ' , '  X    X' , '  X  X  ', &
     & '  XXXXX ' , '  X    X' , ' X      ' , '  X    X' , '  X     ', &
     & '  X   X ' , '  X    X' , '  X    X' , '  X   X ' , '  X    X', &
     & ' XXX XXX' , ' XXXXXX ' , '   XXXX ' , ' XXXXX  ' , ' XXXXXXX', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        '/

      DATA ((ALF(IROW,ILET),ILET=6,10),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & ' XXXXXXX' , '   XXXX ' , ' XXX XXX' , '  XXXXX ' , '   XXXX ', &
     & '  X    X' , '  X    X' , '  X   X ' , '    X   ' , '     X  ', &
     & '  X     ' , ' X      ' , '  X   X ' , '    X   ' , '     X  ', &
     & '  X  X  ' , ' X      ' , '  X   X ' , '    X   ' , '     X  ', &
     & '  XXXX  ' , ' X      ' , '  XXXXX ' , '    X   ' , '     X  ', &
     & '  X  X  ' , ' X   XXX' , '  X   X ' , '    X   ' , '     X  ', &
     & '  X     ' , ' X     X' , '  X   X ' , '    X   ' , ' X   X  ', &
     & '  X     ' , '  X    X' , '  X   X ' , '    X   ' , ' X   X  ', &
     & ' XXXX   ' , '   XXXX ' , ' XXX XXX' , '  XXXXX ' , '  XXX   ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        '/

      DATA ((ALF(IROW,ILET),ILET=11,15),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & ' XXX  XX' , ' XXXXX  ' , ' XX   XX' , ' XX  XXX' , '   XXX  ', &
     & '  X   X ' , '   X    ' , '  X   X ' , '  X   X ' , '  X   X ', &
     & '  X  X  ' , '   X    ' , '  XX XX ' , '  XX  X ' , ' X     X', &
     & '  X  X  ' , '   X    ' , '  XX XX ' , '  XX  X ' , ' X     X', &
     & '  X X   ' , '   X    ' , '  X X X ' , '  X X X ' , ' X     X', &
     & '  XXX   ' , '   X    ' , '  X X X ' , '  X  XX ' , ' X     X', &
     & '  X  X  ' , '   X    ' , '  X   X ' , '  X  XX ' , ' X     X', &
     & '  X   X ' , '   X   X' , '  X   X ' , '  X   X ' , '  X   X ', &
     & ' XXX  XX' , ' XXXXXXX' , ' XXX XXX' , ' XXX  X ' , '   XXX  ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        '/

      DATA ((ALF(IROW,ILET),ILET=16,20),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & ' XXXXXX ' , '   XXX  ' , ' XXXXXX ' , '  XXXXX ' , ' XXXXXXX', &
     & '  X    X' , '  X   X ' , '  X    X' , ' X     X' , ' X  X  X', &
     & '  X    X' , ' X     X' , '  X    X' , ' X      ' , '    X   ', &
     & '  X    X' , ' X     X' , '  X    X' , ' X      ' , '    X   ', &
     & '  XXXXX ' , ' X     X' , '  XXXXX ' , '  XXXXX ' , '    X   ', &
     & '  X     ' , ' X     X' , '  X  X  ' , '       X' , '    X   ', &
     & '  X     ' , ' X     X' , '  X  X  ' , '       X' , '    X   ', &
     & '  X     ' , '  X   X ' , '  X   X ' , ' X     X' , '    X   ', &
     & ' XXXX   ' , '   XXX  ' , ' XXX  XX' , '  XXXXX ' , '   XXX  ', &
     & '        ' , '   XX XX' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        '/

      DATA ((ALF(IROW,ILET),ILET=21,25),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & ' XXX XXX' , ' XXX XXX' , ' XXX XXX' , ' XXX XXX' , ' XXX XXX', &
     & '  X   X ' , '  X   X ' , '  X   X ' , '  X   X ' , '  X   X ', &
     & '  X   X ' , '  X   X ' , '  X   X ' , '   X X  ' , '  X   X ', &
     & '  X   X ' , '  X   X ' , '  X   X ' , '   X X  ' , '   X X  ', &
     & '  X   X ' , '   X X  ' , '  X X X ' , '    X   ' , '   X X  ', &
     & '  X   X ' , '   X X  ' , '  X X X ' , '   X X  ' , '    X   ', &
     & '  X   X ' , '   X X  ' , '  X X X ' , '   X X  ' , '    X   ', &
     & '  X   X ' , '    X   ' , '   X X  ' , '  X   X ' , '    X   ', &
     & '   XXX  ' , '    X   ' , '   X X  ' , ' XXX XXX' , '   XXX  ', &
     & '        ' , '        ' , '        ' , '        ' , '        ', &
     & '        ' , '        ' , '        ' , '        ' , '        '/

      DATA ((ALF(IROW,ILET),ILET=26,30),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & ' XXXXXXX' , '   XXX  ' , '    X   ' , '   XXX  ' , '   XXX  ' , &
     & ' X    X ' , '  X   X ' , '  XXX   ' , '  X   X ' , '  X   X ' , &
     & '     X  ' , '  X   X ' , '    X   ' , '      X ' , '      X ' , &
     & '     X  ' , '  X   X ' , '    X   ' , '      X ' , '      X ' , &
     & '    X   ' , '  X   X ' , '    X   ' , '     X  ' , '    XX  ' , &
     & '   X    ' , '  X   X ' , '    X   ' , '    X   ' , '      X ' , &
     & '   X    ' , '  X   X ' , '    X   ' , '   X    ' , '      X ' , &
     & '  X    X' , '  X   X ' , '    X   ' , '  X     ' , '  X   X ' , &
     & ' XXXXXXX' , '   XXX  ' , '  XXXXX ' , '  XXXXX ' , '   XXX  ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=31,35),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '     X  ' , '  XXXXX ' , '    XX  ' , '   XXXX ' , '    X   ' , &
     & '    XX  ' , '  X     ' , '   X    ' , '  X    X' , '   XXX  ' , &
     & '    XX  ' , '  X     ' , '  X     ' , ' X  XX X' , '  X   X ' , &
     & '   X X  ' , '  X     ' , '  X     ' , ' X X X X' , '  X     ' , &
     & '   X X  ' , '  XXXX  ' , '  XXXX  ' , ' X X X X' , '   XXX  ' , &
     & '  X  X  ' , '      X ' , '  X   X ' , ' X X X X' , '      X ' , &
     & '  XXXXX ' , '      X ' , '  X   X ' , ' X  XXX ' , '  X   X ' , &
     & '     X  ' , '  X   X ' , '  X   X ' , '  X     ' , '   XXX  ' , &
     & '    XXX ' , '   XXX  ' , '   XXX  ' , '   XXX  ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=36,40),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '  X     ' , '   XX   ' , '        ' , '     X  ' , '   X    ' , &
     & ' X X   X' , '  X     ' , '        ' , '    X   ' , '    X   ' , &
     & '  X   X ' , '  X     ' , '  XX XX ' , '    X   ' , '    X   ' , &
     & '     X  ' , '   X    ' , '   XXX  ' , '   X    ' , '     X  ' , &
     & '    X   ' , '  XX    ' , ' XXXXXXX' , '   X    ' , '     X  ' , &
     & '   X    ' , ' X  X  X' , '   XXX  ' , '   X    ' , '     X  ' , &
     & '  X   X ' , ' X  X X ' , '  XX XX ' , '   X    ' , '     X  ' , &
     & ' X   X X' , ' X   X  ' , '        ' , '   X    ' , '     X  ' , &
     & '      X ' , '  XXX XX' , '        ' , '    X   ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '    X   ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '     X  ' , '   X    ' /

      DATA ((ALF(IROW,ILET),ILET=41,44),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '    X   ' , &
     & '        ' , '        ' , '  XXXXX ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '    X   ' , &
     & ' XXXXXXX' , '        ' , '  XXXXX ' , ' XXXXXXX' , &
     & '        ' , '        ' , '        ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '    X   ' , &
     & '        ' , '        ' , '        ' , '        ' , &
     & '        ' , 'XXXXXXXX' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=45,45),IROW=1,13) / &
     & '        ' , &
     & '        ' , &
     & '        ' , &
     & ' X      ' , &
     & '  X     ' , &
     & '   X    ' , &
     & '    X   ' , &
     & '     X  ' , &
     & '      X ' , &
     & '       X' , &
     & '        ' , &
     & '        ' , &
     & '        ' /

      DATA ((ALF(IROW,ILET),ILET=46,50),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '   XXX  ' , '   XXX  ' , '        ' , '        ' , '        ' , &
     & '     X  ' , '   X    ' , '        ' , '        ' , '        ' , &
     & '     X  ' , '   X    ' , '   X    ' , '        ' , '     X  ' , &
     & '     X  ' , '   X    ' , '    X   ' , '        ' , '    X   ' , &
     & '     X  ' , '   X    ' , '     X  ' , '        ' , '   X    ' , &
     & '     X  ' , '   X    ' , '      X ' , '        ' , '  X     ' , &
     & '     X  ' , '   X    ' , '     X  ' , '        ' , '   X    ' , &
     & '     X  ' , '   X    ' , '    X   ' , '        ' , '    X   ' , &
     & '     X  ' , '   X    ' , '   X    ' , '    X   ' , '     X  ' , &
     & '     X  ' , '   X    ' , '        ' , '        ' , '        ' , &
     & '   XXX  ' , '   XXX  ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=51,55),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '   XXX  ' , '        ' , '    X   ' , '        ' , &
     & '        ' , '  X   X ' , '       X' , '    X   ' , '        ' , &
     & '        ' , '      X ' , '      X ' , '    X   ' , '        ' , &
     & '        ' , '      X ' , '     X  ' , '    X   ' , '    X   ' , &
     & '        ' , '     X  ' , '    X   ' , '    X   ' , '        ' , &
     & '        ' , '    X   ' , '   X    ' , '    X   ' , '        ' , &
     & '        ' , '    X   ' , '  X     ' , '    X   ' , '        ' , &
     & '        ' , '        ' , ' X      ' , '        ' , '        ' , &
     & '    X   ' , '    X   ' , '        ' , '    X   ' , '    X   ' , &
     & '   X    ' , '        ' , '        ' , '        ' , '   X    ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=56,60),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '    X   ' , &
     & '    X   ' , '   X X  ' , '        ' , '    X X ' , '   X X  ' , &
     & '    X   ' , '   X X  ' , '        ' , '    X X ' , '  X   X ' , &
     & '    X   ' , '   X X  ' , '        ' , '  XXXXXX' , '        ' , &
     & '        ' , '        ' , '    X   ' , '   X X  ' , '        ' , &
     & '        ' , '        ' , '        ' , '   X X  ' , '        ' , &
     & '        ' , '        ' , '        ' , '   X X  ' , '        ' , &
     & '        ' , '        ' , '        ' , ' XXXXXX ' , '        ' , &
     & '        ' , '        ' , '        ' , '  X X   ' , '        ' , &
     & '        ' , '        ' , '    X   ' , '  X X   ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=61,65),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '  XXXXX ' , '   XXX  ' , '   XXX  ' , '        ' , '        ' , &
     & '  X   X ' , '  X   X ' , '  X   X ' , '        ' , '        ' , &
     & '      X ' , '  X   X ' , '  X   X ' , '        ' , '        ' , &
     & '     X  ' , '  X   X ' , '  X   X ' , '        ' , '  XXXX  ' , &
     & '     X  ' , '   XXX  ' , '   XXXX ' , '        ' , '      X ' , &
     & '    X   ' , '  X   X ' , '      X ' , '        ' , '  XXXXX ' , &
     & '    X   ' , '  X   X ' , '      X ' , '        ' , ' X    X ' , &
     & '   X    ' , '  X   X ' , '     X  ' , '        ' , ' X    X ' , &
     & '   X    ' , '   XXX  ' , '   XX   ' , '        ' , '  XXXX X' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=66,70),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & ' XX     ' , '        ' , '     XX ' , '        ' , '    XX  ' , &
     & '  X     ' , '        ' , '      X ' , '        ' , '   X    ' , &
     & '  X     ' , '        ' , '      X ' , '        ' , '   X    ' , &
     & '  XXXXX ' , '  XXXXX ' , '  XXXXX ' , '  XXXXX ' , '  XXXX  ' , &
     & '  X    X' , ' X     X' , ' X    X ' , ' X     X' , '   X    ' , &
     & '  X    X' , ' X      ' , ' X    X ' , ' XXXXXXX' , '   X    ' , &
     & '  X    X' , ' X      ' , ' X    X ' , ' X      ' , '   X    ' , &
     & '  X    X' , ' X     X' , ' X    X ' , ' X     X' , '   X    ' , &
     & ' XXXXXX ' , '  XXXXX ' , '  XXXXXX' , '  XXXXX ' , '  XXXX  ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=71,75),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , ' XX     ' , '    X   ' , '     X  ' , ' XX     ' , &
     & '        ' , '  X     ' , '        ' , '        ' , '  X     ' , &
     & '        ' , '  X     ' , '        ' , '        ' , '  X     ' , &
     & '  XXXXXX' , '  X XX  ' , '  XXX   ' , '  XXXX  ' , '  X  XX ' , &
     & ' X    X ' , '  XX  X ' , '    X   ' , '     X  ' , '  X  X  ' , &
     & ' X    X ' , '  X   X ' , '    X   ' , '     X  ' , '  X X   ' , &
     & ' X    X ' , '  X   X ' , '    X   ' , '     X  ' , '  XXX   ' , &
     & '  XXXXX ' , '  X   X ' , '    X   ' , '     X  ' , '  X  X  ' , &
     & '      X ' , ' XXX XXX' , '  XXXXX ' , '     X  ' , ' XX   XX' , &
     & '      X ' , '        ' , '        ' , '     X  ' , '        ' , &
     & '  XXXX  ' , '        ' , '        ' , '  XXX   ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=76,80),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '   XX   ' , '        ' , '        ' , '        ' , '        ' , &
     & '    X   ' , '        ' , '        ' , '        ' , '        ' , &
     & '    X   ' , '        ' , '        ' , '        ' , '        ' , &
     & '    X   ' , ' XXX X  ' , ' XX XX  ' , '  XXXXX ' , ' XXXXXX ' , &
     & '    X   ' , '  X X X ' , '  XX  X ' , ' X     X' , '  X    X' , &
     & '    X   ' , '  X X X ' , '  X   X ' , ' X     X' , '  X    X' , &
     & '    X   ' , '  X X X ' , '  X   X ' , ' X     X' , '  X    X' , &
     & '    X   ' , '  X X X ' , '  X   X ' , ' X     X' , '  X    X' , &
     & '  XXXXX ' , ' XX X XX' , ' XXX XXX' , '  XXXXX ' , '  XXXXX ' , &
     & '        ' , '        ' , '        ' , '        ' , '  X     ' , &
     & '        ' , '        ' , '        ' , '        ' , ' XXX    ' /

      DATA ((ALF(IROW,ILET),ILET=81,85),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '   X    ' , '        ' , &
     & '        ' , '        ' , '        ' , '   X    ' , '        ' , &
     & '  XXXXXX' , ' XXX XX ' , '  XXXXX ' , '  XXXX  ' , ' XX  XX ' , &
     & ' X    X ' , '   XX  X' , ' X     X' , '   X    ' , '  X   X ' , &
     & ' X    X ' , '   X    ' , '  XXX   ' , '   X    ' , '  X   X ' , &
     & ' X    X ' , '   X    ' , '     XX ' , '   X    ' , '  X   X ' , &
     & ' X    X ' , '   X    ' , ' X     X' , '   X  X ' , '  X  XX ' , &
     & '  XXXXX ' , ' XXXXX  ' , '  XXXXX ' , '    XX  ' , '   XX XX' , &
     & '      X ' , '        ' , '        ' , '        ' , '        ' , &
     & '     XXX' , '        ' , '        ' , '        ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=86,90),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & ' XXX XXX' , ' XXX XXX' , ' XXX XXX' , ' XXX XXX' , ' XXXXXX ' , &
     & '  X   X ' , '  X   X ' , '  X   X ' , '  X   X ' , ' X   X  ' , &
     & '  X   X ' , '  X X X ' , '   XXX  ' , '  X   X ' , '    X   ' , &
     & '   X X  ' , '  X X X ' , '   XXX  ' , '   X X  ' , '   X    ' , &
     & '   X X  ' , '   X X  ' , '  X   X ' , '   X X  ' , '  X   X ' , &
     & '    X   ' , '   X X  ' , ' XXX XXX' , '    X   ' , ' XXXXXX ' , &
     & '        ' , '        ' , '        ' , '    X   ' , '        ' , &
     & '        ' , '        ' , '        ' , '  XX    ' , '        ' /

      DATA ((ALF(IROW,ILET),ILET=91,95),IROW=1,13) / &
     & '        ' , '        ' , '        ' , '        ' , '        ' , &
     & '    X   ' , '        ' , '        ' , '        ' , '        ' , &
     & '    X   ' , '     XX ' , '  XX    ' , '        ' , '   X    ' , &
     & '    X   ' , '    X   ' , '    X   ' , '  XX   X' , '    X   ' , &
     & '    X   ' , '    X   ' , '    X   ' , ' X  X  X' , '        ' , &
     & '    X   ' , '    X   ' , '    X   ' , ' X   XX ' , '        ' , &
     & '    X   ' , '    X   ' , '    X   ' , '        ' , '        ' , &
     & '    X   ' , '  XX    ' , '     XX ' , '        ' , '        ' , &
     & '    X   ' , '    X   ' , '    X   ' , '        ' , '        ' , &
     & '    X   ' , '    X   ' , '    X   ' , '        ' , '        ' , &
     & '    X   ' , '    X   ' , '    X   ' , '        ' , '        ' , &
     & '    X   ' , '    X   ' , '    X   ' , '        ' , '        ' , &
     & '    X   ' , '     XX ' , '  XX    ' , '        ' , '        ' /


!     ******************************************************************
!!   NOTE:
!!   rearrange the character definitions in their ASCII decimal equivalent
!!   order and the INDEX() call could be replaced with a simple ICHAR()
!!   call. Code has a long history.

      LSTR=MIN(LEN(STR),132)
      DO I30 = 1, LSTR     ! find column number for this letter
         IP=INDEX('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456@$%&*()-_=+\][>.<,?/!;''":#^789 abcdefghijklmnopqrstuvwxyz|{}~`',STR(I30:I30))
         IF (IP .EQ. 0) THEN  ! if not found, letter is not supported
            L(I30) = 64
            write(*,*)'*alphablock* UNSUPPORTED CHARACTER, ADE=',ichar(STR(I30:I30)) ! print ASCII Decimal Equivalent
        ELSE
            L(I30) = IP
        ENDIF
      ENDDO
!     ******************************************************************
      DO K = 1, 13
         WRITE (IOUT, '(1x,132A8:)') (ALF(K,L(MM)), MM = 1, LSTR)
      ENDDO
!     ******************************************************************
end subroutine alphablock
!===============================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()(
!===============================================================================
subroutine roach(io)
implicit none
character(len=:),parameter  :: ident="@(#)roach(3f):print eye-catching ASCII graphic (roach)"
integer,intent(in) :: io  ! the LUN (Logical Unit Number) to write to
write(io,'(a)')'       ,--.     .--.                                '
write(io,'(a)')'      /    \. ./    \                               '
write(io,'(a)')'     /  /\ / " \ /\  \       XXXXXX  XXX XXX   XXXX '
write(io,'(a)')'    / _/  {~~v~~}  \_ \       X    X  X   X   X    X'
write(io,'(a)')'   /     {   |   }     \      X    X  X   X  X      '
write(io,'(a)')'  ;   /\{    |    }/\   \     X    X  X   X  X      '
write(io,'(a)')'  | _/  {    |    }  \_  :    XXXXX   X   X  X      '
write(io,'(a)')'  |     {    |    }      |    X    X  X   X  X   XXX'
write(io,'(a)')'  |    /{    |    }\     |    X    X  X   X  X     X'
write(io,'(a)')'  |   / {    |    } \    |    X    X  X   X   X    X'
write(io,'(a)')'  |  /  {    |    }  \   |   XXXXXX    XXX     XXXX '
write(io,'(a)')'  |  \  \    |    /  /   |                          '
write(io,'(a)')'  |   \  \   |   /  /    |                          '
write(io,'(a)')'   \   \  \  |  /  /    /                           '
write(io,'(a)')'    \  /   ~~~~~   \   /                            '
end subroutine roach
!===============================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()(
!===============================================================================

category: code