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