MINICERN/packlib/kernlib/kerngen/tcgen/vizpri.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:51  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE VIZPRI (LUNP,TEXT)
  11 C
  12 C CERN PROGLIB# J200    VIZPRI          .VERSION KERNFOR  4.22  890913
  13 C ORIG. 20/07/89, JZ
  14 C
  15 C-    Visual printing of TEXT
  16
  17       PARAMETER   (MXTEXT=9)
  18       PARAMETER   (MXCHAR=14*MXTEXT)
  19       CHARACTER    TEXT*(*)
  20       CHARACTER    LINE*(MXCHAR)
  21       CHARACTER    CHLINE(MXCHAR)*1
  22       EQUIVALENCE (CHLINE(1),LINE(1:1))
  23
  24       DIMENSION    MTRAN(MXTEXT), MBITS(12)
  25       CHARACTER    CHT*1
  26
  27 *     unit number for standard output
  28       PARAMETER    (LUNSTP=6)
  29       INTEGER      MPAT(12,93)
  30       DATA (MPAT(J, 1),J=1,12) /   0,   0,   0,   0,   0,   0,
  31      +                             0,   0,   0,   0,   0,   0 /
  32       DATA (MPAT(J, 2),J=1,12) /  96,  96,  96,  96,  96,  96,
  33      +                            96,  96,   0,   0,  96,  96 /
  34       DATA (MPAT(J, 3),J=1,12) / 408, 408, 408,   0,   0,   0,
  35      +                             0,   0,   0,   0,   0,   0 /
  36       DATA (MPAT(J, 4),J=1,12) / 408, 408, 408,4095,4095, 408,
  37      +                           408,4095,4095, 408, 408, 408 /
  38       DATA (MPAT(J, 5),J=1,12) /  96,2046,3687,  99, 103,1022,
  39      +                          2044,3680,3168,3687,2046,  96 /
  40       DATA (MPAT(J, 6),J=1,12) /   0,1564, 788, 412, 192,  96,
  41      +                            48,  24, 460, 326, 451,   0 /
  42       DATA (MPAT(J, 7),J=1,12) / 120, 252, 204, 204, 252, 120,
  43      +                          3324,3526,1923,1795,4095,3326 /
  44       DATA (MPAT(J, 8),J=1,12) /  96,  96,  96,   0,   0,   0,
  45      +                             0,   0,   0,   0,   0,   0 /
  46       DATA (MPAT(J, 9),J=1,12) / 448,  96,  48,  48,  24,  24,
  47      +                            24,  24,  48,  48,  96, 448 /
  48       DATA (MPAT(J,10),J=1,12) /  56,  96, 192, 192, 384, 384,
  49      +                           384, 384, 192, 192,  96,  56 /
  50       DATA (MPAT(J,11),J=1,12) /  96,1638,1902,1020, 504,4095,
  51      +                          4095, 504,1020,1902,1638,  96 /
  52       DATA (MPAT(J,12),J=1,12) /   0,  96,  96,  96,  96,2046,
  53      +                          2046,  96,  96,  96,  96,   0 /
  54       DATA (MPAT(J,13),J=1,12) /   0,   0,   0,   0,   0,   0,
  55      +                             0,   0,   0,   0,  96,  48 /
  56       DATA (MPAT(J,14),J=1,12) /   0,   0,   0,   0,   0,2046,
  57      +                          2046,   0,   0,   0,   0,   0 /
  58       DATA (MPAT(J,15),J=1,12) /   0,   0,   0,   0,   0,   0,
  59      +                             0,   0,   0,   0,  96,  96 /
  60       DATA (MPAT(J,16),J=1,12) /   0,1536, 768, 384, 192,  96,
  61      +                            48,  24,  12,   6,   3,   0 /
  62       DATA (MPAT(J,17),J=1,12) /1020,2046,3075,3075,3075,3075,
  63      +                          3075,3075,3075,3075,2046,1020 /
  64       DATA (MPAT(J,18),J=1,12) /  96, 112, 120,  96,  96,  96,
  65      +                            96,  96,  96,  96,2046,2046 /
  66       DATA (MPAT(J,19),J=1,12) /2046,4095,3075,3072,3072,1536,
  67      +                           384,  96,  24,   6,4095,4095 /
  68       DATA (MPAT(J,20),J=1,12) /2046,4095,3075,3072,3072,1920,
  69      +                          1920,3072,3072,3075,4095,2046 /
  70       DATA (MPAT(J,21),J=1,12) / 448, 480, 432, 408, 396,4094,
  71      +                          4095, 384, 384, 384, 384, 384 /
  72       DATA (MPAT(J,22),J=1,12) /4095,4095,   3,   3,   3, 511,
  73      +                          1023,1536,3072,3072,4095,2047 /
  74       DATA (MPAT(J,23),J=1,12) /2046,4095,3075,   3,   3,2047,
  75      +                          4095,3075,3075,3075,4095,2046 /
  76       DATA (MPAT(J,24),J=1,12) /4095,2047, 771, 384, 192,  96,
  77      +                            96,  96,  96,  96,  96,  96 /
  78       DATA (MPAT(J,25),J=1,12) /2046,4095,3075,3075,1542,1020,
  79      +                          1020,1542,3075,3075,4095,2046 /
  80       DATA (MPAT(J,26),J=1,12) /2046,4095,3075,3075,3075,4095,
  81      +                          4095,3072,3072,3075,4095,2046 /
  82       DATA (MPAT(J,27),J=1,12) /   0,   0,   0,  96,  96,   0,
  83      +                             0,  96,  96,   0,   0,   0 /
  84       DATA (MPAT(J,28),J=1,12) /   0,   0,   0,   0,   0,   0,
  85      +                             0,  96,   0,  96,  96,  48 /
  86       DATA (MPAT(J,29),J=1,12) / 384, 192,  96,  48,  24,  12,
  87      +                            12,  24,  48,  96, 192, 384 /
  88       DATA (MPAT(J,30),J=1,12) /   0,   0,   0,2046,2046,   0,
  89      +                             0,2046,2046,   0,   0,   0 /
  90       DATA (MPAT(J,31),J=1,12) /  24,  48,  96, 192, 384, 768,
  91      +                           768, 384, 192,  96,  48,  24 /
  92       DATA (MPAT(J,32),J=1,12) /2046,4095,3075,3072,3584,2016,
  93      +                           992,  96,  96,   0,  96,  96 /
  94       DATA (MPAT(J,33),J=1,12) /2046,4095,3075,3315,3579,3483,
  95      +                          3483,3571,4083,1795,  63,  62 /
  96       DATA (MPAT(J,34),J=1,12) /2046,4095,3075,3075,3075,4095,
  97      +                          4095,3075,3075,3075,3075,3075 /
  98       DATA (MPAT(J,35),J=1,12) /2047,4095,3075,3075,1539,1023,
  99      +                          1023,1539,3075,3075,4095,2047 /
 100       DATA (MPAT(J,36),J=1,12) /2046,4095,3075,   3,   3,   3,
 101      +                             3,   3,   3,3075,4095,2046 /
 102       DATA (MPAT(J,37),J=1,12) / 511,1023,1539,3075,3075,3075,
 103      +                          3075,3075,3075,1539,1023, 511 /
 104       DATA (MPAT(J,38),J=1,12) /4095,4095,   3,   3,   3, 255,
 105      +                           255,   3,   3,   3,4095,4095 /
 106       DATA (MPAT(J,39),J=1,12) /4095,4095,   3,   3,   3, 255,
 107      +                           255,   3,   3,   3,   3,   3 /
 108       DATA (MPAT(J,40),J=1,12) /2046,4095,3075,   3,   3,   3,
 109      +                          3971,3971,3075,3075,4095,2046 /
 110       DATA (MPAT(J,41),J=1,12) /3075,3075,3075,3075,3075,4095,
 111      +                          4095,3075,3075,3075,3075,3075 /
 112       DATA (MPAT(J,42),J=1,12) /2046,2046,  96,  96,  96,  96,
 113      +                            96,  96,  96,  96,2046,2046 /
 114       DATA (MPAT(J,43),J=1,12) /4092,4092, 192, 192, 192, 192,
 115      +                           192, 192, 195, 195, 255, 126 /
 116       DATA (MPAT(J,44),J=1,12) /3075,1539, 771, 387, 195, 127,
 117      +                           127, 195, 387, 771,1539,3075 /
 118       DATA (MPAT(J,45),J=1,12) /   3,   3,   3,   3,   3,   3,
 119      +                             3,   3,   3,   3,4095,4095 /
 120       DATA (MPAT(J,46),J=1,12) /3075,3591,3855,3483,3315,3171,
 121      +                          3075,3075,3075,3075,3075,3075 /
 122       DATA (MPAT(J,47),J=1,12) /3075,3079,3087,3099,3123,3171,
 123      +                          3267,3459,3843,3587,3075,2051 /
 124       DATA (MPAT(J,48),J=1,12) /4095,4095,3075,3075,3075,3075,
 125      +                          3075,3075,3075,3075,4095,4095 /
 126       DATA (MPAT(J,49),J=1,12) /2047,4095,3075,3075,3075,4095,
 127      +                          2047,   3,   3,   3,   3,   3 /
 128       DATA (MPAT(J,50),J=1,12) /2046,4095,3075,3075,3075,3075,
 129      +                          3075,3267,3459,3843,2047,3582 /
 130       DATA (MPAT(J,51),J=1,12) /2047,4095,3075,3075,3075,4095,
 131      +                          2047, 195, 387, 771,1539,3075 /
 132       DATA (MPAT(J,52),J=1,12) /2046,4095,3075,   3,   7,1022,
 133      +                          2044,3584,3072,3075,4095,2046 /
 134       DATA (MPAT(J,53),J=1,12) /4095,4095,  96,  96,  96,  96,
 135      +                            96,  96,  96,  96,  96,  96 /
 136       DATA (MPAT(J,54),J=1,12) /3075,3075,3075,3075,3075,3075,
 137      +                          3075,3075,3075,3075,4095,2046 /
 138       DATA (MPAT(J,55),J=1,12) /3075,3075,3075,3075,3075,3075,
 139      +                          3075,1542, 780, 408, 240,  96 /
 140       DATA (MPAT(J,56),J=1,12) /3075,3075,3075,3075,3075,3075,
 141      +                          3171,3315,3483,3855,3591,3075 /
 142       DATA (MPAT(J,57),J=1,12) /3075,3075,1542, 780, 408, 240,
 143      +                           240, 408, 780,1542,3075,3075 /
 144       DATA (MPAT(J,58),J=1,12) /3075,3075,1542, 780, 408, 240,
 145      +                            96,  96,  96,  96,  96,  96 /
 146       DATA (MPAT(J,59),J=1,12) /4095,4095,1536, 768, 384, 192,
 147      +                            96,  48,  24,  12,4094,4095 /
 148       DATA (MPAT(J,60),J=1,12) /1020,  12,  12,  12,  12,  12,
 149      +                            12,  12,  12,  12,  12,1020 /
 150       DATA (MPAT(J,61),J=1,12) /   0,   6,  12,  24,  48,  96,
 151      +                           192, 384, 768,1536,3072,   0 /
 152       DATA (MPAT(J,62),J=1,12) /1020, 768, 768, 768, 768, 768,
 153      +                           768, 768, 768, 768, 768,1020 /
 154       DATA (MPAT(J,63),J=1,12) /  96, 240, 408, 780,   0,   0,
 155      +                             0,   0,   0,   0,   0,   0 /
 156       DATA (MPAT(J,64),J=1,12) /   0,   0,   0,   0,   0,   0,
 157      +                             0,   0,   0,   0,4095,4095 /
 158       DATA (MPAT(J,65),J=1,12) /  48,  96, 192,   0,   0,   0,
 159      +                             0,   0,   0,   0,   0,   0 /
 160       DATA (MPAT(J,66),J=1,12) /2046,4095,3075,3075,3075,4095,
 161      +                          4095,3075,3075,3075,3075,3075 /
 162       DATA (MPAT(J,67),J=1,12) /2047,4095,3075,3075,1539,1023,
 163      +                          1023,1539,3075,3075,4095,2047 /
 164       DATA (MPAT(J,68),J=1,12) /2046,4095,3075,   3,   3,   3,
 165      +                             3,   3,   3,3075,4095,2046 /
 166       DATA (MPAT(J,69),J=1,12) / 511,1023,1539,3075,3075,3075,
 167      +                          3075,3075,3075,1539,1023, 511 /
 168       DATA (MPAT(J,70),J=1,12) /4095,4095,   3,   3,   3, 255,
 169      +                           255,   3,   3,   3,4095,4095 /
 170       DATA (MPAT(J,71),J=1,12) /4095,4095,   3,   3,   3, 255,
 171      +                           255,   3,   3,   3,   3,   3 /
 172       DATA (MPAT(J,72),J=1,12) /2046,4095,3075,   3,   3,   3,
 173      +                          3971,3971,3075,3075,4095,2046 /
 174       DATA (MPAT(J,73),J=1,12) /3075,3075,3075,3075,3075,4095,
 175      +                          4095,3075,3075,3075,3075,3075 /
 176       DATA (MPAT(J,74),J=1,12) /2046,2046,  96,  96,  96,  96,
 177      +                            96,  96,  96,  96,2046,2046 /
 178       DATA (MPAT(J,75),J=1,12) /4092,4092, 192, 192, 192, 192,
 179      +                           192, 192, 195, 195, 255, 126 /
 180       DATA (MPAT(J,76),J=1,12) /3075,1539, 771, 387, 195, 127,
 181      +                           127, 195, 387, 771,1539,3075 /
 182       DATA (MPAT(J,77),J=1,12) /   3,   3,   3,   3,   3,   3,
 183      +                             3,   3,   3,   3,4095,4095 /
 184       DATA (MPAT(J,78),J=1,12) /3075,3591,3855,3483,3315,3171,
 185      +                          3075,3075,3075,3075,3075,3075 /
 186       DATA (MPAT(J,79),J=1,12) /3075,3079,3087,3099,3123,3171,
 187      +                          3267,3459,3843,3587,3075,2051 /
 188       DATA (MPAT(J,80),J=1,12) /4095,4095,3075,3075,3075,3075,
 189      +                          3075,3075,3075,3075,4095,4095 /
 190       DATA (MPAT(J,81),J=1,12) /2047,4095,3075,3075,3075,4095,
 191      +                          2047,   3,   3,   3,   3,   3 /
 192       DATA (MPAT(J,82),J=1,12) /2046,4095,3075,3075,3075,3075,
 193      +                          3075,3267,3459,3843,2047,3582 /
 194       DATA (MPAT(J,83),J=1,12) /2047,4095,3075,3075,3075,4095,
 195      +                          2047, 195, 387, 771,1539,3075 /
 196       DATA (MPAT(J,84),J=1,12) /2046,4095,3075,   3,   7,1022,
 197      +                          2044,3584,3072,3075,4095,2046 /
 198       DATA (MPAT(J,85),J=1,12) /4095,4095,  96,  96,  96,  96,
 199      +                            96,  96,  96,  96,  96,  96 /
 200       DATA (MPAT(J,86),J=1,12) /3075,3075,3075,3075,3075,3075,
 201      +                          3075,3075,3075,3075,4095,2046 /
 202       DATA (MPAT(J,87),J=1,12) /3075,3075,3075,3075,3075,3075,
 203      +                          3075,1542, 780, 408, 240,  96 /
 204       DATA (MPAT(J,88),J=1,12) /3075,3075,3075,3075,3075,3075,
 205      +                          3171,3315,3483,3855,3591,3075 /
 206       DATA (MPAT(J,89),J=1,12) /3075,3075,1542, 780, 408, 240,
 207      +                           240, 408, 780,1542,3075,3075 /
 208       DATA (MPAT(J,90),J=1,12) /3075,3075,1542, 780, 408, 240,
 209      +                            96,  96,  96,  96,  96,  96 /
 210       DATA (MPAT(J,91),J=1,12) /4095,4095,1536, 768, 384, 192,
 211      +                            96,  48,  24,  12,4094,4095 /
 212       DATA (MPAT(J,92),J=1,12) /   0,   0,   0,   0,   0,   0,
 213      +                             0,   0,   0,   0,   0,   0 /
 214       DATA (MPAT(J,93),J=1,12) /  96,  96,  96,  96,  96,  96,
 215      +                            96,  96,  96,  96,  96,  96 /
 216 #if defined(CERNLIB_QEBCDIC)
 217 C--                 EBCDIC to ASCII translation table
 218       DIMENSION    MEBCD(188)
 219 C-    ?     ?  ?  ?  ?  ?  ?  ?  ?    ?  ?  .  <  (  +  |  &  ?  ?
 220 C-    ?  ?  ?  ?  ?  ?  ?  !  $  *    )  ;  ~  -  /  ?  ?  ?  ?  ?
 221 C-    ?  ?  ?  ^  ,  %  _  >  ?  ?    ?  ?  ?  ?  ?  ?  ?  ?  `  :
 222 C-    #  @  '  =  "  ?  a  b  c  d    e  f  g  h  i  ?  {  ?  ?  ?
 223 C-    ?  ?  j  k  l  m  n  o  p  q    r  ?  }  ?  ?  ?  ?  ?  ?  s
 224 C-    t  u  v  w  x  y  z  ?  ?  ?    [  ?  ?  ?  ?  ?  ?  ?  ?  ?
 225 C-    ?  ?  ?  ?  ?  ?  ]  ?  ?  ?    A  B  C  D  E  F  G  H  I  ?
 226 C-    ?  ?  ?  ?  ?  ?  J  K  L  M    N  O  P  Q  R  ?  ?  ?  ?  ?
 227 C-    ?  \  ?  S  T  U  V  W  X  Y    Z  ?  ?  ?  ?  ?  ?  0  1  2
 228 C-    3  4  5  6  7  8  9
 229
 230       DATA MEBCD /  32, 32, 32, 32, 32, 32, 32, 32, 32, 32
 231      +,             32, 32, 46, 60, 40, 43,124, 38, 32, 32
 232      +,             32, 32, 32, 32, 32, 32, 32, 33, 36, 42
 233      +,             41, 59,126, 45, 47, 32, 32, 32, 32, 32
 234      +,             32, 32, 32, 94, 44, 37, 95, 62, 63, 32
 235      +,             32, 32, 32, 32, 32, 32, 32, 32, 96, 58
 236      +,             35, 64, 39, 61, 34, 32, 97, 98, 99,100
 237      +,            101,102,103,104,105, 32,123, 32, 32, 32
 238      +,             32, 32,106,107,108,109,110,111,112,113
 239      +,            114, 32,125, 32, 32, 32, 32, 32, 32,115
 240      +,            116,117,118,119,120,121,122, 32, 32, 32
 241      +,             91, 32, 32, 32, 32, 32, 32, 32, 32, 32
 242      +,             32, 32, 32, 32, 32, 32, 93, 32, 32, 32
 243      +,             65, 66, 67, 68, 69, 70, 71, 72, 73, 32
 244      +,             32, 32, 32, 32, 32, 32, 74, 75, 76, 77
 245      +,             78, 79, 80, 81, 82, 32, 32, 32, 32, 32
 246      +,             32, 92, 32, 83, 84, 85, 86, 87, 88, 89
 247      +,             90, 32, 32, 32, 32, 32, 32, 48, 49, 50
 248      +,             51, 52, 53, 54, 55, 56, 57, 32 /
 249 #endif
 250
 251
 252       LUN = LUNP
 253       IF (LUN.EQ.0)  LUN = LUNSTP
 254
 255       NTXL = MIN (MXTEXT, LEN(TEXT))
 256       IF (NTXL.LE.0)               GO TO 41
 257
 258 C----              Translate TEXT to table pointers
 259
 260 #if defined(CERNLIB_QASCII)
 261       DO 24  J=1,NTXL
 262       JV = ICHAR(TEXT(J:J))
 263       JV = MAX (JV-31, 1)
 264       IF (JV.GE.94)  JV = 1
 265    24 MTRAN(J) = JV
 266 #endif
 267 #if defined(CERNLIB_QEBCDIC)
 268       DO 24  J=1,NTXL
 269       JV = ICHAR(TEXT(J:J))
 270       JV = MAX (JV-62, 1)
 271       JV = MIN (188,JV)
 272       JV = MEBCD(JV) - 31
 273       IF (JV.GE.94)  JV = 1
 274    24 MTRAN(J) = JV
 275 #endif
 276
 277    26 IF (MTRAN(NTXL).EQ.1)  THEN
 278           IF (NTXL.EQ.1)           GO TO 41
 279           NTXL = NTXL - 1
 280           GO TO 26
 281         ENDIF
 282       NCHL = NTXL * 14
 283
 284 C-----             Print the 1+12+1 lines representing TEXT
 285
 286       WRITE (LUN,9001)
 287  9001 FORMAT (1X)
 288
 289       DO 39  JLN=1,12
 290       LINE(1:NCHL) = ' '
 291       JCH = 1
 292
 293       DO 37  JTX=1,NTXL
 294       CHT = TEXT(JTX:JTX)
 295       JTB = MTRAN(JTX)
 296       CALL UPKBYT (MPAT(JLN,JTB),1,MBITS,12,0)
 297
 298       JCH = JCH + 1
 299       DO 35  J=1,12
 300       IF (MBITS(J).NE.0)  CHLINE(JCH) = CHT
 301    35 JCH = JCH + 1
 302    37 JCH = JCH + 1
 303
 304       N = LNBLNK (LINE(1:NCHL))
 305       WRITE (LUN,9037) LINE(1:N)
 306  9037 FORMAT (A)
 307
 308    39 CONTINUE
 309       WRITE (LUN,9001)
 310       RETURN
 311
 312 C----              TEXT is empty
 313
 314    41 DO 44 J=1,14
 315       WRITE (LUN,9001)
 316    44 CONTINUE
 317       RETURN
 318       END