C .TITLE ALPHAS
C
C 27 AUG 73 - CHANGE TO 19 'CHARACTERS' PER LINE
C 23 AUG 73 - CHANGE TO SUBROUTINE
C 21 AUG 73 - ADD NUMBERS
C 20 AUG 73 - PAUL HENDERSON
C
C SUBROUTINE TO CONVERT SINGLE CHARACTERS TO CHARACTER GROUPS
C TECHNIQUE USED IS TO DISPLAY THE REQUESTED CHARACTER IN A 5X7 MATRIX
C
C CALLING SEQUENCE:
C
C CHARACTER*1 LINE(19)
C .
C COMMON /ALPHA/LINE
C .
C CALL ALPHAS
C .
C
C WHERE LINE HAS ALREADY BEEN LOADED WITH THE DESIRED 19 CHARACTERS.
C
C
SUBROUTINE ALPHAS
CHARACTER*1 LETTER(51),WORD(19)
CHARACTER*5 LINE(19,7)
CHARACTER*5 ALFA(7,63)
CHARACTER*5 ALFA1(7,30),ALFA2(7,21)
COMMON /ALPHA/WORD
EQUIVALENCE (ALFA(1,1),ALFA1(1,1)),(ALFA(1,31),ALFA2(1,1))
C
C FILL LETTER INDEX ARRAY
C
DATA LETTER/
*'A','B','C','D','E','F','G','H','I','J',
*'K','L','M','N','O','P','Q','R','S','T',
*'U','V','W','X','Y','Z','1','2','3','4',
*'5','6','7','8','9','0','!','"','#','$',
*'%','&','''','(',')','*','+',',','-','.',
*'/'/
C
C NOW FILL UP THE 'ALFA' ARRAY WITH THE CHARACTER CONSTRUCTIONS
C
C '11111222223333344444555556666677777'
DATA ALFA1/
*' AAA ','A A','A A','AAAAA','A A','A A','A A',
*'BBBB ','B B','B B','BBBB ','B B','B B','BBBB ',
*' CCC ','C C','C ','C ','C ','C C',' CCC ',
*'DDD ','D D ','D D','D D','D D','D D ','DDD ',
*'EEEEE','E ','E ','EEEE ','E ','E ','EEEEE',
*'FFFFF','F ','F ','FFFF ','F ','F ','F ',
*' GGG ','G G','G ','G GG','G G','G G',' GGGG',
*'H H','H H','H H','HHHHH','H H','H H','H H',
*' III ',' I ',' I ',' I ',' I ',' I ',' III ',
*' J ',' J ',' J ',' J ','J J ','J J ',' JJ ',
*'K K','K K ','K K ','KK ','K K ','K K ','K K',
*'L ','L ','L ','L ','L ','L ','LLLLL',
*'M M','MM MM','M M M','M M M','M M','M M','M M',
*'N N','NN N','NN N','N N N','N NN','N NN','N N',
*' OOO ','O O','O O','O O','O O','O O',' OOO ',
*'PPPP ','P P','P P','PPPP ','P ','P ','P ',
*' QQQ ','Q Q','Q Q','Q Q','Q Q Q','Q Q ',' QQ Q',
*'RRRR ','R R','R R','RRRR ','R R ','R R ','R R',
*' SSS ','S S','S ',' SSS ',' S','S S',' SSS ',
*'TTTTT',' T ',' T ',' T ',' T ',' T ',' T ',
*'U U','U U','U U','U U','U U','U U',' UUU ',
*'V V','V V','V V',' V V ',' V V ',' V ',' V ',
*'W W','W W','W W','W W W','W W W','WW WW','W W',
*'X X','X X',' X X ',' X ',' X X ','X X','X X',
*'Y Y','Y Y','Y Y',' YYY ',' Y ',' Y ',' Y ',
*'ZZZZZ',' Z',' Z ',' ZZZ ',' Z ','Z ','ZZZZZ',
*' 1 ',' 11 ',' 1 ',' 1 ',' 1 ',' 1 ',' 111 ',
*' 222 ','2 2',' 2',' 222 ','2 ','2 ','22222',
*' 333 ','3 3',' 3',' 33 ',' 3','3 3',' 333 ',
*' 4 ',' 44 ',' 4 4 ','44444',' 4 ',' 4 ',' 4 '/
C
DATA ALFA2/
*'55555','5 ','5 ',' 555 ',' 5','5 5',' 555 ',
*' 666 ','6 6','6 ','6666 ','6 6','6 6',' 666 ',
*'77777','7 7',' 7 ',' 7 ',' 7 ','7 ','7 ',
*' 888 ','8 8','8 8',' 888 ','8 8','8 8',' 888 ',
*' 999 ','9 9','9 9',' 9999',' 9','9 9',' 999 ',
*' 000 ','0 0','0 00','0 0 0','00 0','0 0',' 000 ',
*' !! ',' !! ',' !! ',' !! ',' !! ',' ',' !! ',
*' " " ',' " " ',' " " ',' ',' ',' ',' ',
*' # # ',' # # ','#####',' # # ','#####',' # # ',' # # ',
*' $$$ ','$ $ $','$ $ ',' $$$ ',' $ $','$ $ $',' $$$ ',
*'%% %','%% %',' % ',' % ',' % ','% %%','% %%',
*' & ','& & ','& & ',' & ','& & &','& & ',' && &',
*5H '' ,5H '' ,5H ' ,' ',' ',' ',' ',
*' (',' ( ',' ( ',' ( ',' ( ',' ( ',' (',
*') ',' ) ',' ) ',' ) ',' ) ',' ) ',') ',
*' ','* * *',' *** ',' * ',' *** ','* * *',' ',
*' ',' + ',' + ','+++++',' + ',' + ',' ',
*' ',' ',' ',' ,, ',' ,, ',' , ',' , ',
*' ',' ',' ','-----',' ',' ',' ',
*' ',' ',' ',' ',' ',' .. ',' .. ',
*' ',' /',' / ',' / ',' / ','/ ',' '/
C
C CLEAR LINE ARRAY TO SPACES
C
2 DO 4 L=1,7
DO 3 K=1,19
LINE(K,L) = ' '
3 CONTINUE
4 CONTINUE
C
C NOW IDENTIFY CHARACTER TO BE OUTPUT
C
DO 7 I=1,19
DO 41 INDEX=1,51
IF (WORD(I).EQ.LETTER(INDEX)) GO TO 5
41 CONTINUE
C
C CHARACTER NOT IDENTIFIED. TREAT AS A SPACE
C
GO TO 7
C
C BUILD CHARACTER
C
5 DO 6 K=1,7
LINE(I,K) = ALFA(K,INDEX)
6 CONTINUE
7 CONTINUE
WRITE(6,999) LINE
RETURN
C
999 FORMAT (//7(' ',18(A5,2X),A5/)///)
END