Enter Home Page FORTRAN CLI library

jublock(STRING,IOUNIT)

NAME
jublock - write out 132-character string in large block letters
SYNOPSIS/USAGE
      SUBROUTINE jublock(STRING,IOUNIT)
      CHARACTER*132 STRING
      INTEGER IOUNIT
      
DESCRIPTION

Given a string up to 132 characters long, jublock() writes out the string left-justified in large (13 lines x 8 columns) block letters starting in column 2.

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 jublock('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


NOTES
A typical compile might look like:
    g95 test_jublock.f jublock.f -o jublock_g95
    


SUBROUTINE jublock (STR,IOUT) !=======================================================================-------- !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()() !=======================================================================-------- ! These routines are available for general use. I ask that you send me ! interesting alterations that are available for public use; and that you ! include a note indicating the original author -- John S. Urban !=======================================================================-------- !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()() !=======================================================================-------- ! !@(#) JUBLOCK(STR,IOUT): write up to 132 large block letters ! Copyright (c) 1984, 1996, 2011 John S. Urban ! 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.. ! jublock 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. ! ****************************************************************** ! Example call: ! ! PROGRAM test ! CALL jublock('JOHN',6) ! CALL jublock('URBAN',6) ! END PROGRAM test ! ****************************************************************** IMPLICIT NONE ! ****************************************************************** 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. 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(*,*)'*jublock* 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 jublock ! ****************************************************************** !=======================================================================--------

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.

#ifdef TESTPRG90 ! ****************************************************************** ! Test Program: PROGRAM banner #ifdef NOCLI2003 ! if compiler does not yet have get_command_argument, use module that simulates it for this compiler USE F2KCLI #endif IMPLICIT NONE INTEGER :: i INTEGER :: i10 INTEGER :: ios CHARACTER :: arg*132 CHARACTER(LEN=1) :: letter 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 jublock(arg(:LEN_TRIM(arg)),6) ENDDO ELSE ! no arguments so run thru all available letters ios=0 DO i10=32,127 letter=CHAR(i10) WRITE(*,*)'LETTER='//letter CALL jublock(letter,6) WRITE(*,*)'Enter [RETURN] to continue' READ(*,'(a)',IOSTAT=ios)letter IF(ios.ne.0)THEN EXIT ENDIF ENDDO ENDIF END PROGRAM banner ! ****************************************************************** #endif