* * $Id$ * * $Log$ * Revision 1.1.1.1 1996/02/15 17:49:51 mclareni * Kernlib * * #include "kerngen/pilot.h" SUBROUTINE VIZPRI (LUNP,TEXT) C C CERN PROGLIB# J200 VIZPRI .VERSION KERNFOR 4.22 890913 C ORIG. 20/07/89, JZ C C- Visual printing of TEXT PARAMETER (MXTEXT=9) PARAMETER (MXCHAR=14*MXTEXT) CHARACTER TEXT*(*) CHARACTER LINE*(MXCHAR) CHARACTER CHLINE(MXCHAR)*1 EQUIVALENCE (CHLINE(1),LINE(1:1)) DIMENSION MTRAN(MXTEXT), MBITS(12) CHARACTER CHT*1 * unit number for standard output PARAMETER (LUNSTP=6) INTEGER MPAT(12,93) DATA (MPAT(J, 1),J=1,12) / 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0 / DATA (MPAT(J, 2),J=1,12) / 96, 96, 96, 96, 96, 96, + 96, 96, 0, 0, 96, 96 / DATA (MPAT(J, 3),J=1,12) / 408, 408, 408, 0, 0, 0, + 0, 0, 0, 0, 0, 0 / DATA (MPAT(J, 4),J=1,12) / 408, 408, 408,4095,4095, 408, + 408,4095,4095, 408, 408, 408 / DATA (MPAT(J, 5),J=1,12) / 96,2046,3687, 99, 103,1022, + 2044,3680,3168,3687,2046, 96 / DATA (MPAT(J, 6),J=1,12) / 0,1564, 788, 412, 192, 96, + 48, 24, 460, 326, 451, 0 / DATA (MPAT(J, 7),J=1,12) / 120, 252, 204, 204, 252, 120, + 3324,3526,1923,1795,4095,3326 / DATA (MPAT(J, 8),J=1,12) / 96, 96, 96, 0, 0, 0, + 0, 0, 0, 0, 0, 0 / DATA (MPAT(J, 9),J=1,12) / 448, 96, 48, 48, 24, 24, + 24, 24, 48, 48, 96, 448 / DATA (MPAT(J,10),J=1,12) / 56, 96, 192, 192, 384, 384, + 384, 384, 192, 192, 96, 56 / DATA (MPAT(J,11),J=1,12) / 96,1638,1902,1020, 504,4095, + 4095, 504,1020,1902,1638, 96 / DATA (MPAT(J,12),J=1,12) / 0, 96, 96, 96, 96,2046, + 2046, 96, 96, 96, 96, 0 / DATA (MPAT(J,13),J=1,12) / 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 96, 48 / DATA (MPAT(J,14),J=1,12) / 0, 0, 0, 0, 0,2046, + 2046, 0, 0, 0, 0, 0 / DATA (MPAT(J,15),J=1,12) / 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 96, 96 / DATA (MPAT(J,16),J=1,12) / 0,1536, 768, 384, 192, 96, + 48, 24, 12, 6, 3, 0 / DATA (MPAT(J,17),J=1,12) /1020,2046,3075,3075,3075,3075, + 3075,3075,3075,3075,2046,1020 / DATA (MPAT(J,18),J=1,12) / 96, 112, 120, 96, 96, 96, + 96, 96, 96, 96,2046,2046 / DATA (MPAT(J,19),J=1,12) /2046,4095,3075,3072,3072,1536, + 384, 96, 24, 6,4095,4095 / DATA (MPAT(J,20),J=1,12) /2046,4095,3075,3072,3072,1920, + 1920,3072,3072,3075,4095,2046 / DATA (MPAT(J,21),J=1,12) / 448, 480, 432, 408, 396,4094, + 4095, 384, 384, 384, 384, 384 / DATA (MPAT(J,22),J=1,12) /4095,4095, 3, 3, 3, 511, + 1023,1536,3072,3072,4095,2047 / DATA (MPAT(J,23),J=1,12) /2046,4095,3075, 3, 3,2047, + 4095,3075,3075,3075,4095,2046 / DATA (MPAT(J,24),J=1,12) /4095,2047, 771, 384, 192, 96, + 96, 96, 96, 96, 96, 96 / DATA (MPAT(J,25),J=1,12) /2046,4095,3075,3075,1542,1020, + 1020,1542,3075,3075,4095,2046 / DATA (MPAT(J,26),J=1,12) /2046,4095,3075,3075,3075,4095, + 4095,3072,3072,3075,4095,2046 / DATA (MPAT(J,27),J=1,12) / 0, 0, 0, 96, 96, 0, + 0, 96, 96, 0, 0, 0 / DATA (MPAT(J,28),J=1,12) / 0, 0, 0, 0, 0, 0, + 0, 96, 0, 96, 96, 48 / DATA (MPAT(J,29),J=1,12) / 384, 192, 96, 48, 24, 12, + 12, 24, 48, 96, 192, 384 / DATA (MPAT(J,30),J=1,12) / 0, 0, 0,2046,2046, 0, + 0,2046,2046, 0, 0, 0 / DATA (MPAT(J,31),J=1,12) / 24, 48, 96, 192, 384, 768, + 768, 384, 192, 96, 48, 24 / DATA (MPAT(J,32),J=1,12) /2046,4095,3075,3072,3584,2016, + 992, 96, 96, 0, 96, 96 / DATA (MPAT(J,33),J=1,12) /2046,4095,3075,3315,3579,3483, + 3483,3571,4083,1795, 63, 62 / DATA (MPAT(J,34),J=1,12) /2046,4095,3075,3075,3075,4095, + 4095,3075,3075,3075,3075,3075 / DATA (MPAT(J,35),J=1,12) /2047,4095,3075,3075,1539,1023, + 1023,1539,3075,3075,4095,2047 / DATA (MPAT(J,36),J=1,12) /2046,4095,3075, 3, 3, 3, + 3, 3, 3,3075,4095,2046 / DATA (MPAT(J,37),J=1,12) / 511,1023,1539,3075,3075,3075, + 3075,3075,3075,1539,1023, 511 / DATA (MPAT(J,38),J=1,12) /4095,4095, 3, 3, 3, 255, + 255, 3, 3, 3,4095,4095 / DATA (MPAT(J,39),J=1,12) /4095,4095, 3, 3, 3, 255, + 255, 3, 3, 3, 3, 3 / DATA (MPAT(J,40),J=1,12) /2046,4095,3075, 3, 3, 3, + 3971,3971,3075,3075,4095,2046 / DATA (MPAT(J,41),J=1,12) /3075,3075,3075,3075,3075,4095, + 4095,3075,3075,3075,3075,3075 / DATA (MPAT(J,42),J=1,12) /2046,2046, 96, 96, 96, 96, + 96, 96, 96, 96,2046,2046 / DATA (MPAT(J,43),J=1,12) /4092,4092, 192, 192, 192, 192, + 192, 192, 195, 195, 255, 126 / DATA (MPAT(J,44),J=1,12) /3075,1539, 771, 387, 195, 127, + 127, 195, 387, 771,1539,3075 / DATA (MPAT(J,45),J=1,12) / 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3,4095,4095 / DATA (MPAT(J,46),J=1,12) /3075,3591,3855,3483,3315,3171, + 3075,3075,3075,3075,3075,3075 / DATA (MPAT(J,47),J=1,12) /3075,3079,3087,3099,3123,3171, + 3267,3459,3843,3587,3075,2051 / DATA (MPAT(J,48),J=1,12) /4095,4095,3075,3075,3075,3075, + 3075,3075,3075,3075,4095,4095 / DATA (MPAT(J,49),J=1,12) /2047,4095,3075,3075,3075,4095, + 2047, 3, 3, 3, 3, 3 / DATA (MPAT(J,50),J=1,12) /2046,4095,3075,3075,3075,3075, + 3075,3267,3459,3843,2047,3582 / DATA (MPAT(J,51),J=1,12) /2047,4095,3075,3075,3075,4095, + 2047, 195, 387, 771,1539,3075 / DATA (MPAT(J,52),J=1,12) /2046,4095,3075, 3, 7,1022, + 2044,3584,3072,3075,4095,2046 / DATA (MPAT(J,53),J=1,12) /4095,4095, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96 / DATA (MPAT(J,54),J=1,12) /3075,3075,3075,3075,3075,3075, + 3075,3075,3075,3075,4095,2046 / DATA (MPAT(J,55),J=1,12) /3075,3075,3075,3075,3075,3075, + 3075,1542, 780, 408, 240, 96 / DATA (MPAT(J,56),J=1,12) /3075,3075,3075,3075,3075,3075, + 3171,3315,3483,3855,3591,3075 / DATA (MPAT(J,57),J=1,12) /3075,3075,1542, 780, 408, 240, + 240, 408, 780,1542,3075,3075 / DATA (MPAT(J,58),J=1,12) /3075,3075,1542, 780, 408, 240, + 96, 96, 96, 96, 96, 96 / DATA (MPAT(J,59),J=1,12) /4095,4095,1536, 768, 384, 192, + 96, 48, 24, 12,4094,4095 / DATA (MPAT(J,60),J=1,12) /1020, 12, 12, 12, 12, 12, + 12, 12, 12, 12, 12,1020 / DATA (MPAT(J,61),J=1,12) / 0, 6, 12, 24, 48, 96, + 192, 384, 768,1536,3072, 0 / DATA (MPAT(J,62),J=1,12) /1020, 768, 768, 768, 768, 768, + 768, 768, 768, 768, 768,1020 / DATA (MPAT(J,63),J=1,12) / 96, 240, 408, 780, 0, 0, + 0, 0, 0, 0, 0, 0 / DATA (MPAT(J,64),J=1,12) / 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0,4095,4095 / DATA (MPAT(J,65),J=1,12) / 48, 96, 192, 0, 0, 0, + 0, 0, 0, 0, 0, 0 / DATA (MPAT(J,66),J=1,12) /2046,4095,3075,3075,3075,4095, + 4095,3075,3075,3075,3075,3075 / DATA (MPAT(J,67),J=1,12) /2047,4095,3075,3075,1539,1023, + 1023,1539,3075,3075,4095,2047 / DATA (MPAT(J,68),J=1,12) /2046,4095,3075, 3, 3, 3, + 3, 3, 3,3075,4095,2046 / DATA (MPAT(J,69),J=1,12) / 511,1023,1539,3075,3075,3075, + 3075,3075,3075,1539,1023, 511 / DATA (MPAT(J,70),J=1,12) /4095,4095, 3, 3, 3, 255, + 255, 3, 3, 3,4095,4095 / DATA (MPAT(J,71),J=1,12) /4095,4095, 3, 3, 3, 255, + 255, 3, 3, 3, 3, 3 / DATA (MPAT(J,72),J=1,12) /2046,4095,3075, 3, 3, 3, + 3971,3971,3075,3075,4095,2046 / DATA (MPAT(J,73),J=1,12) /3075,3075,3075,3075,3075,4095, + 4095,3075,3075,3075,3075,3075 / DATA (MPAT(J,74),J=1,12) /2046,2046, 96, 96, 96, 96, + 96, 96, 96, 96,2046,2046 / DATA (MPAT(J,75),J=1,12) /4092,4092, 192, 192, 192, 192, + 192, 192, 195, 195, 255, 126 / DATA (MPAT(J,76),J=1,12) /3075,1539, 771, 387, 195, 127, + 127, 195, 387, 771,1539,3075 / DATA (MPAT(J,77),J=1,12) / 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3,4095,4095 / DATA (MPAT(J,78),J=1,12) /3075,3591,3855,3483,3315,3171, + 3075,3075,3075,3075,3075,3075 / DATA (MPAT(J,79),J=1,12) /3075,3079,3087,3099,3123,3171, + 3267,3459,3843,3587,3075,2051 / DATA (MPAT(J,80),J=1,12) /4095,4095,3075,3075,3075,3075, + 3075,3075,3075,3075,4095,4095 / DATA (MPAT(J,81),J=1,12) /2047,4095,3075,3075,3075,4095, + 2047, 3, 3, 3, 3, 3 / DATA (MPAT(J,82),J=1,12) /2046,4095,3075,3075,3075,3075, + 3075,3267,3459,3843,2047,3582 / DATA (MPAT(J,83),J=1,12) /2047,4095,3075,3075,3075,4095, + 2047, 195, 387, 771,1539,3075 / DATA (MPAT(J,84),J=1,12) /2046,4095,3075, 3, 7,1022, + 2044,3584,3072,3075,4095,2046 / DATA (MPAT(J,85),J=1,12) /4095,4095, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96 / DATA (MPAT(J,86),J=1,12) /3075,3075,3075,3075,3075,3075, + 3075,3075,3075,3075,4095,2046 / DATA (MPAT(J,87),J=1,12) /3075,3075,3075,3075,3075,3075, + 3075,1542, 780, 408, 240, 96 / DATA (MPAT(J,88),J=1,12) /3075,3075,3075,3075,3075,3075, + 3171,3315,3483,3855,3591,3075 / DATA (MPAT(J,89),J=1,12) /3075,3075,1542, 780, 408, 240, + 240, 408, 780,1542,3075,3075 / DATA (MPAT(J,90),J=1,12) /3075,3075,1542, 780, 408, 240, + 96, 96, 96, 96, 96, 96 / DATA (MPAT(J,91),J=1,12) /4095,4095,1536, 768, 384, 192, + 96, 48, 24, 12,4094,4095 / DATA (MPAT(J,92),J=1,12) / 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0 / DATA (MPAT(J,93),J=1,12) / 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96 / #if defined(CERNLIB_QEBCDIC) C-- EBCDIC to ASCII translation table DIMENSION MEBCD(188) C- ? ? ? ? ? ? ? ? ? ? ? . < ( + | & ? ? C- ? ? ? ? ? ? ? ! $ * ) ; ~ - / ? ? ? ? ? C- ? ? ? ^ , % _ > ? ? ? ? ? ? ? ? ? ? ` : C- # @ ' = " ? a b c d e f g h i ? { ? ? ? C- ? ? j k l m n o p q r ? } ? ? ? ? ? ? s C- t u v w x y z ? ? ? [ ? ? ? ? ? ? ? ? ? C- ? ? ? ? ? ? ] ? ? ? A B C D E F G H I ? C- ? ? ? ? ? ? J K L M N O P Q R ? ? ? ? ? C- ? \ ? S T U V W X Y Z ? ? ? ? ? ? 0 1 2 C- 3 4 5 6 7 8 9 DATA MEBCD / 32, 32, 32, 32, 32, 32, 32, 32, 32, 32 +, 32, 32, 46, 60, 40, 43,124, 38, 32, 32 +, 32, 32, 32, 32, 32, 32, 32, 33, 36, 42 +, 41, 59,126, 45, 47, 32, 32, 32, 32, 32 +, 32, 32, 32, 94, 44, 37, 95, 62, 63, 32 +, 32, 32, 32, 32, 32, 32, 32, 32, 96, 58 +, 35, 64, 39, 61, 34, 32, 97, 98, 99,100 +, 101,102,103,104,105, 32,123, 32, 32, 32 +, 32, 32,106,107,108,109,110,111,112,113 +, 114, 32,125, 32, 32, 32, 32, 32, 32,115 +, 116,117,118,119,120,121,122, 32, 32, 32 +, 91, 32, 32, 32, 32, 32, 32, 32, 32, 32 +, 32, 32, 32, 32, 32, 32, 93, 32, 32, 32 +, 65, 66, 67, 68, 69, 70, 71, 72, 73, 32 +, 32, 32, 32, 32, 32, 32, 74, 75, 76, 77 +, 78, 79, 80, 81, 82, 32, 32, 32, 32, 32 +, 32, 92, 32, 83, 84, 85, 86, 87, 88, 89 +, 90, 32, 32, 32, 32, 32, 32, 48, 49, 50 +, 51, 52, 53, 54, 55, 56, 57, 32 / #endif LUN = LUNP IF (LUN.EQ.0) LUN = LUNSTP NTXL = MIN (MXTEXT, LEN(TEXT)) IF (NTXL.LE.0) GO TO 41 C---- Translate TEXT to table pointers #if defined(CERNLIB_QASCII) DO 24 J=1,NTXL JV = ICHAR(TEXT(J:J)) JV = MAX (JV-31, 1) IF (JV.GE.94) JV = 1 24 MTRAN(J) = JV #endif #if defined(CERNLIB_QEBCDIC) DO 24 J=1,NTXL JV = ICHAR(TEXT(J:J)) JV = MAX (JV-62, 1) JV = MIN (188,JV) JV = MEBCD(JV) - 31 IF (JV.GE.94) JV = 1 24 MTRAN(J) = JV #endif 26 IF (MTRAN(NTXL).EQ.1) THEN IF (NTXL.EQ.1) GO TO 41 NTXL = NTXL - 1 GO TO 26 ENDIF NCHL = NTXL * 14 C----- Print the 1+12+1 lines representing TEXT WRITE (LUN,9001) 9001 FORMAT (1X) DO 39 JLN=1,12 LINE(1:NCHL) = ' ' JCH = 1 DO 37 JTX=1,NTXL CHT = TEXT(JTX:JTX) JTB = MTRAN(JTX) CALL UPKBYT (MPAT(JLN,JTB),1,MBITS,12,0) JCH = JCH + 1 DO 35 J=1,12 IF (MBITS(J).NE.0) CHLINE(JCH) = CHT 35 JCH = JCH + 1 37 JCH = JCH + 1 N = LNBLNK (LINE(1:NCHL)) WRITE (LUN,9037) LINE(1:N) 9037 FORMAT (A) 39 CONTINUE WRITE (LUN,9001) RETURN C---- TEXT is empty 41 DO 44 J=1,14 WRITE (LUN,9001) 44 CONTINUE RETURN END