      SUBROUTINE TEXT1
CRENBR(RENBRSTART)(TEXT1/LETTERS 9 WIDE BY 5 HIGH)
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD( 672)
      DIMENSION JLETTR(47),JLETT1(47)
      DIMENSION JLNGTH(47),JLNGT1(47)
      DIMENSION JPACKD(235),JPACK1( 80),JPAC81( 80),
     1          JPA161( 75)
      EQUIVALENCE           (LETTER(1),JLETTR(1)),
     1(LENGTH(1),JLNGTH(1)),(IPACKD(1),JPACKD(1))
      EQUIVALENCE (JLETT1(1),JLETTR(1))
      EQUIVALENCE (JLNGT1(1),JLNGTH(1))
      EQUIVALENCE (JPACK1(1),JPACKD(  1)),
     1            (JPAC81(1),JPACKD( 81)),
     2            (JPA161(1),JPACKD(161))
      DATA JLETT1/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ,1H0,1H1,1H2,1H3,
     3            1H4,1H5,1H6,1H7,1H8,1H9,1H(,1H*,1H/,1H+,
     4            1H-,1H=,1H),1H:,1H',1H.,1H,/
      DATA JLNGT1/ 9, 9, 9, 9, 9, 9, 9, 9, 7, 9, 9, 9,11,
     1             9, 9, 9,11, 9, 9, 9, 9, 9,11, 9, 9, 9,
     2             9, 5, 9, 9, 9, 9, 9, 9, 9, 9, 5, 9, 7,
     3             9, 9, 9, 5, 2, 2, 2, 2/
      DATA JPACK1/  56, 238, 455, 511, 455, 511, 455, 508,
     1             455, 511, 511, 448, 448, 448, 511, 508,
     2             455, 455, 455, 508, 511, 448, 504, 448,
     3             511, 511, 448, 504, 448, 448, 511, 448,
     4             463, 455, 511, 455, 455, 511, 455, 455,
     5             127,  28,  28,  28, 127,   7,   7,   7,
     6             455, 511, 455, 462, 508, 462, 455, 448,
     7             448, 448, 448, 511,1799,1935,1879,1831,
     8            1799, 455, 487, 471, 463, 455, 511, 455,
     9             455, 455, 511, 511, 455, 511, 448, 448/
      DATA JPAC81/2044,1820,1820,1820,2047, 511, 455, 508,
     1             462, 455, 254, 448, 254,   7, 510, 511,
     2              56,  56,  56,  56, 455, 455, 455, 455,
     3             511, 455, 455, 238, 124,  56,1799,1831,
     4            1879,1935,1799, 455, 238,  56, 238, 455,
     5             455, 238,  56,  56,  56, 511,  14,  56,
     6             224, 511, 511, 455, 455, 455, 511,   7,
     7              31,   7,   7,   7, 511,   7, 127, 448,
     8             511, 511,   7,  28,   7, 511, 119, 231,
     9             511,   7,   7, 511, 448, 508,   7, 511/
      DATA JPA161/ 112, 224, 511, 455, 511, 511,  14,  28,
     1              56, 112, 511, 455, 124, 455, 511, 511,
     2             455, 511,  14,  28,   7,  28,  28,  28,
     3               7, 238,  56, 511,  56, 238,   7,  14,
     4              28,  56, 112,  56,  56, 511,  56,  56,
     5               0,   0, 511,   0,   0,   0, 511,   0,
     6             511,   0,  28,   7,   7,   7,  28,   3,
     7               3,   0,   3,   3,   3,   3,   1,   0,
     8               0,   0,   0,   0,   3,   3,   0,   0,
     9               3,   3,   1/
      DATA KNTLTR,IHIGH,IWIDE,JWIDE,LOCK/ 47, 5, 9,11,999/
      RETURN
C767780423690:'
      END
      SUBROUTINE TEXT2
CRENBR(RENBRSTART)(TEXT2/LETTERS 5 WIDE BY 5 HIGH)
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD( 672)
      DIMENSION JLETTR(58),JLETT1(58)
      DIMENSION JLNGTH(58),JLNGT1(58)
      DIMENSION JPACKD(290),JPACK1(130),JPA131(130),
     1          JPA261( 30)
      EQUIVALENCE           (LETTER(1),JLETTR(1)),
     1(LENGTH(1),JLNGTH(1)),(IPACKD(1),JPACKD(1))
      EQUIVALENCE (JLETT1(1),JLETTR(1))
      EQUIVALENCE (JLNGT1(1),JLNGTH(1))
      EQUIVALENCE (JPACK1(1),JPACKD(  1)),
     1            (JPA131(1),JPACKD(131)),
     2            (JPA261(1),JPACKD(261))
      DATA JLETT1/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ,1H0,1H1,1H2,1H3,
     3            1H4,1H5,1H6,1H7,1H8,1H9,1H(,1H),1H+,1H-,
     4            1H*,1H/,1H.,1H,,1H',1H:,1H^,1H",1H#,1H$,
     5            1H%,1H&,1H=,1H<,1H>,1H?,1H@,1H!/
      DATA JLNGT1/5,5,5,5,5,5,5,5,3,5,5,5,5,5,5,5,5,5,5,5,
     1            5,5,5,5,5,5,5,3,5,5,5,5,5,5,5,5,3,3,5,5,
     2            5,5,2,2,2,2,5,5,5,5,5,5,5,3,3,5,5,1/
      DATA JPACK1/ 4,10,17,31,17,30,17,30,17,30,15,16,16,
     1            16,15,30,17,17,17,30,31,16,30,16,31,31,
     2            16,30,16,16,15,16,19,17,15,17,17,31,17,
     3            17, 7, 2, 2, 2, 7, 1, 1, 1,17,14,17,18,
     4            28,18,17,16,16,16,16,31,17,27,21,17,17,
     5            17,25,21,19,17,14,17,17,17,14,30,17,30,
     6            16,16,14,17,21,18,13,30,17,30,18,17,15,
     7            16,14, 1,30,31, 4, 4, 4, 4,17,17,17,17,
     8            14,17,17,17,10, 4,17,17,21,27,17,17,10,
     9             4,10,17,17,10, 4, 4, 4,31, 2, 4, 8,31/
      DATA JPA131/14,17,17,17,14, 6, 2, 2, 2, 7,30, 1,14,
     1            16,31,30, 1, 6, 1,30,17,17,31, 1, 1,31,
     2            16,30, 1,30, 4, 8,30,17,14,31, 2, 4, 8,
     3            16,14,17,14,17,14,14,17,15, 2, 4, 3, 4,
     4             4, 4, 3, 6, 1, 1, 1, 6, 0, 4,31, 4, 0,
     5             0, 0,31, 0, 0, 0,14,31,14, 0, 1, 2, 4,
     6             8,16, 0, 0, 0, 3, 3, 0, 0, 3, 3, 1, 3,
     7             3, 1, 0, 0, 3, 3, 0, 3, 3, 4,10,17, 0,
     8             0,27,27, 9, 0, 0,10,27, 0,27,10,15,20,
     9            14, 5,30,25,26, 4,11,19,28, 8,21,18,13/
      DATA JPA261/ 0,31, 0,31, 0, 1, 2, 4, 2, 1, 4, 2, 1,
     1             2, 4,30, 1, 6, 0, 4,14,17,19,19, 8, 1,
     2             1, 1, 0, 1/
      DATA KNTLTR,IHIGH,IWIDE,JWIDE,LOCK/ 58, 5, 5, 5,999/
      RETURN
C750874299490':^"#$%&<>?@!
      END
      SUBROUTINE TEXT3
CRENBR(RENBRSTART)(TEXT3/LETTERS 12 WIDE BY 11 HIGH)
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD( 672)
      DIMENSION JLETTR(59),JLETT1(59)
      DIMENSION JLNGTH(59),JLNGT1(59)
      DIMENSION JPACKD(649),JPACK1( 80),JPAC81( 80),
     1          JPA161( 80),JPA241( 80),JPA321( 80),
     2          JPA401( 80),JPA481( 80),JPA561( 80),
     3          JPA641(  9)
      EQUIVALENCE           (LETTER(1),JLETTR(1)),
     1(LENGTH(1),JLNGTH(1)),(IPACKD(1),JPACKD(1))
      EQUIVALENCE (JLETT1(1),JLETTR(1))
      EQUIVALENCE (JLNGT1(1),JLNGTH(1))
      EQUIVALENCE (JPACK1(1),JPACKD(  1)),
     1            (JPAC81(1),JPACKD( 81)),
     2            (JPA161(1),JPACKD(161)),
     3            (JPA241(1),JPACKD(241)),
     4            (JPA321(1),JPACKD(321)),
     5            (JPA401(1),JPACKD(401)),
     6            (JPA481(1),JPACKD(481)),
     7            (JPA561(1),JPACKD(561)),
     8            (JPA641(1),JPACKD(641))
      DATA JLETT1/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ,1H0,1H1,1H2,1H3,
     3            1H4,1H5,1H6,1H7,1H8,1H9,1H<,1H>,1H%,1H$,
     4            1H?,1H^,1H!,1H#,1H&,1H@,1H/,1H+,1H*,1H-,
     5            1H=,1H(,1H',1H:,1H",1H;,1H.,1H,,1H)/
      DATA JLNGT1/12,12,12,12,12,12,12,12, 6,12,12,12,12,
     1            12,12,12,12,12,12,12,12,12,12,12,12,12,
     2            12, 6,12,12,12,12,12,12,12,12,10,10,12,
     3            12,12,12, 4,12,12,12,12,12,12,12,12, 8,
     4             3, 4, 9, 4, 4, 3, 8/
      DATA JPACK1/  96, 240, 408, 780,1542,3075,3075,4095,
     1            3075,3075,3075,4088,3078,3075,3075,3078,
     2            4088,3078,3075,3075,3078,4088, 504,1542,
     3            3075,3072,3072,3072,3072,3072,3075,1542,
     4             504,4080,3084,3078,3075,3075,3075,3075,
     5            3075,3078,3084,4080,4095,3072,3072,3072,
     6            3072,4080,3072,3072,3072,3072,4095,4095,
     7            3072,3072,3072,3072,4080,3072,3072,3072,
     8            3072,3072, 504,1542,3075,3072,3072,3072,
     9            3103,3075,3075,1539, 511,3075,3075,3075/
      DATA JPAC81/3075,3075,4095,3075,3075,3075,3075,3075,
     1              63,  12,  12,  12,  12,  12,  12,  12,
     2              12,  12,  63,   3,   3,   3,   3,   3,
     3               3,   3,   3,3075,1542, 504,3084,3096,
     4            3120,3168,3264,3552,3888,3608,3084,3078,
     5            3075,3072,3072,3072,3072,3072,3072,3072,
     6            3072,3072,3072,4095,3075,3591,3855,3483,
     7            3315,3171,3075,3075,3075,3075,3075,3075,
     8            3587,3843,3459,3267,3171,3123,3099,3087,
     9            3079,3075, 504,1542,3075,3075,3075,3075/
      DATA JPA161/3075,3075,3075,1542, 504,4088,3078,3075,
     1            3075,3078,4088,3072,3072,3072,3072,3072,
     2             504,1542,3075,3075,3075,3075,3075,3097,
     3            3084,1542, 499,4088,3078,3075,3075,3078,
     4            4088,3120,3096,3084,3078,3075, 504,1542,
     5            3075,3072,1536, 504,   6,   3,3075,1542,
     6             504,4095,  96,  96,  96,  96,  96,  96,
     7              96,  96,  96,  96,3075,3075,3075,3075,
     8            3075,3075,3075,3075,3075,1542, 504,3075,
     9            3075,3075,3075,3075,3075,1542, 780, 408/
      DATA JPA241/ 240,  96,3075,3075,3075,3075,3075,3171,
     1            3315,3483,3855,3591,3075,3075,1542, 780,
     2             408, 240,  96, 240, 408, 780,1542,3075,
     3            3075,1542, 780, 408, 240,  96,  96,  96,
     4              96,  96,  96,4095,   6,  12,  24,  48,
     5              96, 192, 384, 768,1536,4095, 504,1542,
     6            3075,3075,3075,3075,3075,3075,3075,1542,
     7             504,  12,  28,  60,  12,  12,  12,  12,
     8              12,  12,  12,  63, 504,1542,3075,   3,
     9               6,  24,  96, 384,1536,3072,4095, 504/
      DATA JPA321/1542,3075,   3,   6, 248,   6,   3,3075,
     1            1542, 504,  48,  96, 192, 387, 771,1539,
     2            4095,   3,   3,   3,   3,4095,3072,3072,
     3            3072,3072,4088,   6,   3,   3,   6,4088,
     4              24,  48,  96, 192, 384,1016,1542,3075,
     5            3075,1542, 504,4095,   6,  12,  24,  48,
     6              96,  96,  96,  96,  96,  96, 504,1542,
     7            3075,3075,1542, 504,1542,3075,3075,1542,
     8             504, 504,1542,3075,3075,1542, 508,  24,
     9              48,  96, 192, 384,   0,   3,  12,  48/
      DATA JPA401/ 192, 768, 192,  48,  12,   3,   0,   0,
     1             768, 192,  48,  12,   3,  12,  48, 192,
     2             768,   0,1795,2182,2188,1816,  48,  96,
     3             192, 398, 785,1553,3086,  96,  96,1023,
     4            3168,3168,1020,  99,  99,4092,  96,  96,
     5            4088,   6,   3,   3,   6, 504, 384,   0,
     6             384, 960, 384,  96, 240, 408, 780,1542,
     7            3075,   0,   0,   0,   0,   0,   6,   6,
     8               6,   6,   6,   6,   6,   0,   6,  15,
     9               6, 408, 408, 408,3999,   0,   0,   0/
      DATA JPA481/3999, 408, 408, 408, 480, 816, 816, 480,
     1             192, 480, 816,1563,3084,3126,1987, 504,
     2            1542,3075,3171,3219,3219,3219,3198,3072,
     3            1536, 511,   3,   6,  12,  24,  48,  96,
     4             192, 384, 768,1536,3072,   0,   0,  96,
     5              96,  96,4095,  96,  96,  96,   0,   0,
     6               0,   0, 780, 408, 240,4095, 240, 408,
     7             780,   0,   0,   0,   0,   0,   0,   0,
     8            4095,   0,   0,   0,   0,   0,   0,   0,
     9               0,4095,   0,   0,   0,4095,   0,   0/
      DATA JPA561/   0,  15,  56,  96, 192, 192, 192, 192,
     1             192,  96,  56,  15,   6,   7,   3,   6,
     2               0,   0,   0,   0,   0,   0,   0,   6,
     3              15,   6,   0,   0,   0,   0,   0,   6,
     4              15,   6, 390, 455, 195, 390,   0,   0,
     5               0,   0,   0,   0,   0,   6,  15,   6,
     6               0,   0,   0,   0,   6,   7,   3,   6,
     7               0,   0,   0,   0,   0,   0,   0,   0,
     8               6,  15,   6,   0,   0,   0,   0,   0,
     9               0,   0,   6,   7,   3,   6, 240,  28/
      DATA JPA641/   6,   3,   3,   3,   3,   3,   6,  28,
     1             240/
      DATA KNTLTR,IHIGH,IWIDE,JWIDE,LOCK/ 59,11,12,12,999/
      RETURN
C330359958028<>%$?^!#&@':";
      END
      SUBROUTINE TEXT4
CRENBR(RENBRSTART)(TEXT4/LETTERS 7 HIGH BY 9 WIDE)
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD( 672)
      DIMENSION JLETTR(54),JLETT1(54)
      DIMENSION JLNGTH(54),JLNGT1(54)
      DIMENSION JPACKD(378),JPACK1(100),JPA101(100),
     1          JPA201(100),JPA301( 78)
      EQUIVALENCE           (LETTER(1),JLETTR(1)),
     1(LENGTH(1),JLNGTH(1)),(IPACKD(1),JPACKD(1))
      EQUIVALENCE (JLETT1(1),JLETTR(1))
      EQUIVALENCE (JLNGT1(1),JLNGTH(1))
      EQUIVALENCE (JPACK1(1),JPACKD(  1)),
     1            (JPA101(1),JPACKD(101)),
     2            (JPA201(1),JPACKD(201)),
     3            (JPA301(1),JPACKD(301))
      DATA JLETT1/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HY,1HX,1HZ,1H0,1H1,1H2,1H3,
     3            1H4,1H5,1H6,1H7,1H8,1H9,1H(,1H+,1H-,1H*,
     4            1H/,1H=,1H.,1H,,1H',1H),1H^,1H?,1H<,1H>,
     5            1H#,1H:,1H;,1H!/
      DATA JLNGT1/ 9, 8, 8, 8, 8, 8, 8, 8, 6, 8, 8, 8,10,
     1             8, 9, 8, 9, 8, 8, 8, 8, 8,10, 8, 8, 8,
     2             8, 4, 8, 8, 8, 8, 8, 8, 8, 8, 5, 8, 8,
     3             8, 8, 8, 2, 3, 3, 5, 8, 8, 6, 6, 8, 2,
     4             3, 2/
      DATA JPACK1/  7, 15, 27, 51,127,195,387,252,195,195,
     1            252,195,195,252, 31, 96,192,192,192, 96,
     2             31,248,198,195,195,195,198,248,255,192,
     3            192,248,192,192,255,255,192,192,248,192,
     4            192,192, 31, 96,192,207,195, 99, 31,195,
     5            195,195,255,195,195,195, 63, 12, 12, 12,
     6             12, 12, 63,  3,  3,  3,  3,195,102, 60,
     7            198,204,216,248,236,198,195,192,192,192,
     8            192,192,192,255,771,903,975,891,819,771,
     9            771,195,227,243,219,207,199,195,124,198/
      DATA JPA101/387,387,387,198,124,252,195,195,252,192,
     1            192,192,124,198,387,411,397,198,123,252,
     2            195,195,252,204,198,195, 63,192,192, 60,
     3              3,  3,252,255, 24, 24, 24, 24, 24, 24,
     4            195,195,195,195,195,102, 60,195,198,204,
     5            216,240,224,192,771,771,819,891,975,903,
     6            771,195,102, 60, 24, 24, 24, 24,195,102,
     7             60, 24, 60,102,195,255,  6, 12, 24, 48,
     8             96,255, 60,102,195,195,195,102, 60,  3,
     9             15,  3,  3,  3,  3,  3,252,  3,  3, 60/
      DATA JPA201/192,192,255,252,  3,  3, 60,  3,  3,252,
     1             15, 27, 51, 99,255,  3,  3,255,192,192,
     2            252,  3,  3,252, 12, 24, 48,124,195,195,
     3             60,255,  3,  6, 12, 24, 24, 24, 60,195,
     4            195, 60,195,195, 60, 60,195,195, 62, 12,
     5             24, 48,  3, 12, 24, 24, 24, 12,  3,  0,
     6             24, 24,255, 24, 24,  0,  0,  0,  0,255,
     7              0,  0,  0,  0,102, 60,255, 60,102,  0,
     8              3,  6, 12, 24, 48, 96,192,  0,  0,255,
     9              0,255,  0,  0,  0,  0,  0,  0,  0,  3/
      DATA JPA301/  3,  0,  0,  0,  0,  7,  3,  6,  7,  3,
     1              6,  0,  0,  0,  0, 24,  6,  3,  3,  3,
     2              6, 24, 24, 60,102,195,  0,  0,  0,252,
     3              3,  3, 28,  0, 24, 24,  0,  3, 12, 48,
     4             12,  3,  0,  0, 48, 12,  3, 12, 48,  0,
     5            102,102,231,  0,231,102,102,  3,  3,  0,
     6              0,  0,  3,  3,  3,  3,  0,  0,  7,  3,
     7              6,  3,  3,  3,  3,  0,  3,  3/
      DATA KNTLTR,IHIGH,IWIDE,JWIDE,LOCK/ 54, 7, 8,10,999/
      RETURN
C383688310881'^?<>#:;!
      END
      SUBROUTINE TEXT5
CRENBR(TEXT5/LETTERS 14 WIDE BY 9 HIGH)
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD(1020)
      DIMENSION JLETTR(85),JLETT1(85)
      DIMENSION JLNGTH(85),JLNGT1(85)
      DIMENSION JPACKD(1020),JPACK1(  50),JPAC51(  50),
     1          JPA101(  50),JPA151(  50),JPA201(  50),
     2          JPA251(  50),JPA301(  50),JPA351(  50),
     3          JPA401(  50),JPA451(  50),JPA501(  50),
     4          JPA551(  50),JPA601(  50),JPA651(  50),
     5          JPA701(  50),JPA751(  50),JPA801(  50),
     6          JPA851(  50),JPA901(  50),JPA951(  50),
     7          JP1001(  20)
      EQUIVALENCE           (LETTER(1),JLETTR(1)),
     1(LENGTH(1),JLNGTH(1)),(IPACKD(1),JPACKD(1))
      EQUIVALENCE (JLETT1(1),JLETTR(1))
      EQUIVALENCE (JLNGT1(1),JLNGTH(1))
      EQUIVALENCE (JPACK1(1),JPACKD(   1)),
     1            (JPAC51(1),JPACKD(  51)),
     2            (JPA101(1),JPACKD( 101)),
     3            (JPA151(1),JPACKD( 151)),
     4            (JPA201(1),JPACKD( 201)),
     5            (JPA251(1),JPACKD( 251)),
     6            (JPA301(1),JPACKD( 301)),
     7            (JPA351(1),JPACKD( 351)),
     8            (JPA401(1),JPACKD( 401)),
     9            (JPA451(1),JPACKD( 451))
      EQUIVALENCE (JPA501(1),JPACKD( 501)),
     1            (JPA551(1),JPACKD( 551)),
     2            (JPA601(1),JPACKD( 601)),
     3            (JPA651(1),JPACKD( 651)),
     4            (JPA701(1),JPACKD( 701)),
     5            (JPA751(1),JPACKD( 751)),
     6            (JPA801(1),JPACKD( 801)),
     7            (JPA851(1),JPACKD( 851)),
     8            (JPA901(1),JPACKD( 901)),
     9            (JPA951(1),JPACKD( 951))
      EQUIVALENCE (JP1001(1),JPACKD(1001))
      DATA JLETT1/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ,1HA,1HB,1HC,1HD,
     3            1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN,
     4            1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,
     5            1HY,1HZ,1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,
     6            1H8,1H9,1H;,1H.,1H:,1H!,1H,,1H",1H/,1H+,
     7            1H*,1H-,1H',1H),1H(,1H=,1H#,1H^,1H<,1H>,
     8            1H?,1H&,1H%,1H$,1H@/
      DATA JLNGT1/14,14,14,14,14,14,14,14, 8,14,14,14,14,
     1            14,14,14,14,14,14,14,14,14,14,14,14,14,
     2            12,12,12,12,12,12,12,12, 4, 8,12, 4,20,
     3            12,12,12,12,12,12,12,12,12,20,12,12,12,
     4            14, 7,14,14,14,14,14,14,14,14, 4, 4, 4,
     5             4, 3,10,12,14,14,14, 3,10,10,14,14,14,
     6            10,10,14,14,14,14,14/
      DATA JPACK1/    192,    480,   1008,   1656,   3132,
     1               6174,  16383,  12303,  12303,      0,
     2                  0,      0,  16368,  15422,  15375,
     3              15422,  16368,  15422,  15375,  15422,
     4              16368,      0,      0,      0,   1023,
     5               7936,  15360,  15360,  15360,  15360,
     6              15360,   7936,   1023,      0,      0,
     7                  0,  16320,  15608,  15390,  15375,
     8              15375,  15375,  15390,  15608,  16320,
     9                  0,      0,      0,  16383,  15360/
      DATA JPAC51/  15360,  15360,  16352,  15360,  15360,
     1              15360,  16383,      0,      0,      0,
     2              16383,  15360,  15360,  15360,  16352,
     3              15360,  15360,  15360,  15360,      0,
     4                  0,      0,   1023,   7936,  15360,
     5              15360,  15360,  15423,  15375,   7951,
     6               1023,      0,      0,      0,  15375,
     7              15375,  15375,  15375,  16383,  15375,
     8              15375,  15375,  15375,      0,      0,
     9                  0,    255,     60,     60,     60/
      DATA JPA101/     60,     60,     60,     60,    255,
     1                  0,      0,      0,     15,     15,
     2                 15,     15,     15,  15375,  15375,
     3               7998,   1016,      0,      0,      0,
     4              15367,  15388,  15472,  15808,  16128,
     5              16320,  15600,  15420,  15375,      0,
     6                  0,      0,  15360,  15360,  15360,
     7              15360,  15360,  15360,  15360,  15360,
     8              16383,      0,      0,      0,  12303,
     9              14367,  15423,  15983,  14287,  13199/
      DATA JPA151/  12559,  12303,  12303,      0,      0,
     1                  0,  15875,  16131,  14211,  13251,
     2              12771,  12531,  12411,  12351,  12319,
     3                  0,      0,      0,   1008,   7998,
     4              15375,  15375,  15375,  15375,  15375,
     5               7998,   1008,      0,      0,      0,
     6              16368,  15422,  15375,  15375,  15422,
     7              16368,  15360,  15360,  15360,      0,
     8                  0,      0,   1008,   7998,  15375,
     9              15375,  15375,  15815,  15473,   7964/
      DATA JPA201/   1991,      0,      0,      0,  16368,
     1              15422,  15375,  15375,  15422,  16376,
     2              15420,  15390,  15375,      0,      0,
     3                  0,   1023,   7936,  15360,   7936,
     4               1008,     62,     15,     62,  16368,
     5                  0,      0,      0,  16383,    480,
     6                480,    480,    480,    480,    480,
     7                480,    480,      0,      0,      0,
     8              15363,  15363,  15363,  15363,  15363,
     9              15363,  15363,   7966,   1016,      0/
      DATA JPA251/      0,      0,  15363,  15363,  15363,
     1               7686,   3852,   1944,   1008,    480,
     2                192,      0,      0,      0,  15363,
     3              15363,  15395,  15475,  15611,  15775,
     4              16143,  15879,  15363,      0,      0,
     5                  0,  15366,   7692,   3864,   1968,
     6               1008,    888,   1596,   3102,   6159,
     7                  0,      0,      0,  15363,   7686,
     8               3852,   1944,   1008,    480,    480,
     9                480,    480,      0,      0,      0/
      DATA JPA301/  16383,     60,    120,    240,    480,
     1                960,   1920,   3840,  16383,      0,
     2                  0,      0,      0,      0,      0,
     3               2044,     15,   1023,   3855,   3855,
     4               1023,      0,      0,      0,   3840,
     5               3840,   3840,   4088,   3870,   3855,
     6               3855,   3870,   4088,      0,      0,
     7                  0,      0,      0,      0,    511,
     8               1920,   3840,   3840,   1920,    511,
     9                  0,      0,      0,     15,     15/
      DATA JPA351/     15,    511,   1935,   3855,   3855,
     1               1935,    511,      0,      0,      0,
     2                  0,      0,      0,    504,   1950,
     3               3855,   4095,   1920,    511,      0,
     4                  0,      0,     31,    120,    240,
     5               4095,    240,    240,    240,    240,
     6                240,      0,      0,      0,      0,
     7                  0,      0,    511,   1935,   3855,
     8               3855,   1935,    511,     15,     30,
     9               2040,   3840,   3840,   3840,   3900/
      DATA JPA401/   3966,   4047,   3983,   3855,   3855,
     1                  0,      0,      0,      6,     15,
     2                  6,      0,     15,     15,     15,
     3                 15,     15,      0,      0,      0,
     4                  6,     15,      6,      0,     15,
     5                 15,     15,     15,     15,     15,
     6                 30,    248,   3840,   3840,   3840,
     7               3868,   3952,   4032,   4080,   3900,
     8               3855,      0,      0,      0,     15,
     9                 15,     15,     15,     15,     15/
      DATA JPA451/     15,     15,     15,      0,      0,
     1                  0,      0,      0,      0, 998460,
     2            1015422,1036239,1019791, 986895, 986895,
     3                  0,      0,      0,      0,      0,
     4                  0,   3900,   3966,   4047,   3983,
     5               3855,   3855,      0,      0,      0,
     6                  0,      0,      0,    504,   1950,
     7               3855,   3855,   1950,    504,      0,
     8                  0,      0,      0,      0,      0,
     9               4088,   3870,   3855,   3855,   3870/
      DATA JPA501/   4088,   3840,   3840,   3840,      0,
     1                  0,      0,    511,   1935,   3855,
     2               3855,   1935,    511,     15,     15,
     3                 15,      0,      0,      0,   3871,
     4               3960,   4032,   3840,   3840,   3840,
     5                  0,      0,      0,      0,      0,
     6                  0,   1023,   3840,   2032,    254,
     7                 15,   4092,      0,      0,      0,
     8                240,    240,    240,   4095,    240,
     9                240,    240,    240,    240,      0/
      DATA JPA551/      0,      0,      0,      0,      0,
     1               3855,   3855,   3871,   3903,   2031,
     2                975,      0,      0,      0,      0,
     3                  0,      0,   3843,   1926,    972,
     4                504,    240,     96,      0,      0,
     5                  0,      0,      0,      0, 983811,
     6             493446, 249804, 129528,  61680,  24672,
     7                  0,      0,      0,      0,      0,
     8                  0,   3847,   1948,    496,    248,
     9                926,   3599,      0,      0,      0/
      DATA JPA601/      0,      0,      0,   3843,   1926,
     1                972,    504,    240,     96,    192,
     2                896,   3584,      0,      0,      0,
     3               4095,     30,    120,    480,   1920,
     4               4095,      0,      0,      0,   1008,
     5               7998,  15375,  15375,  15375,  15375,
     6              15375,   7998,   1008,      0,      0,
     7                  0,      3,     15,    127,     15,
     8                 15,     15,     15,     15,     15,
     9                  0,      0,      0,  16368,     62/
      DATA JPA651/     15,     62,   1008,   7936,  15360,
     1              15360,  16383,      0,      0,      0,
     2              16368,     62,     15,     62,   1008,
     3                 62,     15,     62,  16368,      0,
     4                  0,      0,    508,    828,   1596,
     5               3132,   6204,  16383,  16383,     60,
     6                 60,      0,      0,      0,  16383,
     7              15360,  15360,  16368,     62,     15,
     8                 15,     62,  16368,      0,      0,
     9                  0,     60,    480,   1920,   7680/
      DATA JPA701/  16368,  15422,  15375,   7998,   1008,
     1                  0,      0,      0,  16383,     15,
     2                 15,     30,     60,    120,    240,
     3                480,    960,      0,      0,      0,
     4               2040,   7694,  15367,   7950,   1008,
     5               7228,  14351,   7198,   2040,      0,
     6                  0,      0,   1008,   7998,  15375,
     7               7951,   1023,     30,    120,    480,
     8               3840,      0,      0,      0,      6,
     9                 15,      6,      0,      0,      6/
      DATA JPA751/      7,      3,      6,      0,      0,
     1                  0,      0,      0,      0,      0,
     2                  0,      0,      6,     15,      6,
     3                  0,      0,      0,      6,     15,
     4                  6,      0,      0,      0,      6,
     5                 15,      6,      0,      0,      0,
     6                 15,     15,     15,     15,     15,
     7                  0,      6,     15,      6,      0,
     8                  0,      0,      0,      0,      0,
     9                  0,      0,      6,      7,      3/
      DATA JPA801/      6,      0,      0,      0,    774,
     1                903,    387,    774,      0,      0,
     2                  0,      0,      0,      0,      0,
     3                  0,     15,     30,     60,    120,
     4                240,    480,    960,   1920,   3840,
     5                  0,      0,      0,      0,    480,
     6                480,    480,  16383,  16383,    480,
     7                480,    480,      0,      0,      0,
     8                  0,   3612,   1848,   1008,  16383,
     9              16383,   1008,   1848,   3612,      0/
      DATA JPA851/      0,      0,      0,      0,      0,
     1                  0,  16383,  16383,      0,      0,
     2                  0,      0,      0,      0,      6,
     3                  7,      3,      6,      0,      0,
     4                  0,      0,      0,      0,      0,
     5                  0,    992,    124,     30,     15,
     6                 15,     15,     30,    124,    992,
     7                  0,      0,      0,     31,    248,
     8                480,    960,    960,    960,    480,
     9                248,     31,      0,      0,      0/
      DATA JPA901/      0,  16383,  16383,      0,      0,
     1                  0,  16383,  16383,      0,      0,
     2                  0,      0,   3612,   3612,  16383,
     3               3612,   3612,   3612,  16383,   3612,
     4               3612,      0,      0,      0,    192,
     5               1008,   3900,  15375,      0,      0,
     6                  0,      0,      0,      0,      0,
     7                  0,      0,     15,     60,    240,
     8                960,    240,     60,     15,      0,
     9                  0,      0,      0,      0,    960/
      DATA JPA951/    240,     60,     15,     60,    240,
     1                960,      0,      0,      0,      0,
     2              16368,     62,     15,     62,   2032,
     3                  0,    768,   1920,    768,      0,
     4                  0,      0,   1016,   7680,   7680,
     5               2016,   7680,  15423,  15374,   7708,
     6               2032,      0,      0,      0,   7198,
     7              13884,  13944,   7408,    480,    974,
     8               1947,   3867,   7694,      0,      0,
     9                  0,    192,    192,   4095,  15360/
      DATA JP1001/   4092,     15,  16380,    192,    192,
     1                  0,      0,      0,   2040,   7182,
     2              12771,  13107,  13107,  13107,  12798,
     3               7168,   2047,      0,      0,      0/
      DATA KNTLTR,IHIGH,IWIDE,JWIDE,LOCK/ 85,12,14,20,999/
      RETURN
C974371065670;:!"'#^<>?&%$@
      END
      SUBROUTINE GETWRD(IPACKD,IBUFFR,MAXBFR,LOWBFR,KIND  )
C     RENBR(/GET NEXT WORD IN SINGLE LINE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TAKING AS INPUT LIST OF POSSIBLE WORDS
C     SUPPLIED IN MULTIPLE OF A5 FORMAT, AND MATCHES NEXT
C     WORD IN LINE OF TEXT READ WITH MULTIPLE OF A1 FORMAT
C
C     IPACKD = STRING OF WORDS SIMILAR TO '/YES NO/'
C              WHERE INITIAL CHARACTER WITHIN STRING
C              (HERE SLASH) ALSO MARKS END OF STRING.
C              STRING CAN CONTAIN AT MOST 20 WORDS FORMED
C              FROM TOTAL OF NO MORE THAN 100 CHARACTERS.
C     IBUFFR = TEXT TYPED BY USER READ BY MULTIPLE OF A1
C              FORMAT
C     MAXBFR = NUMBER OF CHARACTERS IN IBUFFR
C     LOWBFR = INITIALLY SHOULD BE INPUT CONTAINING ZERO
C              TO ALLOW INITIAL COMMA TO INDICATE MISSING
C              ITEM.  THEREAFTER SHOULD BE INPUT CONTAINING
C              SUBSCRIPT OF NEXT LOCATION IN IBUFFR ARRAY
C              WHICH IS TO BE EXAMINED.
C            = RETURNED POINTING TO NEXT CHARACTER NOT YET
C              EXAMINED.
C     KIND   = SEQUENCE NUMBER OF MATCHED WORD PLUS 3.
C            = 1, LINE IS EMPTY
C            = 2, ERROR MESSAGE TYPE TO USER
C            = 3, MISSING ITEM INDICATED BY EXTRA COMMA
C
      DIMENSION IPACKD(100),IBUFFR(MAXBFR),KNTLTR(20),
     1IWORD(100)
      DATA ITTY,LMTWRD,LMTKNT/5,100,20/
      DATA IWHAT/1H?/
C
C     CONSTRUCT A1 FORMAT DICTIONARY
      MAXWRD=0
      MAXKNT=0
      CALL A5TOA1(IPACKD,100,LMTWRD,LMTKNT,MAXWRD,MAXKNT,
     1IWORD,KNTLTR)
C
C     MATCH USER TYPED TEXT AGAINST A1 FORMAT DICTIONARY
      MANY=1
      IF(LOWBFR.GT.0)GO TO 1
      LOWBFR=1
      MANY=0
    1 LOCK=MANY
      CALL DALOSS(1,MAXWRD,IWORD,1,MAXKNT,
     1KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND,MATCH,LCNWRD,
     2LCNKNT,LCNBFR,MANY,LCNERR)
      GO TO(5,6,12,12,6,6,6,6,2,4,11),KIND
C
C     TREAT SEMICOLON LIKE COMMA
    2 IF(LOCK.EQ.0)GO TO 3
      MANY=-1
      GO TO 1
    3 LOWBFR=LOWBFR-1
      GO TO 11
C
C     BUFFER IS EMPTY
    4 IF(MANY.LT.0)GO TO 11
    5 KIND=1
      GO TO 13
C
C     UNKNOWN INITIAL CHARACTER
    6 LOWBFR=LCNERR
      LCNERR=LCNERR-1
      KIND=2
      WRITE(ITTY,7)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
    7 FORMAT(' ILLEGAL RESPONSE ',132A1)
      WRITE(ITTY,8)
    8 FORMAT(' RESPOND WITH ONE OF FOLLOWING')
      LTREND=0
      KNTEND=0
    9 KNTEND=KNTEND+1
      IF(KNTEND.GT.MAXKNT)GO TO 13
      LTRBGN=LTREND+1
      LTREND=LTREND+KNTLTR(KNTEND)
      WRITE(ITTY,10)(IWORD(I),I=LTRBGN,LTREND)
   10 FORMAT(3X,132A1)
      GO TO 9
C
C     MISSING WORD
   11 KIND=3
      GO TO 13
C
C     CORRECT MATCH FOUND
   12 KIND=MATCH+3
C
C     RETURN TO CALLING PROGRAM
   13 RETURN
C377634367196?'
      END
      SUBROUTINE GETNUM(KONTRL,IBUFFR,MAXBFR,LOWBFR,KIND  ,
     1    IVALUE,VALUE )
C     RENBR(/GET NEXT NUMBER IN SINGLE LINE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     KONTRL = 0, RETURN INTEGER AS ARGUMENT IVALUE
C            = 1, RETURN REAL NUMBER IN ARGUMENT VALUE
C     IBUFFR = TEXT TYPED BY USER READ WITH MULTIPLE OF A1
C              FORMAT
C     MAXBFR = NUMBER OF CHARACTERS IN IBUFFR
C     LOWBFR = INITIALLY SHOULD BE INPUT CONTAINING ZERO
C              TO ALLOW INITIAL COMMA TO INDICATE MISSING
C              ITEM.  THEREAFTER SHOULD BE INPUT CONTAINING
C              SUBSCRIPT OF NEXT LOCATION IN IBUFFR ARRAY
C              WHICH IS TO BE EXAMINED.
C            = RETURNED POINTING TO NEXT CHARACTER NOT YET
C              EXAMINED.
C     KIND   = 1, LINE IS EMPTY
C            = 2, ERROR MESSAGE TYPED TO USER
C            = 3, MISSING NUMBER
C            = 4, A NUMBER HAS BEEN EVALUATED
C     IVALUE = RETURNED CONTAINING INTEGER VALUE IF
C              KONTRL=0
C     VALUE  = RETURNED CONTAINING REAL VALUE IF KONTRL=1
C
      DIMENSION IBUFFR(MAXBFR)
      DATA IWHAT/1H?/
      DATA ITTY/5/
C
C     OBTAIN NEXT ITEM IN TEXT BUFFER
      MANY=1
      IF(LOWBFR.GT.0)GO TO 1
      LOWBFR=1
      MANY=0
    1 LOCK=MANY
      CALL DAMISS(KONTRL,1,0,IBUFFR,MAXBFR,
     1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE,MANY,LCNBFR,LCNERR)
      GO TO(5,12,6,6,2,4,14),KIND
C
C     TREAT SEMICOLON LIKE COMMA
    2 IF(LOCK.EQ.0)GO TO 3
      MANY=-1
      GO TO 1
    3 LOWBFR=LOWBFR-1
      GO TO 14
C
C     BUFFER IS EMPTY
    4 IF(MANY.LT.0)GO TO 14
    5 KIND=1
      GO TO 15
C
C     NUMBER FOUND
    6 IF(LSHIFT.LT.0)GO TO 8
      IF(KONTRL.GT.0)GO TO 7
      IF(KSHIFT.LT.0)GO TO 10
    7 KIND=4
      GO TO 15
C
C     ILLEGAL NUMBER REPRESENTATION
    8 LOWBFR=LCNERR
      LCNERR=LCNERR-1
      WRITE(ITTY,9)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
    9 FORMAT(' NUMBER REQUIRED BUT NO VALUE DIGITS IN ',
     1132A1)
      KIND=2
      GO TO 15
   10 LOWBFR=LCNERR
      LCNERR=LCNERR-1
      WRITE(ITTY,11)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
   11 FORMAT(' INTEGER REQUIRED BUT TENTHS SPECIFIED IN ',
     1132A1)
      KIND=2
      GO TO 15
C
C     UNKNOWN INITIAL CHARACTER
   12 LOWBFR=LCNERR
      LCNERR=LCNERR-1
      WRITE(ITTY,13)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
   13 FORMAT(' NUMBER EXPECTED BUT INSTEAD FOUND ',132A1)
      KIND=2
      GO TO 15
C
C     MISSING NUMBER
   14 KIND=3
C
C     RETURN TO CALLING PROGRAM
   15 RETURN
C372999423353?'
      END
      SUBROUTINE A5TOA1(IPACKD,LMTPKD,LMTWRD,LMTKNT,MAXWRD,
     1    MAXKNT,IWORD ,KNTLTR)
C     RENBR(/CONVERT A5 DEFINED ARRAY TO A1)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO RESTRUCTURE DICTIONARY, SPECIFIED AS WORDS
C     SEPARATED   BY   SPACES   CONTAINED  IN  SINGLE  LONG
C     HOLLERITH STRING OR IN SINGLE LONG TEXT STRING QUOTED
C     WITH   APOSTROPHES,   INTO   IWORD  ARRAY  OF  SINGLE
C     CHARACTERS AND INTO KNTLTR ARRAY OF CHARACTER  COUNTS
C     PER  WORD  NEEDED  BY  DAVERB.   SECOND APPEARANCE OF
C     FIRST PRINTING CHARACTER MARKS END OF STRING.
C
C     INEACH IS NUMBER OF CHARACTERS IN EACH HOLLERITH WORD
      DIMENSION IPACKD(LMTPKD),KNTLTR(LMTKNT),IWORD(LMTWRD)
      DATA INEACH/5/,IBLANK/1H /
      KNTPKD=0
      LOCAL=-1
      LIMIT=LMTPKD
C
C     GET NEXT GROUP OF CHARACTERS
    1 NEEDED=LMTWRD-MAXWRD
      IF(NEEDED.GT.INEACH)NEEDED=INEACH
      IF(NEEDED.GT.LIMIT)NEEDED=LIMIT
      IF(NEEDED.LE.0)GO TO 8
      KNTPKD=KNTPKD+1
      ISTART=MAXWRD+1
      IEND=MAXWRD+NEEDED
      LIMIT=LIMIT-NEEDED
C
C     READ ALPHAMERIC  INFORMATION FROM IPACKD(KNTPKD) INTO
C     IWORD(ISTART)  THROUGH IWORD(IEND)  VIA THE INDICATED
C     FORMAT.   NEEDED IS THE NUMBER OF CHARACTERS TO READ.
      DECODE(NEEDED,2,IPACKD(KNTPKD))
     1(IWORD(I),I=ISTART,IEND)
    2 FORMAT(100A1)
C
C     FIND WORDS OR DELIMITER CHARACTERS
    3 IF(ISTART.GT.IEND)GO TO 1
      IF(LOCAL.LT.0)GO TO 5
      IF(IWORD(ISTART).EQ.IFINAL)GO TO 8
      IF(IWORD(ISTART).EQ.IBLANK)GO TO 6
      IF(LOCAL.GT.0)GO TO 4
      IF(MAXKNT.GE.LMTKNT)GO TO 8
      MAXKNT=MAXKNT+1
      KNTLTR(MAXKNT)=0
      LOCAL=1
    4 KNTLTR(MAXKNT)=KNTLTR(MAXKNT)+1
      MAXWRD=MAXWRD+1
      IWORD(MAXWRD)=IWORD(ISTART)
      GO TO 7
    5 IF(IWORD(ISTART).EQ.IBLANK)GO TO 7
      IFINAL=IWORD(ISTART)
    6 LOCAL=0
    7 ISTART=ISTART+1
      GO TO 3
    8 RETURN
C283250238701
      END
      SUBROUTINE DAHELP(IBUFFR,MAXBFR,LOWBFR,IQUERY)
C     RENBR(/DETERMINE NUMBER OF LEADING QUESTION MARKS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     IBUFFR = ARRAY CONTAINING CHARACTERS READ BY MULTIPLE
C              OF A1 FORMAT.
C     MAXBFR = SUBSCRIPT   OF   IBUFFR    ARRAY    LOCATION
C              CONTAINING RIGHTMOST CHARACTER.
C     LOWBFR = SUBSCRIPT OF FIRST LOCATION IN IBUFFR  ARRAY
C              TO  BE  TESTED.  LOWBFR IS RETURNED POINTING
C              TO  THE  FIRST  NON-QUESTION  MARK  PRINTING
C              CHARACTER  IN BUFFER OR BEYOND END OF BUFFER
C              IF NO OTHER PRINTING  CHARACTERS  APPEAR  IN
C              BUFFER.
C     IQUERY = 0, RETURNED IF NO QUESTION MARKS  APPEAR  AT
C              START OF TEXT IN IBUFFR ARRAY.
C            = GREATER  THAN  ZERO,  IQUERY  IS  NUMBER  OF
C              QUESTION  MARKS  FOUND  AT  START OF TEXT IN
C              IBUFFR ARRAY.
C
      DIMENSION IBUFFR(MAXBFR)
      DATA IQUEST,ISPACE,ITAB/1H?,1H ,1H	/
      IQUERY=0
    1 IF(LOWBFR.GT.MAXBFR)GO TO 3
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.ISPACE)GO TO 2
      IF(LETTER.EQ.ITAB)GO TO 2
      IF(LETTER.NE.IQUEST)GO TO 3
      IQUERY=IQUERY+1
    2 LOWBFR=LOWBFR+1
      GO TO 1
    3 RETURN
C098245027474?
      END
      SUBROUTINE DACASE(MINBFR,MAXBFR,IBUFFR)
C     RENBR(/CONVERT LOWER CASE LETTERS TO UPPER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     MINBFR = SUBSCRIPT OF FIRST LOCATION IN IBUFFR  ARRAY
C              CONTAINING  CHARACTER  TO  BE  CONVERTED  TO
C              UPPER CASE.  MINBFR IS RETURNED UNCHANGED.
C     MAXBFR = SUBSCRIPT OF FINAL LOCATION IN IBUFFR  ARRAY
C              CONTAINING  CHARACTER  TO  BE  CONVERTED  TO
C              UPPER CASE.  MAXBFR IS RETURNED UNCHANGED.
C     IBUFFR = ARRAY   CONTAINING   IN   LOCATIONS   HAVING
C              SUBSCRIPTS  MINBFR THROUGH MAXBFR CHARACTERS
C              READ BY MULTPLE OF 1A FORMAT WHICH ARE TO BE
C              CONVERTED  TO  UPPER  CASE IF INPUT IN LOWER
C              CASE.
C
      DIMENSION IBUFFR(MAXBFR),KAPITL(26),LOWER(26)
C
C     CCCC       AAA UU   UU TTTTTTTT IIII  OOOO   NN    NN
C   CC          AAAA UU   UU    TT     II  OO  OO  NNN   NN
C  CC          AA AA UU   UU    TT     II OO    OO NNNN  NN
C  CC         AA  AA UU   UU    TT     II OO    OO NN NN NN
C  CC        AAAAAAA UU   UU    TT     II OO    OO NN  NNNN
C   CC      AA    AA  UU UU     TT     II  OO  OO  NN   NNN
C     CCCC AA     AA   UUU      TT    IIII  OOOO   NN    NN
C
C     TO CONVERT LOWER  CASE  LETTERS  IN  THE  INPUT  TEXT
C     BUFFER INTO UPPER CASE LETTERS, THIS ROUTINE COMPARES
C     THE CHARACTERS IN THE INPUT TEXT BUFFER  AGAINST  THE
C     LOWER  CASE  LETTERS IN THE LOWER ARRAY.  THE LETTERS
C     IN THE LOWER ARRAY MUST  BE  ARRANGED  IN  INCREASING
C     NUMERICAL  ORDER.   IF THE NUMERICAL ORDER IS NOT THE
C     SAME  AS  THE  ALPHABETICAL  ORDER,  THEN  THE   DATA
C     STATEMENTS  APPEARING  BELOW  MUST BE CHANGED OR ELSE
C     SOME OR ALL LOWER CASE  LETTERS  IN  THE  INPUT  TEXT
C     BUFFER  WILL  NOT BE CONVERTED INTO THE CORRESPONDING
C     UPPER CASE LETTERS.  ONCE THE LETTERS  IN  THE  LOWER
C     ARRAY ARE SORTED INTO INCREASING NUMERICAL ORDER, THE
C     UPPER CASE LETTERS IN  THE  KAPITL  ARRAY  SHOULD  BE
C     REARRANGED  SO  THAT LOWER AND UPPER CASE VERSIONS OF
C     EACH LETTER APPEAR IN  LOCATIONS  IN  THE  LOWER  AND
C     KAPITL ARRAYS HAVING THE SAME SUBSCRIPTS.
C
C     IF THE COMPUTER UPON WHICH THIS ROUTINE IS USED  DOES
C     NOT  SUPPORT  LOWER CASE LETTERS, THEN BOTH THE LOWER
C     AND KAPITL ARRAYS CAN CONTAIN THE LETTERS 1HA THROUGH
C     1HZ  IN  ALPHABETICAL  ORDER (EVEN IF THIS IS NOT THE
C     NUMERICALLY SORTED ORDER).
C
C     KAPITL = UPPER CASE LETTERS A THROUGH Z SORTED ON
C              LOWER ARRAY
      DATA KAPITL/
     11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     31HU,1HV,1HW,1HX,1HY,1HZ/
C
C     LOWER  = LOWER CASE LETTERS A THROUGH Z SORTED INTO
C              NUMERICALLY INCREASING ORDER
      DATA LOWER/
     11Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     21Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
     31Hu,1Hv,1Hw,1Hx,1Hy,1Hz/
C
C     THIS IS A TERNARY SEARCH TAKING ADVANTAGE OF THE SIZE
C     OF  ALPHABET BEING NEARLY 3**3.  THE 3RD OF THE ARRAY
C     CONTAINING THE DESIRED LETTER IS FIRST LOCATED,  THEN
C     THE  3RD  OF  THIS  3RD,  AND  FINALLY  EACH  OF  THE
C     REMAINING 3  LETTERS  ARE  TESTED  INDIVIDUALLY.   TO
C     PREVENT  TESTING  AGAINST  THE 27TH LETTER WHICH DOES
C     NOT EXIST, UPPER 3RD  IS  TAKEN  AS  UPPER  9  SORTED
C     LETTERS,  RATHER THAN FROM 19TH THROUGH 27TH LETTERS,
C     SO THAT LOWER(18) IS TESTED AGAINST IN UPPER 3RD EVEN
C     THOUGH LETTER BEING MATCHED HAS ALREADY BEEN FOUND TO
C     BE LARGER THAN THIS.
      INDEX=MINBFR
    1 IF(INDEX.GT.MAXBFR)GO TO 8
      LETTER=IBUFFR(INDEX)
      IF(LETTER.GT.LOWER(18))GO TO 3
      IF(LETTER.GT.LOWER(9))GO TO 2
      IF(LETTER.LT.LOWER(1))GO TO 7
      J=3
      GO TO 4
    2 J=12
      GO TO 4
    3 IF(LETTER.GT.LOWER(26))GO TO 7
      J=20
    4 IF(LETTER.LE.LOWER(J))GO TO 5
      J=J+3
      IF(LETTER.GT.LOWER(J))J=J+3
    5 IF(LETTER.EQ.LOWER(J))GO TO 6
      J=J-1
      IF(LETTER.EQ.LOWER(J))GO TO 6
      J=J-1
      IF(LETTER.NE.LOWER(J))GO TO 7
    6 IBUFFR(INDEX)=KAPITL(J)
    7 INDEX=INDEX+1
      GO TO 1
    8 RETURN
C
C     THE FOLLOWING BINARY  SEARCH COULD BE USED AS A MODEL
C     IF A LARGER ALPHABET HAD TO BE CONVERTED
C     INDEX=MINBFR
C     GO TO 3
C   1 IBUFFR(INDEX)=KAPITL(NOWTST)
C   2 INDEX=INDEX+1
C   3 IF(INDEX.GT.MAXBFR)GO TO 7
C     LETTER=IBUFFR(INDEX)
C     IF(LETTER.LT.LOWER(1))GO TO 2
C     IF(LETTER.GT.LOWER(26))GO TO 2
C     MAXTST=26
C     MINTST=1
C     NOWTST=MINTST
C     GO TO 5
C   4 MAXTST=NOWTST
C   5 LNGTST=(MAXTST-MINTST)/2
C     NOWTST=MAXTST-LNGTST
C     IF(LETTER.EQ.LOWER(NOWTST))GO TO 1
C     IF(LETTER.GT.LOWER(NOWTST))GO TO 6
C     IF(LNGTST.GT.0)GO TO 4
C     IF(MAXTST.LE.MINTST)GO TO 2
C     NOWTST=MINTST
C     GO TO 4
C   6 IF(LNGTST.LE.0)GO TO 2
C     MINTST=NOWTST
C     GO TO 5
C   7 RETURN
C349007223700abcdefghijklmnopqrstuvwxyz
      END
      SUBROUTINE DATREE(KLIMB ,KOMPAR,ITYPE ,MINNOD,MAXNOD,
     1    NODES ,MINCLM,MAXCLM,NOWCLM,KOLUMN,INITAL,KIND  ,
     2    NEWCLM)
C     RENBR(/NODES IN NEXT LINE OF TREE REPRESENTATION)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO RETURN THE NODES WHICH WOULD  BE  IN  NEXT
C     LINE   OF   THE   REPRESENTATION  OF  A  SIMPLE  TREE
C     STRUCTURE.   THE  NODES  ARE  IDENTIFIED  TO  CALLING
C     PROGRAM  BY  SUBSCRIPTS, AND ARE NOT REPRESENTED IN A
C     FORM WHICH CAN BE DIRECTLY WRITTEN WITH A MULTIPLE OF
C     AN A1 FORMAT.
C
C     KLIMB  = 0, ENTIRE TREE IS TO BE REPRESENTED
C            = 1, ONLY PORTION OF  TREE  STARTING  AT  NODE
C              HAVING  IDENTIFICATION NUMBER IN NODES ARRAY
C              EQUAL TO INPUT VALUE  OF  KOMPAR  IS  TO  BE
C              REPRESENTED
C     KOMPAR = IF KLIMB=1, THEN KOMPAR IS EQUAL  TO  NUMBER
C              IN NODES ARRAY WHICH IDENTIFIES NODE AT BASE
C              OF TREE.  PORTION OF TREE  BELOW  THIS  NODE
C              WILL NOT BE REPRESENTED.
C     ITYPE  = 0, EACH GROUP IN  NODES  ARRAY  CONSISTS  OF
C              NUMBER  OF  ITEMS  WHICH  ARE  IDENTIFIED IN
C              GROUP FOLLOWED BY IDENTIFICATION OF  CALLING
C              ITEM  AND THEN BY IDENTIFICATIONS OR SOME OR
C              ALL OF ITEMS WHICH IT CALLS.  NODES ARRAY IS
C              TERMINATED  BY  GROUP CONTAINING ONLY SINGLE
C              ZERO.  IF ITEM 10 CALLS 11 AND 12, AND  ITEM
C              11  CALLS  12 AND 13, THEN NODES ARRAY WOULD
C              CONTAIN
C                 3, 10, 11, 12, 3, 11, 12, 13 AND 0
C            = 1, EACH GROUP IN  NODES  ARRAY  CONSISTS  OF
C              NUMBER OF ITEMS IDENTIFIED IN GROUP FOLLOWED
C              BY IDENTIFICATION OF ITEM CALLED AND THEN BY
C              IDENTIFICATIONS  OF  SOME  OR  ALL  OF ITEMS
C              CALLING IT.  NODES ARRAY  IS  TERMINATED  BY
C              GROUP  CONTAINING  ONLY  SINGLE  ZERO.   FOR
C              ABOVE EXAMPLE IN WHICH 12 IS CALLED BY  BOTH
C              10  AND  11, IN WHICH 11 IS CALLED BY 10 AND
C              IN WHICH 13 IS CALLED  BY  11,  NODES  ARRAY
C              WOULD CONTAIN
C                 3, 12, 10, 11, 2, 11, 10, 2, 13, 11 AND 0
C     MINNOD = LOWEST SUBSCRIPT TO USE IN NODES ARRAY
C     MAXNOD = DIMENSION OF NODES ARRAY
C     NODES  = ARRAY CONTAINING NODE IDENTIFIERS
C     MINCLM = SUBSCRIPT OF FIRST LOCATION IN KOLUMN ARRAY
C     MAXCLM = SUBSCRIPT OF FINAL LOCATION IN KOLUMN  ARRAY
C              WHICH IS AVAILABLE FOR USE
C     NOWCLM = MUST BE SET TO MINCLM-1 BEFORE THIS  ROUTINE
C              IS  FIRST  CALLED  TO  REPRESENT  PARTICULAR
C              TREE.  RETURNED CONTAINING HIGHEST SUBSCRIPT
C              USED  IN  KOLUMN  ARRAY TO REPRESENT CURRENT
C              LINE AND MUST BE SENT TO SUBSEQUENT CALL  OF
C              THIS ROUTINE UNCHANGED
C     KOLUMN = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              NODES  ARRAY OF THOSE NODES ON CURRENT LINE.
C              CONTENTS OF KOLUMN ARRAY  MUST  BE  SENT  TO
C              SUBSEQUENT  CALL  OF THIS ROUTINE UNCHANGED.
C              CONTENTS OF KOLUMN ARRAY  ARE  IGNORED  WHEN
C              THIS ROUTINE IS CALLED WITH NOWCLM LESS THAN
C              MINCLM
C     INITAL = ARRAY DIMENSIONED SAME AS KOLUMN ARRAY,  BUT
C              WHICH  IS  USED  ONLY FOR TRANSFER OF VALUES
C              FROM ONE  CALL  OF  THIS  ROUTINE  TO  NEXT.
C              CONTENTS  OF  THIS ARRAY MUST NOT BE CHANGED
C              BETWEEN CALLS TO THIS ROUTINE UNTIL KIND  IS
C              RETURNED  CONTAINING  1 INDICATING THAT TREE
C              HAS BEEN COMPLETED.
C     KIND   = 1, RETURNED IF REPRESENTATION  OF  TREE  HAD
C              BEEN FINISHED BY PREVIOUS CALL
C            = 2, LINE IN REPRESENTATION IS BEING  RETURNED
C              IN   KOLUMN(MINCLM)  THROUGH  AND  INCLUDING
C              KOLUMN(NOWCLM)
C            = 3, SAME AS KIND=2 EXCEPT THAT REPRESENTATION
C              IS TERMINATED AT LOOP END
C            = 4, SAME AS KIND=2 EXCEPT THAT NOT ALL  NODES
C              COULD  BE REPRESENTED DUE TO TOO LITTLE ROOM
C              IN KOLUMN ARRAY
C            = 5, KLIMB WAS INPUT CONTAINING 1  AND  NOWCLM
C              CONTAINING  MINCLM-1 INDICATING THAT PARTIAL
C              TREE WAS DESIRED,  BUT  NODE  IDENTIFIED  BY
C              KOMPAR  COULD  NOT  BE FOUND IN NODES ARRAY.
C              NO NODES ARE BEING RETURNED IN KOLUMN ARRAY,
C              AND NOWCLM IS RETURNED CONTAINING MINCLM-1.
C     NEWCLM = RETURNED  CONTAINING  LOWEST   SUSCRIPT   OF
C              KOLUMN   ARRAY   WHICH   HAS  BEEN  RETURNED
C              CHANGED.  INPUT VALUE IS IGNORED
C
      DIMENSION NODES(MAXNOD),KOLUMN(MAXCLM),INITAL(MAXCLM)
C
      KIND=1
      IF(NOWCLM.GE.MINCLM)GO TO 21
      NOWCLM=MINCLM-1
      NEWCLM=MINCLM
      LIMIT=MINNOD
      IF(KLIMB.EQ.0)GO TO 3
C
C     FIND ROOT IF SPECIFIED BY CALLING PROGRAM
    1 ISIZE=NODES(LIMIT)
      IF(ISIZE.LE.0)GO TO 25
      JTEST=LIMIT
      LOWER=LIMIT
      LIMIT=LIMIT+ISIZE+1
      IF(LIMIT.GT.MAXNOD)GO TO 25
    2 LOWER=LOWER+1
      IF(LOWER.GE.LIMIT)GO TO 1
      IF(NODES(LOWER).NE.KOMPAR)GO TO 2
      GO TO 14
C
C     FIND NEXT ROOT IF NOT SPECIFIED BY CALLING PROGRAM
    3 ISIZE=NODES(LIMIT)
      IF(ISIZE.LE.0)GO TO 26
      JTEST=LIMIT
      LOWER=LIMIT+1
      LIMIT=LOWER+ISIZE
      IF(LIMIT.GT.MAXNOD)GO TO 26
      IF(ITYPE.EQ.0)GO TO 9
      IF(ISIZE.LE.1)GO TO 5
    4 LOWER=LOWER+1
      IF(LOWER.GE.LIMIT)GO TO 3
    5 IDNTFY=NODES(LOWER)
    6 NODTST=MINNOD
    7 ISIZE=NODES(NODTST)
      IF(ISIZE.LE.0)GO TO 10
      ITEST=NODTST+1
      NODTST=ITEST+ISIZE
      IF(NODTST.GT.MAXNOD)GO TO 10
      IF(ITYPE.EQ.0)GO TO 8
      IF(ISIZE.LE.1)GO TO 7
    8 IF(NODES(ITEST).NE.IDNTFY)GO TO 7
      IF(ITYPE.NE.0)GO TO 4
      IF(ITEST.LT.LOWER)GO TO 3
      GO TO 14
    9 IDNTFY=NODES(LOWER)
   10 NODTST=MINNOD
   11 ISIZE=NODES(NODTST)
      IF(ISIZE.LE.0)GO TO 6
      ITEST=NODTST+1
      NODTST=ITEST+ISIZE
      IF(NODTST.GT.MAXNOD)GO TO 6
      IF(ITYPE.EQ.0)GO TO 12
      IF(ISIZE.LE.1)GO TO 13
   12 ITEST=ITEST+1
      IF(ITEST.GE.NODTST)GO TO 11
   13 IF(NODES(ITEST).NE.IDNTFY)GO TO 12
      IF(ITYPE.EQ.0)GO TO 3
      IF(ITEST.LT.LOWER)GO TO 4
C
C     INSERT NEW NODE ONTO BRANCH
   14 IF(NOWCLM.GE.MAXCLM)GO TO 24
      NOWCLM=NOWCLM+1
      KOLUMN(NOWCLM)=LOWER
      INITAL(NOWCLM)=JTEST
      IDNTFY=NODES(LOWER)
      LIMIT=MINNOD
      KIND=2
C
C     CHECK THAT BRANCH DOES NOT CONTAIN A LOOP
      J=MINCLM
   15 IF(J.GE.NOWCLM)GO TO 16
      I=KOLUMN(J)
      IF(NODES(I).EQ.NODES(LOWER))GO TO 23
      J=J+1
      GO TO 15
C
C     SEARCH FOR NEXT NODE ALONG BRANCH
   16 ISIZE=NODES(LIMIT)
      IF(ISIZE.LE.0)GO TO 20
      JTEST=LIMIT
      LOWER=LIMIT+1
      LIMIT=LOWER+ISIZE
      IF(LIMIT.GT.MAXNOD)GO TO 20
      IF(ITYPE.EQ.0)GO TO 18
      ITEST=LOWER
   17 ITEST=ITEST+1
      IF(ITEST.GE.LIMIT)GO TO 16
      IF(NODES(ITEST).NE.IDNTFY)GO TO 17
      GO TO 14
   18 IF(NODES(LOWER).NE.IDNTFY)GO TO 16
   19 LOWER=LOWER+1
      IF(LOWER.GE.LIMIT)GO TO 16
      GO TO 14
C
C     BACK UP TO PREVIOUS NODE IF CURRENT NODE COMPLETED
   20 IF(KIND.NE.1)GO TO 26
   21 LOWER=KOLUMN(NOWCLM)
      JTEST=INITAL(NOWCLM)
      LIMIT=JTEST+NODES(JTEST)+1
      NEWCLM=NOWCLM
      NOWCLM=NOWCLM-1
      IF(NOWCLM.LT.MINCLM)GO TO 22
      I=KOLUMN(NOWCLM)
      IDNTFY=NODES(I)
      IF(ITYPE.EQ.0)GO TO 19
      GO TO 16
   22 IF(KLIMB.NE.0)GO TO 26
      IF(ITYPE.EQ.0)GO TO 3
      GO TO 4
C
C     RETURN TO CALLING PROGRAM
   23 KIND=3
      GO TO 26
   24 KIND=4
      GO TO 26
   25 KIND=5
   26 RETURN
C660045846000
      END
      SUBROUTINE OPNFIL(  ITTY,  JTTY,KMDNUM,KMDDVC,KMDNAM,
     1    KMDEXT,ID1NUM,ID1DVC,ID1EXT,ID2NUM,ID2DVC,ID2EXT,
     2    ID3NUM,ID3DVC,ID3EXT,MAXTTL,MAXBFR,  KIND,KNDFLG,
     3    NUMFLG,LTRTTL,ID1OPN,ID2OPN,IBUFFR)
C     RENBR(/OPEN FILES FOR FILE,FILE=FILE,FILE COMMAND)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE OPENS THE FILES SPECIFIED BY THE USER IN
C     A  COMMAND  IN  WHICH  UP  TO 2 OUTPUT FILE NAMES ARE
C     FOLLOWED BY AN EQUAL SIGN AND THEN BY ANY  NUMBER  OF
C     INPUT  FILE  NAMES.   THE  FIRST CALL TO THIS ROUTINE
C     OPENS THE FIRST INPUT FILE AND ALL THE OUTPUT  FILES.
C     SUBSEQUENT  CALLS  TO  THIS  ROUTINE  OPEN SUBSEQUENT
C     INPUT FILES.  OUTPUT FILES ARE IDENTIFIED AS BEING OF
C     EITHER  TYPE  ONE  OR  TYPE TWO BY THE SWITCHES WHICH
C     APPEAR WITH THE FILE SPECIFICATIONS.  IF NO MORE THAN
C     A  SINGLE  OUTPUT  FILE  IS  SUPPLIED AND NO SWITCHES
C     IMPLY ITS TYPE, THEN IT IS ASSUMED TO BE OF TYPE ONE.
C
C     OPNFIL ARGUMENTS NAMED ITTY,  JTTY,  KMDNUM,  KMDDVC,
C     KMDNAM,  KMDEXT,  MAXBFR  AND IBUFFR ARE IDENTICAL TO
C     GETFIL ARGUMENTS HAVING SAME NAMES AND  HAVE  ALREADY
C     BEEN  DESCRIBED.   FOLLOWING ARGUMENTS, TOGETHER WITH
C     ITTY,  JTTY,  KMDNUM,  KMDDVC,  KMDNAM,  KMDEXT   AND
C     MAXBFR,  ARE  USED  ONLY  FOR  INPUT AND ARE RETURNED
C     UNCHANGED.
C
C     ID1NUM = NUMBER OF UNIT UPON WHICH THIS ROUTINE IS TO
C              OPEN OUTPUT FILE WHICH IS TO BE OF TYPE ONE.
C              OUTPUT FILE WILL BE OF TYPE ONE IF ITS  FILE
C              SPECIFICATION  IS ASSOCIATED WITH SWITCH FOR
C              WHICH CORRESPONDING VALUE IN KNDFLG ARRAY IS
C              1.
C     ID1DVC = NAME IN 5H FORM OF DEVICE  UPON  WHICH  TYPE
C              ONE  OUTPUT  FILE  IS  TO BE WRITTEN IF USER
C              DOES NOT  SUPPLY  DEVICE  NAME  FOLLOWED  BY
C              COLON  AT START OF SPECIFICATION OF TYPE ONE
C              OUTPUT FILE.
C     ID1EXT = NAME IN 3H FORM  WHICH  IS  TO  BE  USED  AS
C              SECOND  COMPONENT  (FILE  NAME EXTENSION) OF
C              NAME OF TYPE ONE OUTPUT FILE  IF  NO  SECOND
C              COMPONENT OF NAME OF TYPE ONE OUTPUT FILE IS
C              SUPPLIED BY USER.  IF USER DOES NOT  SPECIFY
C              FIRST COMPONENT OF NAME OF OUTPUT FILE, THEN
C              FIRST COMPONENT OF NAME OF FIRST INPUT  FILE
C              IS  USED  AS FIRST COMPONENT OF NAME OF THIS
C              OUTPUT FILE.
C     ID2NUM, ID2DVC AND ID2EXT = SIMILAR TO ID1NUM, ID1DVC
C              AND ID1EXT RESPECTIVELY, EXCEPT THAT ID2NUM,
C              ID2DVC AND ID2EXT REFER TO OUTPUT FILE WHICH
C              IS  TO  BE OF TYPE TWO.  OUTPUT FILE WILL BE
C              OF TYPE TWO IF  ITS  FILE  SPECIFICATION  IS
C              ASSOCIATED    WITH    SWITCH    FOR    WHICH
C              CORRESPONDING VALUE IN KNDFLG ARRAY IS 2.
C     ID3NUM = NUMBER OF UNIT UPON WHICH THIS ROUTINE IS TO
C              OPEN NEXT INPUT FILE SPECIFIED BY USER.
C     ID3DVC = NAME IN 5H FORM OF DEVICE  UPON  WHICH  NEXT
C              INPUT FILE IS TO BE OPENED IF NO DEVICE NAME
C              HAS BEEN SPECIFIED BY USER FOR ANY  PREVIOUS
C              INPUT   FILE   AND  IF  NO  DEVICE  NAME  IS
C              SPECIFIED BY USER FOR THIS NEW INPUT FILE.
C     ID3EXT = NAME IN 3H FORM  WHICH  IS  TO  BE  USED  AS
C              SECOND  COMPONENT  (FILE  NAME EXTENSION) OF
C              NAME OF EACH INPUT FILE FOR WHICH NO  SECOND
C              COMPONENT OF FILE NAME IS SUPPLIED BY USER.
C     MAXTTL = DIMENSION OF LTRTTL ARRAY AND MAXIMUM NUMBER
C              OF  CHARACTERS  WHICH  CAN  BE  RETURNED  IN
C              LTRTTL ARRAY.
C
C     FOLLOWING ARGUMENT MUST BE ZEROED BY CALLING  PROGRAM
C     BEFORE  THIS  ROUTINE IS FIRST CALLED, BUT THEN VALUE
C     RETURNED BY THIS ROUTINE SHOULD BE SENT TO  FOLLOWING
C     CALL OF THIS ROUTINE UNCHANGED.
C
C     KIND   = DEFINED SIMILARLY TO ARGUMENT OF  SAME  NAME
C              IN  ARGUMENT  LIST OF GETFIL ROUTINE, EXCEPT
C              THAT OPNFIL ROUTINE DOES NOT RETURN  KIND=5.
C              KIND  SHOULD BE SET TO ZERO (OR TO 1) BEFORE
C              THIS ROUTINE IS FIRST  CALLED,  OR  WHENEVER
C              INTERPRETATION   OF   CURRENT  SET  OF  FILE
C              SPECIFICATIONS IS TO BE ABANDONED.
C            = 1, RETURNED IF PREVIOUS CALL TO THIS ROUTINE
C              OPENED FINAL INPUT FILE SPECIFIED BY USER.
C            = 2, RETURNED IF PREVIOUS CALL TO THIS ROUTINE
C              OPENED FINAL INPUT FILE SPECIFIED TO LEFT OF
C              SEMICOLON.  IF THIS ROUTINE IS CALLED  AGAIN
C              WITHOUT  KIND HAVING FIRST BEEN ZEROED, THEN
C              EVALUATION OF NEW SET OF FILE SPECIFICATIONS
C              WILL  BE BEGUN IN TEXT APPEARING TO RIGHT OF
C              SEMICOLON.
C            = 3, CURRENT CALL TO THIS ROUTINE  HAS  OPENED
C              OUTPUT  FILE  OR  FILES AND HAS OPENED FIRST
C              INPUT FILE.
C            = 4, CURRENT CALL TO THIS ROUTINE  HAS  OPENED
C              SECOND OR SUBSEQUENT INPUT FILE.
C
C     FOLLOWING  ARGUMENT  IS   USED   BOTH   FOR   SENDING
C     INFORMATION   TO  THIS  ROUTINE,  AND  FOR  RETURNING
C     INFORMATION TO CALLING PROGRAM.  CALLING PROGRAM MUST
C     DEFINE  CONTENTS OF THIS ARRAY BEFORE THIS ROUTINE IS
C     FIRST CALLED.
C
C     KNDFLG = ARRAY DIMENSIONED AT 27 WHICH MUST INITIALLY
C              INDICATE  OUTPUT FILE TYPES TO BE ASSOCIATED
C              WITH  EACH  OF  SINGLE  LETTER  SWITCHES  /A
C              THROUGH  /Z AND /' (OR LONE ') RESPECTIVELY.
C              IF THIS ROUTINE IS CALLED WITH KIND SET TO 2
C              OR  LESS, THEN THIS ROUTINE REDEFINES KNDFLG
C              ARRAY TO  CONTAIN  ABSOLUTE  VALUES  OF  ITS
C              ORIGINAL  CONTENTS.  IF CURRENT CALL TO THIS
C              ROUTINE BEGINS  PROCESSING  OF  NEW  COMMAND
C              SUCH  THAT KIND IS RETURNED CONTAINING VALUE
C              3, THEN THOSE LOCATIONS WITHIN KNDFLG  ARRAY
C              HAVING  AS THEIR SUBSCRIPTS SERIAL LOCATIONS
C              WITHIN ALPHABET OF LETTERS WHICH  ARE  FOUND
C              AS  SWITCHES (ASSUMING APOSTROPHE TO BE 27TH
C              LETTER  OF  ALPHABET)  ARE   THEN   RETURNED
C              CONTAINING   NEGATIVES   OF  THEIR  ABSOLUTE
C              VALUES.   CONTENTS  OF  KNDFLG   ARRAY   ARE
C              RETURNED  UNCHANGED  IF KIND IS RETURNED SET
C              TO 4.
C
C              IF VALUE IN KNDFLG  ARRAY  CORRESPONDING  TO
C              SWITCH  IS  EITHER  -1  OR 1, THEN FILE WITH
C              WHICH SWITCH IS ASSOCIATED WILL BE  OF  TYPE
C              ONE.  IF VALUE IN KNDFLG ARRAY CORRESPONDING
C              TO SWITCH IS EITHER -2 OR 2, THEN FILE  WITH
C              WHICH  SWITCH  IS ASSOCIATED WILL BE OF TYPE
C              TWO.  IF VALUE IN KNDFLG ARRAY CORRESPONDING
C              TO SWITCH IS ZERO, THEN ROUTINE NAMED HLPFIL
C              IS CALLED TO DISPLAY HELP  MESSAGE  TO  USER
C              AND  USER IS THEN ASKED TO SUPPLY NEW SET OF
C              FILE  SPECIFICATIONS.   SWITCHES  FOR  WHICH
C              CORRESPONDING  LOCATIONS  IN KNDFLG ARRAY DO
C              NOT CONTAIN ONE OF VALUES -2 THROUGH  2  CAN
C              APPEAR WITH EITHER OUTPUT FILE SPECIFICATION
C              OR WITH LEFTMOST  INPUT  FILE  SPECIFICATION
C              BUT DO NOT IDENTIFY TYPE OF OUTPUT FILES.
C
C     FOLLOWING  ARGUMENTS  ARE  USED  ONLY  FOR  RETURNING
C     INFORMATION  TO CALLING PROGRAM WHEN KIND IS RETURNED
C     SET TO 3.  THESE ARGUMENTS ARE RETURNED UNCHANGED  IF
C     KIND IS RETURNED SET TO VALUE OTHER THAN 3.
C
C     NUMFLG = ARRAY DIMENSIONED AT 27 WHICH  IS  USED  FOR
C              RETURNING   VALUES   WHICH   APPEARED   WITH
C              SEPARATING COLONS  AFTER  SWITCHES  IN  FILE
C              SPECIFICATIONS.   NUMFLG  ARRAY LOCATIONS IN
C              WHICH THESE  VALUES  ARE  RETURNED  HAVE  AS
C              THEIR  SUBSCRIPTS  SERIAL  LOCATIONS  WITHIN
C              ALPHABET  OF  LETTERS  WHICH  ARE  USED   AS
C              SWITCHES.  SUCH NUMBERS MUST BE SPECIFIED AS
C              DECIMAL   INTEGERS,   BUT   CANNOT   CONTAIN
C              EXPONENTS.      NUMFLG(27)    IS    RETURNED
C              CONTAINING NUMBER OF CHARACTERS RETURNED  IN
C              LTRTTL  ARRAY  WHICH  WERE FOUND TO RIGHT OF
C              LEADING APOSTROPHE.
C     LTRTTL = ARRAY IN WHICH  AT  MOST  MAXTTL  CHARACTERS
C              APPEARING  TO  RIGHT  OF  APOSTROPHE  CAN BE
C              RETURNED.  NUMFLG(27) IS RETURNED CONTAINING
C              NUMBER  OF  CHARACTERS  RETURNED  IN  LTRTTL
C              ARRAY.
C     ID1OPN = 0, RETURNED IF TYPE ONE OUTPUT FILE WAS  NOT
C              OPENED.
C            = 1, RETURNED IF  TYPE  ONE  OUTPUT  FILE  WAS
C              OPENED.
C     ID2OPN = 0, RETURNED IF TYPE TWO OUTPUT FILE WAS  NOT
C              OPENED.
C            = 1, RETURNED IF  TYPE  TWO  OUTPUT  FILE  WAS
C              OPENED.
C
      COMMON/FASPY/NEWNUL(3),NEWDSK(3),NEWNAM(3),
     1NEWPTH(3,3),LCNRIT
      DIMENSION KNDFLG(27),NUMFLG(27),LTRTTL(MAXTTL),
     1IBUFFR(MAXBFR),LTRABC(27),LWRABC(27),LTRDGT(10),
     2INILTR(6),KNTLTR(6)
      DOUBLE PRECISION KMDNAM,NEWNAM,NEWPTH,PTHONE(3),
     1PTHTWO(3),PTHTHR(3),FILONE,FILTWO,FILTHR,FILNAM
      DATA LTRABC/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     1            1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     2            1HU,1HV,1HW,1HX,1HY,1HZ,1H'/
      DATA LWRABC/1Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     1            1Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
     2            1Hu,1Hv,1Hw,1Hx,1Hy,1Hz,1H'/
      DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LTRPLS,LTRMNS,IBLANK/1H+,1H-,5H     /
C
C     INITIALIZE STORAGE OF COMMAND
      INITAL=KIND-2
      IF(INITAL.GT.0)GO TO 4
      GO TO 2
    1 KIND=0
    2 ID1OPN=0
      ID2OPN=0
      DO 3 I=1,27
      IF(KNDFLG(I).LT.0)KNDFLG(I)=-KNDFLG(I)
    3 NUMFLG(I)=0
      KNDONE=0
      KNDTWO=0
      KNDTHR=0
C
C     GET NEXT COMPONENT OF COMMAND TYPED BY USER
    4 CALL GETFIL(3,ITTY,JTTY,KMDNUM,KMDDVC,
     1KMDNAM,KMDEXT,6,MAXBFR,KIND,NEWNUL,NEWDSK,
     2NEWNAM,NEWPTH,LCNRIT,IBUFFR,MAXFLG,INILTR,KNTLTR,
     3LCNOWN)
      GO TO(45,45,23,31,5),KIND
C
C     DECIDE WHICH SWITCH WAS GIVEN
    5 IF(MAXFLG.LE.0)GO TO 4
      IF(KNTLTR(1).LE.0)GO TO 4
      IF(INITAL.GT.0)GO TO 4
      LOCLTR=INILTR(1)
      LTRNOW=IBUFFR(LOCLTR)
      NEWFLG=0
    6 NEWFLG=NEWFLG+1
      IF(NEWFLG.GT.27)GO TO 4
      IF(LTRABC(NEWFLG).EQ.LTRNOW)GO TO 7
      IF(LWRABC(NEWFLG).NE.LTRNOW)GO TO 6
    7 IF(KNDFLG(NEWFLG).EQ.0)GO TO 35
      IF(KNDFLG(NEWFLG).GT.0)KNDFLG(NEWFLG)=-KNDFLG(NEWFLG)
      IF(KNDFLG(NEWFLG).EQ.-2)GO TO 11
      IF(KNDFLG(NEWFLG).NE.-1)GO TO 15
C
C     MARK THAT FILE BEARS TYPE ONE SWITCH
      ID1OPN=1
      GO TO(8,9,10),LCNOWN
    8 IF(KNDONE.EQ.1)GO TO 15
      IF(KNDONE.NE.3)KNDONE=KNDONE+1
      GO TO 15
    9 IF(KNDTWO.EQ.1)GO TO 15
      IF(KNDTWO.NE.3)KNDTWO=KNDTWO+1
      GO TO 15
   10 IF(KNDTHR.EQ.1)GO TO 15
      IF(KNDTHR.NE.3)KNDTHR=KNDTHR+1
      GO TO 15
C
C     MARK THAT FILE BEARS TYPE TWO SWITCH
   11 ID2OPN=1
      GO TO(12,13,14),LCNOWN
   12 IF(KNDONE.LE.1)KNDONE=KNDONE+2
      GO TO 15
   13 IF(KNDTWO.LE.1)KNDTWO=KNDTWO+2
      GO TO 15
   14 IF(KNDTHR.LE.1)KNDTHR=KNDTHR+2
C
C     STORE QUOTED TEXT STRING
   15 IVALUE=0
      IF(NEWFLG.LT.27)GO TO 17
      LMTLTR=LOCLTR+KNTLTR(1)
   16 IF(IVALUE.GE.MAXTTL)GO TO 22
      LOCLTR=LOCLTR+1
      IF(LOCLTR.GE.LMTLTR)GO TO 22
      IVALUE=IVALUE+1
      LTRTTL(IVALUE)=IBUFFR(LOCLTR)
      GO TO 16
C
C     EVALUATE NUMBERS IN RANGE OF SWITCH
   17 IF(MAXFLG.LE.1)GO TO 22
      IF(KNTLTR(2).LE.0)GO TO 22
      LOCLTR=INILTR(2)
      LMTLTR=LOCLTR+KNTLTR(2)
      I=0
      IF(IBUFFR(LOCLTR).EQ.LTRPLS)GO TO 18
      IF(IBUFFR(LOCLTR).NE.LTRMNS)GO TO 19
      I=1
   18 LOCLTR=LOCLTR+1
   19 IF(LOCLTR.GE.LMTLTR)GO TO 21
      LTRNOW=IBUFFR(LOCLTR)
      DO 20 L=1,10
      IF(LTRDGT(L).NE.LTRNOW)GO TO 20
      IVALUE=(10*IVALUE)+L-1
      GO TO 18
   20 CONTINUE
   21 IF(I.NE.0)IVALUE=-IVALUE
   22 NUMFLG(NEWFLG)=IVALUE
      GO TO 4
C
C     SET DEFAULT OUPUT DEVICE NAMES AND PATHS
   23 IF(NEWNUL(LCNRIT).LE.1)GO TO 38
      IF(NEWNUL(LCNRIT).EQ.4)GO TO 38
      IF(ID1OPN.EQ.ID2OPN)ID1OPN=1
      FILONE=NEWNAM(LCNRIT)
      FILTWO=FILONE
      MORONE=ID1EXT
      MORTWO=ID2EXT
      PTHONE(1)=0
      PTHTWO(1)=0
      LOCONE=ID1DVC
      LOCTWO=ID2DVC
      GO TO(31,24,25),LCNRIT
C
C     SINGLE FILE LEFT OF EQUAL SIGN
   24 IF(NEWNUL(1).EQ.0)GO TO 31
      IF(ID1OPN.EQ.ID2OPN)GO TO 36
      KNDONE=1
      KNDTWO=1
      GO TO 26
C
C     TWO FILES LEFT OF EQUAL SIGN
   25 IF(KNDONE.GE.3)GO TO 36
      IF(KNDTWO.GE.3)GO TO 36
      IF(KNDONE.EQ.KNDTWO)GO TO 36
      ID1OPN=1
      ID2OPN=1
      IF(KNDONE.EQ.0)KNDONE=3-KNDTWO
      IF(KNDTWO.EQ.0)KNDTWO=3-KNDONE
   26 IF(NEWNUL(KNDONE).EQ.0)GO TO 29
      IF(NEWDSK(KNDONE).NE.IBLANK)LOCONE=NEWDSK(KNDONE)
      DO 27 I=1,3
   27 PTHONE(I)=NEWPTH(I,KNDONE)
      IF(NEWNUL(KNDONE).LE.1)GO TO 29
      FILNAM=NEWNAM(KNDONE)
      IF(NEWNUL(KNDONE).LE.3)FILONE=FILNAM
      IF(NEWNUL(KNDONE).GE.3)DECODE(10,28,FILNAM)MORONE
   28 FORMAT(7X,1A3)
   29 IF(NEWNUL(KNDTWO).EQ.0)GO TO 31
      IF(NEWDSK(KNDTWO).NE.IBLANK)LOCTWO=NEWDSK(KNDTWO)
      DO 30 I=1,3
   30 PTHTWO(I)=NEWPTH(I,KNDTWO)
      IF(NEWNUL(KNDTWO).LE.1)GO TO 31
      FILNAM=NEWNAM(KNDTWO)
      IF(NEWNUL(KNDTWO).LE.3)FILTWO=FILNAM
      IF(NEWNUL(KNDTWO).GE.3)DECODE(10,28,FILNAM)MORTWO
C
C     OPEN INPUT FILE
   31 IF(NEWNUL(LCNRIT).EQ.0)GO TO 4
      FILTHR=NEWNAM(LCNRIT)
      MORTHR=ID3EXT
      IF(NEWNUL(LCNRIT).GE.3)DECODE(10,28,FILTHR)MORTHR
      LOCTHR=NEWDSK(LCNRIT)
      IF(LOCTHR.EQ.IBLANK)LOCTHR=ID3DVC
      DO 32 I=1,3
   32 PTHTHR(I)=NEWPTH(I,LCNRIT)
      ENCODE(10,33,FILNAM)FILTHR,MORTHR
   33 FORMAT(1A6,1H.,1A3)
      OPEN(UNIT=ID3NUM,FILE=FILNAM,DIRECTORY=PTHTHR,
     1DEVICE=LOCTHR,ACCESS='SEQIN',ERR=43)
      IF(INITAL.GT.0)GO TO 47
C
C     OPEN OUTPUT FILES
      IF(ID1OPN.EQ.0)GO TO 34
      ENCODE(10,33,FILNAM)FILONE,MORONE
      OPEN(UNIT=ID1NUM,FILE=FILNAM,DIRECTORY=PTHONE,
     1DEVICE=LOCONE,ACCESS='SEQOUT',ERR=40)
      IF(ID2OPN.EQ.0)GO TO 46
   34 ENCODE(10,33,FILNAM)FILTWO,MORTWO
      OPEN(UNIT=ID2NUM,FILE=FILNAM,DIRECTORY=PTHTWO,
     1DEVICE=LOCTWO,ACCESS='SEQOUT',ERR=42)
      GO TO 46
C
C     ISSUE HELP MESSAGE AND THEN CLEAR COMMAND IF ANY
   35 CALL HLPFIL(JTTY)
      GO TO 1
C
C     ERROR IN COMMAND TYPED BY USER
   36 WRITE(JTTY,37)
   37 FORMAT(31H AMBIGUOUS OUTPUT SPECIFICATION)
      GO TO 1
   38 WRITE(JTTY,39)
   39 FORMAT(34H 1ST SOURCE FILE MUST BE SPECIFIED)
      GO TO 1
   40 WRITE(JTTY,41)LOCONE,FILNAM
   41 FORMAT(26H CANNOT WRITE OUTPUT FILE ,1A5,1H:,1A10)
      GO TO 1
   42 WRITE(JTTY,41),LOCTWO,FILNAM
      GO TO 1
   43 WRITE(JTTY,44)LOCTHR,FILNAM
   44 FORMAT(25H CANNOT READ SOURCE FILE ,1A5,1H:,1A10)
      GO TO 4
C
C     RETURN TO CALLING PROGRAM
   45 IF(INITAL.LE.0)GO TO 2
      GO TO 47
   46 KIND=3
   47 RETURN
C024147266970'abcdefghijklmnopqrstuvwxyz:
      END
      SUBROUTINE GETFIL(MAXFIL,  ITTY,  JTTY,KMDNUM,KMDDVC,
     1    KMDNAM,KMDEXT,MAXSTR,MAXBFR,  KIND,NEWNUL,NEWDSK,
     2    NEWNAM,NEWPTH,LCNRIT,IBUFFR,MAXFLG,INILTR,KNTLTR,
     3    LCNOWN)
C     RENBR(/EVALUATE FORM FILE,FILE=FILE,FILE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAFLAG   LOCATES   COMPONENTS    OF    SINGLE    FILE
C     SPECIFICATION,  BUT  DOES  NOT  PACK CHARACTERS WHICH
C     FORM THESE COMPONENTS INTO SINGLE OR DOUBLE PRECISION
C     COMPUTER  LOCATIONS WHICH CAN BE USED AS ARGUMENTS IN
C     SYSTEM SUBROUTINE CALLS OR  FORTRAN  OPEN  STATEMENTS
C     WHICH ARE NECESSARY TO PREPARE FOR READING OR WRITING
C     OF  DESIRED  FILE.   LISTED  ON  FOLLOWING  PAGES  IS
C     WRAPPER  FOR DAFLAG ROUTINE WHICH PACKS COMPONENTS OF
C     FILE   SPECIFICATION   INTO   FORM    REQUIRED    FOR
C     DECSYSTEM-10   FORTRAN   OPEN   STATEMENTS.   WRAPPER
C     ROUTINE,  NAMED  GETFIL,   SUPPORTS   MULTIPLE   FILE
C     SPECIFICATION OF FORM
C          LIST OF OUTPUT FILES=LIST OF INPUT FILES
C     OR
C          LIST OF INPUT FILES
C     AND SO MUST SCAN COMMAND FROM LEFT TO RIGHT UNTIL ONE
C     MORE THAN NUMBER OF FILES WHICH CAN APPEAR IN LIST OF
C     OUTPUT FILES HAS BEEN  FOUND.   IF  USER  DESIRES  TO
C     INPUT  SEVERAL  LINES,  ALL  BUT  LAST  LINE  CAN  BE
C     TERMINATED BY AMPERSAND, OR, IF COMMAND  CONSISTS  OF
C     LIST OF FILE SPECIFICATIONS, ALL BUT LAST LINE CAN BE
C     TERMINATED  BY  RIGHTMOST  COMMA.   ALTHOUGH   GETFIL
C     INITIALLY  INTERACTS WITH USER, USER CAN AT ANY POINT
C     SPECIFY THAT REMAINDER OF COMMAND IS TO BE READ  FROM
C     FILE  BY  GIVING ITS NAME ALONG WITH AT (@) SIGN.  IF
C     COMMAND IS BEING READ FROM  FILE,  THEN  CONTINUATION
C     INDICATIONS  ARE  NOT  NECESSARY SINCE ENTIRE COMMAND
C     FILE WILL BE READ UNTIL END OF FILE IS ENCOUNTERED.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT  AND  ARE
C     RETURNED UNCHANGED.
C
C     MAXFIL = 1 MORE THAN NUMBER OF FILES WHICH CAN APPEAR
C              TO  LEFT  OF  EQUAL  SIGN.  SINGLE PRECISION
C              ARRAYS  NEWNUL  AND   NEWDSK,   AND   DOUBLE
C              PRECISION  ARRAY  NEWNAM MUST BE DIMENSIONED
C              TO AT LEAST  VALUE  OF  MAXFIL,  AND  DOUBLE
C              PRECISION   AND   DOUBLY  DIMENSIONED  ARRAY
C              NEWPTH MUST HAVE 3 AS  ITS  FIRST  DIMENSION
C              AND   MAXFIL   AS   ITS   SECOND  DIMENSION.
C              SWITCHES  ARE  ALWAYS  RETURNED  TO  CALLING
C              PROGRAM  PRIOR  TO  FILE SPECIFICATIONS WITH
C              WHICH THEY  ARE  ASSOCIATED.   ALL  SWITCHES
C              LEFT  OF  EQUAL SIGN AND SWITCHES ASSOCIATED
C              WITH FIRST FILE SPECIFICATION RIGHT OF EQUAL
C              SIGN  WILL  HAVE  BEEN  RETURNED  TO CALLING
C              PROGRAM BEFORE ANY FILE  SPECIFICATIONS  ARE
C              RETURNED.   FIRST CALL TO THIS ROUTINE WHICH
C              RETURNS FILE SPECIFICATIONS CAN RETURN UP TO
C              MAXFIL  FILE  SPECIFICATIONS,  OF WHICH ONLY
C              FILE  SPECIFICATION  WHICH  IS  RETURNED  IN
C              LOCATION  IN  EACH  ARRAY  HAVING  VALUE  OF
C              LCNRIT AS ITS SUBSCRIPT IS TO RIGHT OF EQUAL
C              SIGN.  SUBSEQUENT CALLS TO THIS ROUTINE WILL
C              RETURN EITHER SINGLE SWITCH SPECIFICATION OR
C              SINGLE FILE SPECIFICATION.  EQUAL SIGN FOUND
C              AFTER MORE THAN MAXFIL  FILE  SPECIFICATIONS
C              HAVE  BEEN  FOUND  IS TAKEN AS EQUIVALENT TO
C              COMMA.
C     ITTY   = NUMBER OF UNIT FROM WHICH TERMINAL INPUT  IS
C              TO BE READ.
C     JTTY   = NUMBER OF UNIT TO WHICH TERMINAL  OUTPUT  IS
C              TO BE WRITTEN.
C     KMDNUM = NUMBER  OF  UNIT  FROM  WHICH  COMMAND  FILE
C              INDICATED BY AT SIGN IS TO BE READ.
C     KMDDVC = DEFAULT NAME IN 5H FORM OF DEVICE FROM WHICH
C              COMMAND  FILE IS TO BE READ IF USER FAILS TO
C              SUPPLY DEVICE NAME FOLLOWED BY COLON.
C     KMDNAM = DEFAULT FIRST NAME IN A6 FORM TO BE USED  IN
C              NAME  OF COMMAND FILE IF NONE IS SUPPLIED BY
C              USER.   THIS  MUST  BE  A  DOUBLE  PRECISION
C              VARIABLE ON PDP10 COMPUTER.
C     KMDEXT = DEFAULT EXTENSION IN 3H FORM TO BE  USED  IN
C              NAME  OF COMMAND FILE IF NONE IS SUPPLIED BY
C              USER.  IF COMMAND FILE NAME IS NOT  TO  HAVE
C              EXTENSION,   THEN   USER  MUST  TYPE  PERIOD
C              FOLLOWING FIRST PART OF NAME.
C     MAXSTR = DIMENSION OF INILTR  AND  KNTLTR  ARRAYS  IN
C              WHICH  DESCRIPTIONS OF COMPONENTS OF SWITCHS
C              ARE RETURNED AND WHICH ARE  USED  INTERNALLY
C              WITHIN   THIS   ROUTINE   FOR   STORAGE   OF
C              DESCRIPTIONS  OF  COMPONENTS  OF  EACH  FILE
C              SPECIFICATION.   MAXSTR SHOULD HAVE VALUE OF
C              AT LEAST 6.
C     MAXBFR = DIMENSION OF IBUFFR ARRAY  INTO  WHICH  EACH
C              LINE  OF COMMANDS TYPED BY USER OR READ FROM
C              COMMAND FILE ARE STORED IN  MULTIPLE  OF  A1
C              FORMAT.    MAXBFR   IS   MAXIMUM  NUMBER  OF
C              CHARACTERS  WHICH  CAN  APPEAR   IN   SINGLE
C              COMMAND LINE.  MAXBFR MUST NOT EXCEED 132.
C
C     FOLLOWING ARGUMENT MUST BE SET BEFORE THIS ROUTINE IS
C     FIRST CALLED, BUT THEN VALUE RETURNED BY THIS ROUTINE
C     SHOULD BE SENT TO  FOLLOWING  CALL  OF  THIS  ROUTINE
C     UNCHANGED.
C
C     KIND   = SHOULD  BE  INPUT  SET  TO  ZERO  WHEN  THIS
C              ROUTINE   IS   FIRST   CALLED,  OR  WHENEVER
C              INTERPRETATION OF PREVIOUS SET  OF  COMMANDS
C              IS   TO  BE  ABANDONED.   KIND  IS  RETURNED
C              DESCRIBING  REASON  WHY  CONTROL  HAS   BEEN
C              TRANSFERRED  BACK  TO  CALLING  PROGRAM, AND
C              SHOULD NOT BE CHANGED BY CALLING PROGRAM  IF
C              THIS  ROUTINE  IS  TO  BE  CALLED  AGAIN  TO
C              CONTINUE INTERPRETATION OF SAME SEQUENCE  OF
C              COMMANDS.
C            = 1, RETURNED IF NO MORE  FILE  SPECIFICATIONS
C              REMAIN TO BE EVALUATED.
C            = 2, RETURNED IF SEMICOLON WAS FOUND.  IF THIS
C              ROUTINE  IS CALLED AGAIN WITHOUT KIND HAVING
C              FIRST BEEN ZEROED, THEN  EVALUATION  OF  NEW
C              SET  OF FILE SPECIFICATIONS WILL BE BEGUN IN
C              TEXT  APPEARING  TO  RIGHT   OF   SEMICOLON.
C              APPEARANCE    OF    SEMICOLON    WHEN   FILE
C              SPECIFICATION IS KNOWN BY THIS ROUTINE TO BE
C              INCOMPLETE  WILL  NOT BE REPORTED SINCE TEXT
C              TO RIGHT OF SEMICOLON IS TREATED  AS  IF  IT
C              CONTINUED  FILE SPECIFICATIONS ON SUBSEQUENT
C              LINE OF INPUT.
C            = 3, RETURNED IF THIS ROUTINE IS REPORTING ALL
C              OF  FILE SPECIFICATIONS APPEARING TO LEFT OF
C              EQUAL  SIGN   TOGETHER   WITH   FIRST   FILE
C              SPECIFICATION  TO RIGHT OF EQUAL SIGN, OR IF
C              THIS  ROUTINE  IS   REPORTING   FIRST   FILE
C              SPECIFICATION     IN    SERIES    OF    FILE
C              SPECIFICATIONS WHICH DOES NOT INCLUDE  EQUAL
C              SIGN.
C            = 4, RETURNED IF  THIS  ROUTINE  IS  REPORTING
C              SECOND  OR  SUBSEQUENT FILE SPECIFICATION TO
C              RIGHT OF EQUAL SIGN, OR IF THIS  ROUTINE  IS
C              REPORTING    SECOND   OR   SUBSEQUENT   FILE
C              SPECIFICATION    IN    SERIES    OF     FILE
C              SPECIFICATIONS  WHICH DOES NOT INCLUDE EQUAL
C              SIGN.
C            = 5, RETURNED IF  THIS  ROUTINE  IS  RETURNING
C              DESCRIPTION  OF  SWITCH IN INILTR AND KNTLTR
C              ARRAY LOCATIONS HAVING SUBSCRIPTS 1  THROUGH
C              MAXFLG.  LCNOWN IS RETURNED CONTAINING VALUE
C              OF SUBSCRIPT OF LOCATIONS IN NEWNUL, NEWDSK,
C              NEWNAM AND NEWPTH ARRAYS WHICH WILL DESCRIBE
C              FILE  SPECIFICATION  WHEN   KIND   IS   NEXT
C              RETURNED SET TO EITHER 3 OR 4.
C
C     FOLLOWING  ARGUMENTS  ARE  USED  BOTH  FOR  RETURNING
C     INFORMATION  TO CALLING PROGRAM AND FOR COMMUNICATING
C     WITH SUBSEQUENT  CALLS  OF  THIS  ROUTINE.   ORIGINAL
C     CONTENTS OF THESE ARGUMENTS ARE IGNORED.
C
C     NEWNUL = IF KIND IS RETURNED SET TO EITHER  3  OR  4,
C              THEN   LOCATIONS   IN  NEWNUL  ARRAY  HAVING
C              SUBSCRIPTS 1  THROUGH  LCNRIT  ARE  RETURNED
C              DESCRIBING  WHETHER  FILE  SPECIFICATION WAS
C              FOUND, AND  IF  SO,  WHETHER  EXTENSION  WAS
C              SPECIFIED.
C            = 0, AN EXTRA COMMA INDICATED THAT NO FILE WAS
C              BEING  SPECIFIED.   NO FILE SPECIFICATION IS
C              DESCRIBED  IN  NEWDSK,  NEWNAM  AND   NEWPTH
C              ARRAYS.
C            = 1, EITHER DEVICE NAME OR PATH WAS SPECIFIED,
C              BUT NO FILE NAME WAS SPECIFIED.
C            = 2,  FILE  NAME   BUT   NOT   EXTENSION   WAS
C              SPECIFIED.
C            = 3, BOTH FILE NAME  AND  ITS  EXTENSION  WERE
C              SPECIFIED.
C            = 4, PERIOD AND  EXTENSION WERE SPECIFIED, BUT
C              NO NAME WAS SPECIFIED TO LEFT OF PERIOD.
C     NEWDSK = IF KIND IS RETURNED SET TO EITHER  3  OR  4,
C              THEN   LOCATIONS   IN  NEWDSK  ARRAY  HAVING
C              SUBSCRIPTS 1  THROUGH  LCNRIT  ARE  RETURNED
C              CONTAINING  DEVICE  NAME  IN 5H FORM.  IF NO
C              DEVICE   NAME   IS   SPECIFIED    IN    FILE
C              SPECIFICATIONS  TO  LEFT OF EQUAL SIGN, THEN
C              THESE  LOCATIONS  CONTAIN  BLANKS.   IF   NO
C              DEVICE    NAME    IS   SPECIFIED   IN   FILE
C              SPECIFICATIONS TO RIGHT OF EQUAL SIGN,  THEN
C              THESE LOCATIONS CONTAIN PREVIOUSLY SPECIFIED
C              DEVICE NAME IF ANY  HAS  BEEN  SPECIFIED  TO
C              RIGHT  OF  EQUAL  SIGN, OR CONTAIN BLANKS IF
C              NONE HAS YET  BEEN  SPECIFIED  TO  RIGHT  OF
C              EQUAL SIGN.
C     NEWNAM = IF KIND IS RETURNED SET TO EITHER  3  OR  4,
C              THEN  LOCATIONS  IN  NEWNAM DOUBLE PRECISION
C              ARRAY HAVING SUBSCRIPTS 1 THROUGH LCNRIT ARE
C              RETURNED  CONTAINING FILE NAME AND EXTENSION
C              IN A10 FORM (FORMAT 1A6,1H.,1A3).
C     NEWPTH = IF KIND IS RETURNED SET TO EITHER  3  OR  4,
C              THEN  LOCATIONS  IN  NEWPTH DOUBLE PRECISION
C              AND   DOUBLY   DIMENSIONED   ARRAY    HAVING
C              SUBSCRIPTS  1  THROUGH  LCNRIT  ARE RETURNED
C              CONTAINING PATH UPON WHICH FILE IS  LOCATED.
C              IF    NO   PATH   IS   SPECIFIED   IN   FILE
C              SPECIFICATIONS TO LEFT OF EQUAL  SIGN,  THEN
C              THESE  LOCATIONS CONTAIN ZEROES.  IF NO PATH
C              IS SPECIFIED IN FILE SPECIFICATIONS TO RIGHT
C              OF  EQUAL SIGN, THEN THESE LOCATIONS CONTAIN
C              PREVIOUSLY SPECIFIED PATH IF  ANY  HAS  BEEN
C              SPECIFIED TO RIGHT OF EQUAL SIGN, OR CONTAIN
C              ZEROES IF NONE HAS  YET  BEEN  SPECIFIED  TO
C              RIGHT OF EQUAL SIGN.  NEWPTH(1,...) CONTAINS
C              IN ITS LEFT HALF PROJECT NUMBER AND  IN  ITS
C              RIGHT  HALF  PROGRAMMER  NUMBER, OR CONTAINS
C              ZERO  IF  NO  PATH   HAS   BEEN   SPECIFIED.
C              NEWPTH(2,...)  CONTAINS  SUB  FILE DIRECTORY
C              (SFD) NAME  IN  6H  FORM  IF  ANY  HAS  BEEN
C              SPECIFIED,   OR   CONTAINS  ZERO  OTHERWISE.
C              NEWPTH(3,...) ALWAYS CONTAINS ZERO.
C     LCNRIT = IF KIND IS RETURNED SET TO EITHER  3  OR  4,
C              THEN  LCNRIT IS RETURNED CONTAINING VALUE OF
C              SUBSCRIPT OF LOCATIONS  IN  NEWNUL,  NEWDSK,
C              NEWNAM AND NEWPTH ARRAYS WHICH DESCRIBE FILE
C              SPECIFICATION  WHICH  APPEARS  TO  RIGHT  OF
C              EQUAL  SIGN.   IF  KIND IS RETURNED SET TO 3
C              AND IF LCNRIT  IS  GREATER  THAN  ONE,  THEN
C              LOWER  LOCATIONS  IN  THESE  ARRAYS DESCRIBE
C              FILE SPECIFICATIONS  APPEARING  TO  LEFT  OF
C              EQUAL  SIGN.   IF KIND IS RETURNED SET TO 4,
C              THEN LOCATIONS WITHIN  THESE  ARRAYS  HAVING
C              LOWER SUBSCRIPTS SHOULD BE IGNORED.
C     IBUFFR = ARRAY  INTO  WHICH  THIS  ROUTINE  CAN  READ
C              CHARACTERS   TYPED  BY  USER  OR  READ  FROM
C              COMMAND FILE.
C     MAXFLG = IF KIND IS RETURNED SET TO 5, THEN MAXFLG IS
C              RETURNED  CONTAINING  SUPSCRIPT OF LOCATIONS
C              IN INILTR AND KNTLTR ARRAYS  WHICH  DESCRIBE
C              RIGHTMOST COMPONENT OF SWITCH.
C     INILTR = IF KIND IS RETURNED SET TO 5, THEN LOCATIONS
C              IN  INILTR ARRAY HAVING SUBSCRIPTS 1 THROUGH
C              VALUE  OF  MAXFLG  ARE  RETURNED  CONTAINING
C              VALUES  OF  SUBSCRIPTS  OF  LOCATIONS WITHIN
C              IBUFFR ARRAY AT WHICH EACH OF COMPONENTS  OF
C              SWITCH START.
C     KNTLTR = IF KIND IS RETURNED SET TO 5, THEN LOCATIONS
C              IN  INILTR ARRAY HAVING SUBSCRIPTS 1 THROUGH
C              VALUE  OF  MAXFLG  ARE  RETURNED  CONTAINING
C              NUMBER   OF   CHARACTERS   WITHIN   EACH  OF
C              COMPONENTS OF SWITCH.  MISSING COMPONENT  OF
C              SWITCH  IS INDICATED BY ZERO VALUE IN KNTLTR
C              ARRAY.
C     LCNOWN = IF KIND IS RETURNED SET TO 5, THEN LCNOWN IS
C              RETURNED  CONTAINING  VALUE  OF SUBSCRIPT OF
C              LOCATIONS  IN  NEWNUL,  NEWDSK,  NEWNAM  AND
C              NEWPTH   ARRAYS  WHICH  WILL  DESCRIBE  FILE
C              SPECIFICATION WHEN KIND IS NEXT RETURNED SET
C              TO EITHER 3 OR 4.
C
      COMMON/FASPZ/KNTFIL,MANY,IEOF,IAFTER,LSTPTH,LSTDSK,
     1LOWBFR
      DIMENSION INILTR(MAXSTR),KNTLTR(MAXSTR),
     1IBUFFR(MAXBFR),NEWNUL(MAXFIL),NEWDSK(MAXFIL),
     2LETTER(8),KOLECT(10),NUMTWO(2)
      DOUBLE PRECISION NEWNAM(MAXFIL),NEWPTH(3,MAXFIL),
     1KOMAND,ONEPTH(3),LSTPTH(3),TWONUM,KMDNAM
      EQUIVALENCE (TWONUM,NUMTWO),(NEWPRJ,NUMTWO(1)),
     1(NEWUSR,NUMTWO(2))
      DATA LETTER/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7/
      DATA IBLANK,JBLANK,IDOT/1H ,5H     ,1H./
C
C     DECIDE WHETHER ARE STARTING OR CONTINUING EVALUATION
      IF(KIND.EQ.5)GO TO 9
      IF(KIND.GE.3)GO TO 30
      LCNRIT=0
      KNTFIL=0
      IAFTER=0
      MANY=0
      IF(KIND.EQ.2)GO TO 9
C
C     READ CONTENTS OF NEXT LINE
      WRITE(JTTY,1)
    1 FORMAT(2H *,$)
      GO TO 4
    2 WRITE(JTTY,3)
    3 FORMAT(2H &,$)
    4 READ(ITTY,5,END=10)IBUFFR
    5 FORMAT(132A1)
      IEOF=0
      GO TO 7
    6 READ(KMDNUM,5,END=10)IBUFFR
      IEOF=1
    7 LOWBFR=1
      GO TO 9
    8 LCNRIT=1
      KNTFIL=0
C
C     LOCATE NEXT FILE SPECIFICATION
    9 CALL DAFLAG(1,1,MAXSTR,MAXBFR,IBUFFR,
     1LOWBFR,MANY,KIND,INILTR,KNTLTR,MAXDSK,MAXNAM,
     2MAXNUM,MAXFLG,KONTNT,MINPRT,MAXPRT)
      GO TO(11,11,13,15,16,17,17,17),KIND
C
C     END OF LINE, END OF FILE OR SEMICOLON FOUND
   10 KIND=1
      IEOF=0
   11 IF(IAFTER.LT.0)GO TO 14
      IF(IAFTER.EQ.1)GO TO 14
      IF(KNTFIL.GT.0)GO TO 12
      IF(LCNRIT.EQ.0)GO TO 15
      IF(KIND.EQ.2)GO TO 37
      IF(IEOF.EQ.0)GO TO 37
      GO TO 6
   12 IF(KIND.EQ.2)LOWBFR=LOWBFR-1
      GO TO 29
C
C     EQUAL SIGN FOUND
   13 IF(IAFTER.GT.0)GO TO 27
      MANY=-1
      IAFTER=0
      LCNRIT=-1
      GO TO 9
C
C     AMPERSAND FOUND OR MORE FILES NEEDED
   14 KNTFIL=KNTFIL-1
      MANY=-1
      IAFTER=0
   15 IF(KIND.EQ.2)GO TO 9
      IF(IEOF.NE.0)GO TO 6
      GO TO 2
C
C     EXTRA COMMA FOUND
   16 IF(IAFTER.GT.0)GO TO 27
      KNTFIL=KNTFIL+1
      NEWNUL(KNTFIL)=0
      IAFTER=1
      GO TO 19
C
C     EVALUATE LOCATION AND REPACK DEVICE AND FILE NAME
   17 IF(KONTNT.EQ.0)GO TO 20
      IF(IAFTER.GT.0)GO TO 28
      NXTFIL=KNTFIL+1
      GO TO 38
   18 IF(KONTNT.GE.16)GO TO 21
      KNTFIL=NXTFIL
      IAFTER=2
   19 IF(LCNRIT.NE.0)GO TO 9
      IF(KNTFIL.LT.MAXFIL)IAFTER=IAFTER-2
      GO TO 9
C
C     ALLOW CALLING PROGRAM TO EVALUATE SWITCH
   20 LCNOWN=KNTFIL
      KIND=5
      IF(MANY.GT.0)GO TO 37
      IF(IAFTER.GT.0)GO TO 28
      MANY=-1
      LCNOWN=LCNOWN+1
      GO TO 37
C
C     OPEN COMMAND FILE SPECIFIED BY USER
   21 KOMAND=NEWNAM(NXTFIL)
      IF(NEWNUL(NXTFIL).LE.1)ENCODE(10,22,KOMAND)
     1KMDNAM,KMDEXT
      IF(NEWNUL(NXTFIL).EQ.2)ENCODE(10,22,KOMAND)
     1NEWNAM(NXTFIL),KMDEXT
   22 FORMAT(1A6,1H.,1A3)
      IF(NEWNUL(NXTFIL).EQ.4)ENCODE(10,23,KOMAND)
     1KMDNAM,(KOLECT(I),I=8,10)
   23 FORMAT(1A6,1H.,3A1)
      INDISK=NEWDSK(NXTFIL)
      IF(INDISK.EQ.JBLANK)INDISK=KMDDVC
      DO 24 I=1,3
   24 ONEPTH(I)=NEWPTH(I,NXTFIL)
      OPEN(UNIT=KMDNUM,DEVICE=INDISK,FILE=KOMAND,
     1DIRECTORY=ONEPTH,ACCESS=5HSEQIN,ERR=25)
      GO TO 6
   25 WRITE(JTTY,26)(IBUFFR(I),I=MINPRT,MAXPRT)
   26 FORMAT(26H CANNOT READ COMMAND FROM ,100A1)
      GO TO 2
C
C     PREPARE TO RETURN RESULTS TO CALLING PROGRAM
   27 MANY=-1
      GO TO 29
   28 LOWBFR=MINPRT
   29 IAFTER=0
      IF(LCNRIT.GT.0)GO TO 31
      KIND=3
      IF(LCNRIT.LT.0)GO TO 33
      LCNRIT=1
      GO TO 34
   30 LCNRIT=LCNRIT+1
   31 IF(LCNRIT.GT.KNTFIL)GO TO 8
      KIND=4
      IF(NEWNUL(LCNRIT).EQ.0)GO TO 37
      IF(NEWDSK(LCNRIT).EQ.JBLANK)NEWDSK(LCNRIT)=LSTDSK
      IF(NEWPTH(1,LCNRIT).NE.0)GO TO 34
      DO 32 I=1,3
   32 NEWPTH(I,LCNRIT)=LSTPTH(I)
      GO TO 36
   33 LCNRIT=KNTFIL
   34 DO 35 I=1,3
   35 LSTPTH(I)=NEWPTH(I,LCNRIT)
   36 LSTDSK=NEWDSK(LCNRIT)
C
C     RETURN TO CALLING PROGRAM
   37 RETURN
C
C     *****************************************************
C     *                                                   *
C     *  A10 PACK NAME, A5 PACK DEVICE, EVALUATE NUMBERS  *
C     *                                                   *
C     *****************************************************
C
C     SET SWITCHES WHICH STATE IF ANYTHING WAS FOUND
   38 NEWPRJ=0
      NEWUSR=0
      DO 39 I=1,3
   39 NEWPTH(I,NXTFIL)=TWONUM
      NEWNUL(NXTFIL)=0
      NEWDSK(NXTFIL)=JBLANK
C
C     PACK DEVICE NAME INTO A5 FORM
      IF(MAXDSK.LT.1)GO TO 42
      KOUNT=KNTLTR(1)
      IF(KOUNT.LE.0)GO TO 42
      IBGN=INILTR(1)
      DO 40 I=1,5
      KOLECT(I)=IBLANK
      IF(KOUNT.GT.0)KOLECT(I)=IBUFFR(IBGN)
      IBGN=IBGN+1
   40 KOUNT=KOUNT-1
      ENCODE(5,41,NEWDSK(NXTFIL))(KOLECT(I),I=1,5)
   41 FORMAT(5A1)
      NEWNUL(NXTFIL)=1
C
C     EVALUATE OCTAL PROJECT, PROGRAMMER NUMBERS
   42 INDEX=MAXNAM+1
      IF(INDEX.GE.MAXNUM)GO TO 48
   43 KOUNT=KNTLTR(INDEX)
      IF(KOUNT.LE.0)GO TO 48
      IBGN=INILTR(INDEX)
      IEND=IBGN+KOUNT-1
      NEWPRJ=NEWUSR
      NEWUSR=0
      DO 45 I=IBGN,IEND
      LTRNOW=IBUFFR(I)
      NEWUSR=8*NEWUSR
      DO 44 J=1,8
      IF(LETTER(J).NE.LTRNOW)GO TO 44
      NEWUSR=NEWUSR+J-1
      GO TO 45
   44 CONTINUE
   45 CONTINUE
      IF(NEWUSR.LE.0)GO TO 48
      INDEX=INDEX+1
      IF(INDEX.LE.(MAXNAM+2))GO TO 43
      NEWPTH(1,NXTFIL)=TWONUM
      NEWNUL(NXTFIL)=1
C
C     PACK SUB FILE DIRECTORY NAME
      IF(MAXNUM.LE.(MAXNAM+2))GO TO 48
      KOUNT=KNTLTR(MAXNAM+3)
      IF(KOUNT.LE.0)GO TO 48
      IBGN=INILTR(MAXNAM+3)
      DO 46 I=1,6
      KOLECT(I)=IBLANK
      IF(KOUNT.GT.0)KOLECT(I)=IBUFFR(IBGN)
      IBGN=IBGN+1
   46 KOUNT=KOUNT-1
      ENCODE(10,47,NEWPTH(2,NXTFIL))(KOLECT(I),I=1,6)
   47 FORMAT(6A1,4X)
C
C     PACK FILE NAME AND ITS EXTENSION INTO A10 FORM
   48 DO 49 I=1,10
   49 KOLECT(I)=IBLANK
      IF(MAXNAM.LE.MAXDSK)GO TO 55
      KOUNT=KNTLTR(MAXDSK+1)
      IF(KOUNT.LE.0)GO TO 51
      NEWNUL(NXTFIL)=2
      IBGN=INILTR(MAXDSK+1)
      IF(KOUNT.GT.6)KOUNT=6
      DO 50 I=1,KOUNT
      KOLECT(I)=IBUFFR(IBGN)
   50 IBGN=IBGN+1
      IF(MAXNAM.LE.(MAXDSK+1))GO TO 54
      NEWNUL(NXTFIL)=3
      KOUNT=KNTLTR(MAXDSK+2)
      GO TO 52
   51 IF(MAXNAM.LE.(MAXDSK+1))GO TO 55
      KOUNT=KNTLTR(MAXDSK+2)
      IF(KOUNT.LE.0)GO TO 55
      NEWNUL(NXTFIL)=4
   52 IBGN=INILTR(MAXDSK+2)
      IF(KOUNT.GT.3)KOUNT=3
      DO 53 I=8,10
      IF(KOUNT.GT.0)KOLECT(I)=IBUFFR(IBGN)
      IBGN=IBGN+1
   53 KOUNT=KOUNT-1
   54 KOLECT(7)=IDOT
   55 ENCODE(10,56,NEWNAM(NXTFIL))KOLECT
   56 FORMAT(10A1)
      GO TO 18
C610045095007$&
      END
      SUBROUTINE DAFLAG(KONECT,LOWSTR,MAXSTR,MAXBFR,IBUFFR,
     1    LOWBFR,MANY  ,KIND  ,INILTR,KNTLTR,MAXDSK,MAXNAM,
     2    MAXNUM,MAXFLG,KONTNT,MINPRT,MAXPRT)
C     RENBR(/EVALUATE FORM DSK:NAME.EXT[NUMBER,NUMBER])
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO LOCATE COMPONENTS OF FILE SPECIFICATION OF
C     FORM
C
C     DSK:NAME.EXT[12,34,56]/SWITCH:ARGUMENT/SWITCH:'TEXT'
C
C     ONLY  ONE  DEVICE  FIELD,  ONE  NAME  FIELD  AND  ONE
C     BRACKETED FIELD CAN APPEAR IN THE FILE SPECIFICATION.
C     THE DEVICE FIELD MUST APPEAR BEFORE THE  NAME  FIELD,
C     BUT  THE  BRACKETED  FIELD CAN BE BEFORE, BETWEEN, OR
C     AFTER THESE.  THE SWITCH  FIELDS  CAN  APPEAR  BEFORE
C     AND/OR AFTER THE REST OF THE FILE SPECIFICATION.
C
C     THE  COMPONENTS  OF  EACH  FIELD  WITHIN   THE   FILE
C     DESCRIPTION  ARE IDENTIFIED TO THE CALLING PROGRAM BY
C     LENGTH AND BY STARTING LOCATION  WITHIN  THE  BUFFER.
C     THIS  INFORMATION  IS  RETURNED  WITHIN  THE 2 ARRAYS
C     KNTLTR AND INILTR RESPECTIVELY.  SINCE EACH FIELD CAN
C     CONSIST  OF ANY NUMBER OF COMPONENTS CONNECTED BY THE
C     APPROPRIATE CHARACTER (COLON, COMMA OR  PERIOD),  AND
C     SINCE  FOR  SOME  APPLICATIONS  A  TERMINAL SEPARATOR
C     CHARACTER HAS SPECIAL MEANING, A ZERO CHARACTER COUNT
C     IS  RETURNED  IN  THE  KNTLTR  ARRAY  FOR  THE  FINAL
C     COMPONENT OF A FIELD IN WHICH  AN  OPTIONAL  TERMINAL
C     CONNECTING  CHARACTER IS FOUND.  SINCE THERE IS NEVER
C     ANY QUESTION ABOUT WHETHER  AN  ITEM  IN  THE  DEVICE
C     FIELD  WAS  FOLLOWED BY THE CONNECTING CHARACTER, THE
C     DESCRIPTION OF THE DEVICE FIELD DOES  NOT  INCLUDE  A
C     FINAL ZERO CHARACTER COUNT.
C
C     A TEXT STRING DELIMITED BY APOSTROPHES IS TREATED  AS
C     A  SWITCH  EVEN  IF  NOT  PRECEDED  BY  A SLASH.  THE
C     LOCATION OF A TEXT STRING  IS  THAT  OF  THE  INITIAL
C     APOSTROPHE,  AND THE LENGTH INCLUDES THE INITIAL, BUT
C     NOT THE FINAL, APOSTROPHE.  IF THE  FINAL  APOSTROPHE
C     IS MISSING, THEN THE TEXT STRING IS ASSUMED TO EXTEND
C     THROUGH  THE  RIGHTMOST  PRINTING  CHARACTER  IN  THE
C     BUFFER.    WITHIN   A   TEXT   STRING,  TWO  ADJACENT
C     APOSTROPHES INDICATE A SINGLE APOSTROPHE WHICH IS  TO
C     BE   INCLUDED  WITHIN  THE  STRING.   IF  2  ADJACENT
C     APOSTROPHES ARE ENCOUNTERED WITHIN THE  TEXT  STRING,
C     THEN THE REMAINDER OF THE STRING IS MOVED 1 CHARACTER
C     TO THE LEFT SO THAT  THE  RETURNED  CONTENTS  OF  THE
C     BUFFER AND THE RETURNED LENGTH IN THE KNTLTR ARRAY DO
C     NOT INCLUDE THE EXTRA APOSTROPHE.
C
C     AN  ASTERISK  WHICH  IS  FOLLOWED  IMMEDIATELY  BY  A
C     PRINTING  CHARACTER  OTHER THAN A PUNCTUATION MARK IS
C     TREATED  AS  THOUGH  SEPARATED  FROM  THIS  FOLLOWING
C     CHARACTER  BY  A  PERIOD  IF  IN THE NAME FIELD, BY A
C     COMMA IF IN THE BRACKETED FIELD OR BY A COLON  IF  IN
C     THE SWITCH FIELD.
C
C     FOR EXAMPLE, IF THE CONTENTS OF THE BUFFER ARE
C
C     DSK:DAFLAG.F4[6001,56,FASP]/LINE:60:/TITLE:'JAN 76'
C
C     THEN THE FOLLOWING INFORMATION WOULD BE RETURNED BY 3
C     CONSECUTIVE CALLS TO THIS ROUTINE
C
C     FIELD         KNTLTR CONTENTS      INILTR CONTENTS
C
C     BY THE FIRST CALL TO THIS ROUTINE
C
C     DEVICE              3                    1
C
C     NAME                6                    5
C                         2                   12
C
C     BRACKETED           4                   15
C                         2                   20
C                         4                   23
C
C     BY THE SECOND CALL TO THIS ROUTINE
C
C     SWITCH              4                   29
C                         2                   34
C                         0                UNDEFINED
C
C     BY THE THIRD CALL TO THIS ROUTINE
C
C     SWITCH              5                   38
C                         7                   44
C
C     THE FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT.
C
C     KONECT = -1, SPACES AND/OR TAB CHARACTERS CAN  APPEAR
C              BETWEEN  COMPONENTS  OF  ANY  FIELD, AND CAN
C              REPLACE SEPARATING PERIODS AND COMMAS IN THE
C              NAME   AND  BRACKETED  FIELDS  RESPECTIVELY.
C              SUCH  SPACES  AND/OR  TABS  MARK  END  OF  A
C              PARTICULAR  COMPONENT  OF  FIELD, BUT DO NOT
C              SIGNAL EITHER END OF FIELD OR  END  OF  FILE
C              SPECIFICATION.      COMPONENTS    OF    FILE
C              SPECIFICATION WILL BE LOCATED THROUGH END OF
C              BUFFER,   OR  UP  TO  FOLLOWING  EXCLAMATION
C              POINT, AMPERSAND  OR  SEMICOLON,  OR  UP  TO
C              FOLLOWING  COMMA  WHICH  IS NOT IN BRACKETED
C              FIELD.  SINGLE CALL  TO  THIS  ROUTINE  WILL
C              REPORT  EITHER  CONTENTS  OF  SINGLE  SWITCH
C              FIELD OR COMBINATION OF DEVICE  FIELD,  NAME
C              FIELD  AND  BRACKETED  FIELD  WHETHER OR NOT
C              THESE ARE SEPARATED BY SPACES AND/OR TABS.
C            = 0, SIMILAR TO KONECT=-1 EXCEPT  THAT  SPACES
C              AND  TAB  CHARACTERS  CANNOT  APPEAR BETWEEN
C              FIELDS AND CANNOT APPEAR BETWEEN  COMPONENTS
C              OF    DEVICE    AND   NAME   FIELDS.    FILE
C              SPECIFICATION WILL BEGIN WITH FIRST PRINTING
C              CHARACTER  OTHER THAN PUNCTUATION CHARACTERS
C              COMMA, AMPERSAND, EQUALS SIGN, SEMICOLON  OR
C              EXCLAMATION  POINT,  THEN EXTEND THROUGH END
C              OF BUFFER, OR  UP  TO  FIRST  SPACE  OR  TAB
C              CHARACTER  WHICH  WHICH  IS  NEITHER  WITHIN
C              BRACKETED FIELD NOR WITHIN SWITCH FIELD  NOR
C              WITHIN TEXT STRING DELIMITED BY APOSTROPHES,
C              OR  UP  TO  FOLLOWING   EXCLAMATION   POINT,
C              AMPERSAND  OR  SEMICOLON, OR UP TO FOLLOWING
C              COMMA  WHICH  IS  NOT  IN  BRACKETED  FIELD.
C              SINGLE  CALL  TO  THIS  ROUTINE  WILL REPORT
C              EITHER CONTENTS OF SINGLE  SWITCH  FIELD  OR
C              COMBINATION  OF DEVICE FIELD, NAME FIELD AND
C              BRACKETED   FIELD   PROVIDING   THESE    ARE
C              CONTIGUOUS.
C            = 1, SIMILAR TO KONECT=-1 EXCEPT  THAT  SPACES
C              AND  TAB  CHARACTERS  CANNOT  APPEAR BETWEEN
C              COMPONENTS OF DEVICE AND NAME FIELDS.
C     LOWSTR = SUBSCRIPT OF FIRST  LOCATION  WITHIN  INILTR
C              AND  KNTLTR ARRAYS WHICH CAN BE USED TO HOLD
C              DESCRIPTION   OF    COMPONENTS    OF    FILE
C              SPECIFICATION.
C     MAXSTR = SUBSCRIPT OF FINAL  LOCATION  WITHIN  INILTR
C              AND  KNTLTR ARRAYS WHICH CAN BE USED TO HOLD
C              DESCRIPTION   OF    COMPONENTS    OF    FILE
C              SPECIFICATION.
C     MAXBFR = SUBSCRIPT  OF  FINAL  (RIGHTMOST)   LOCATION
C              WITHIN IBUFFR ARRAY WHICH CONTAINS CHARACTER
C              WHICH CAN BE PART OF FILE SPECIFICATION.
C
C     FOLLOWING ARGUMENTS ARE USED FOR BOTH INPUT  TO,  AND
C     OUTPUT FROM THIS ROUTINE.
C
C     IBUFFR = ARRAY CONTAINING IN LOCATIONS IBUFFR(LOWBFR)
C              THROUGH  IBUFFR(MAXBFR)  CHARACTERS  READ BY
C              CALLING PROGRAM WITH MULTIPLE OF  A1  FORMAT
C              AND   WHICH  CAN  FORM  FILE  SPECIFICATION.
C              CONTENTS  OF  IBUFFR  ARRAY   ARE   RETURNED
C              UNCHANGED,  WITH  EXCEPTION  THAT PORTION OF
C              TEXT STRING TO RIGHT OF ADJACENT APOSTROPHES
C              IN  TEXT  STRING  IN SWITCH FIELD IS MOVED 1
C              CHARACTER TO LEFT.
C     LOWBFR = SUBSCRIPT  OF  FIRST   (LEFTMOST)   LOCATION
C              WITHIN IBUFFR ARRAY WHICH CONTAINS CHARACTER
C              WHICH CAN BE  PART  OF  FILE  SPECIFICATION.
C              LOWBFR   IS   RETURNED   POINTING  TO  FIRST
C              CHARACTER  WHICH  SHOULD  BE  EVALUATED   BY
C              SUBSEQUENT  CALL TO THIS ROUTINE, OR ELSE IS
C              RETURNED POINTING BEYOND END  OF  BUFFER  IF
C              BUFFER IS EMPTY OR IF BUFFER CONTAINS MERELY
C              COMMENT.
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF A NEW LOGICAL SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE  WHEN BEGINNING PROCESSING OF A LINE
C              OF TEXT NOT TIED TO THE PREVIOUS LINE BY  AN
C              AMPERSAND  AT  THE END OF THE PREVIOUS LINE,
C              OR WHEN PROCESSING THE TEXT TO THE RIGHT  OF
C              A  SEMICOLON  OR  TO  THE RIGHT OF AN EQUALS
C              SIGN.
C            = RETURNED CONTAINING  THE  VALUE  WHICH  MANY
C              SHOULD  HAVE  WHEN THIS ROUTINE OR ANY OTHER
C              IN  THE  FASP  PACKAGE  HAVING  MANY  AS  AN
C              ARGUMENT IS NEXT CALLED.  THE RETURNED VALUE
C              OF MANY SHOULD NOT BE CHANGED BY THE CALLING
C              PROGRAM  UNLESS  THE  INTERPRETATION  OF THE
C              CONTENTS OF THE BUFFER  IS  BEING  ABANDONED
C              PREMATURELY,  IN  WHICH  CASE MANY SHOULD BE
C              RESET TO HAVE A ZERO VALUE.
C            = -1, RETURNED IF A  MISSING  ITEM  IS  TO  BE
C              INDICATED  IF  THE NEXT ROUTINE ENCOUNTERS A
C              LEADING  COMMA  OR  FINDS  THAT  THE  BUFFER
C              CONTAINS   NOTHING  OTHER  THAN  A  POSSIBLE
C              COMMENT.  MANY IS RETURNED CONTAINING -1  IF
C              A  COMMA  PRECEDES  EITHER AN AMPERSAND OR A
C              SWITCH FIELD.
C            = 0, RETURNED IF  A  MISSING  ITEM  IS  TO  BE
C              INDICATED  IF  THE NEXT ROUTINE ENCOUNTERS A
C              LEADING COMMA, BUT A  MISSING  ITEM  IS  NOT
C              INDICATED  IF  THE  BUFFER  CONTAINS NOTHING
C              OTHER THAN  A  POSSIBLE  COMMENT.   MANY  IS
C              RETURNED  CONTAINING ZERO IF BUFFER IS FOUND
C              TO BE EMPTY, OR IF FIRST PRINTING  CHARACTER
C              AT OR TO RIGHT OF IBUFFR(LOWBFR) IS FOUND TO
C              BE EXCLAMATION POINT,  SEMICOLON  OR  EQUALS
C              SIGN.   THESE ARE ALL CONDITIONS UNDER WHICH
C              NEXT CALL TO  THIS  ROUTINE  WOULD  EVALUATE
C              START  OF  NEW GROUP OF FILE SPECIFICATIONS.
C              MANY IS RETURNED UNCHANGED IF A SWITCH FIELD
C              IS FOUND AT THE START OF THE CONTENTS OF THE
C              BUFFER.
C            = 1, RETURNED IF A MISSING ITEM IS NOT  TO  BE
C              INDICATED  IF  THE NEXT ROUTINE ENCOUNTERS A
C              LEADING  COMMA  OR  FINDS  THAT  THE  BUFFER
C              CONTAINS   NOTHING  OTHER  THAN  A  POSSIBLE
C              COMMENT.  MANY IS RETURNED CONTAINING ONE IF
C              A FILE SPECIFICATION CONSISTING OF MORE THAN
C              JUST A  SWITCH  FIELD  IS  FOUND,  OR  IF  A
C              MISSING ITEM IS BEING INDICATED.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT.   THEIR
C     INPUT VALUES ARE IGNORED.
C
C     KIND   = RETURNED    DESCRIBING    TYPE    OF    ITEM
C              ENCOUNTERED.
C            = 1,   NOTHING,   EXCEPT   POSSIBLY    COMMENT
C              INDICATED  BY LEADING EXCLAMATION POINT, WAS
C              FOUND AT  OR  TO  RIGHT  OF  IBUFFR(LOWBFR).
C              LOWBFR  IS  RETURNED  POINTING BEYOND END OF
C              BUFFER.
C            = 2, FIRST PRINTING CHARACTER AT OR  TO  RIGHT
C              OF  IBUFFR(LOWBFR)  IS SEMICOLON.  LOWBFR IS
C              RETURNED POINTING TO CHARACTER TO  RIGHT  OF
C              SEMICOLON.   IT  IS  SUGGESTED  THAT CALLING
C              PROGRAM TREAT THIS  AS  INDICATION  BY  USER
C              THAT  PRECEDING  COMMAND  HAS BEEN COMPLETED
C              AND THAT SUBSEQUENT COMMAND WILL  FOLLOW  ON
C              SAME LINE.
C            = 3, FIRST PRINTING CHARACTER AT OR  TO  RIGHT
C              OF IBUFFR(LOWBFR) IS EQUALS SIGN.  LOWBFR IS
C              RETURNED POINTING TO CHARACTER TO  RIGHT  OF
C              EQUALS SIGN.  ON PDP10 COMPUTER, EQUALS SIGN
C              IS USED TO SEPARATE DESTINATION  AND  SOURCE
C              FILE SPECIFICATIONS.
C            = 4, FIRST PRINTING CHARACTER AT OR  TO  RIGHT
C              OF  IBUFFR(LOWBFR) IS AMPERSAND.  CHARACTERS
C              TO  RIGHT  OF  AMPERSAND  ARE  TAKEN  TO  BE
C              COMMENT.  LOWBFR IS RETURNED POINTING BEYOND
C              END OF BUFFER.  IT IS SUGGESTED THAT CALLING
C              PROGRAM  TREAT  THIS AS REQUEST BY USER THAT
C              COMMAND  BE  CONTINUED  ON  FOLLOWING  LINE.
C              EFFECT  IS  NOT  QUITE  SAME  AS IF USER HAD
C              TYPED ALL OF FILE SPECIFICATIONS  ON  SINGLE
C              LINE  SINCE  FILE  SPECIFICATION  CANNOT  BE
C              SPLIT ACROSS LINE BOUNDARY.
C            = 5, MISSING FILE SPECIFICATION WAS  INDICATED
C              BY AN EXTRA COMMA.
C            = 6,  PARTIAL  FILE  SPECIFICATION  WAS  FOUND
C              WHICH  WILL  BE CONTINUED BY SUBSEQUENT CALL
C              TO  THIS  ROUTINE.    MANY   WILL   NOT   BE
C              INCREMENTED  UNTIL  FINAL  SECTION  OF  FILE
C              SPECIFICATION    (KIND    BEING     RETURNED
C              CONTAINING 7 OR 8) IS LOCATED.  IF FILE NAME
C              AND/OR DEVICE  AND/OR  BRACKETED  FIELD  HAS
C              BEEN  FOUND BY CURRENT CALL TO THIS ROUTINE,
C              THEN PORTION  TO  RIGHT  OF  THAT  EVALUATED
C              CONTAINS  SWITCH.   IF SWITCH HAS BEEN FOUND
C              BY  CURRENT  CALL  TO  THIS  ROUTINE,   THEN
C              PORTION   RIGHT   OF  THAT  EVALUATED  COULD
C              CONTAIN ANY ITEM.
C            = 7, FILE SPECIFICATION AND/OR  SWITCHES  WERE
C              FOUND.   IF  PREVIOUS  CALL  TO THIS ROUTINE
C              RETURNED    KIND=6    INDICATING     PARTIAL
C              SPECIFICATION,  THEN INFORMATION RETURNED BY
C              CURRENT CALL TO THIS ROUTINE COMPLETES  FILE
C              SPECIFICATION.
C            = 8, FILE SPECIFICATION AND/OR  SWITCHES  WERE
C              FOUND, BUT THESE WERE FOLLOWED BY UNEXPECTED
C              CHARACTER POINTED TO BY  RETURNED  VALUE  OF
C              LOWBFR.        FOR       EXAMPLE,       TEXT
C              DEVICE:NAME.EXTENSION:  WOULD  BE  EVALUATED
C              AS  THOUGH BUFFER TERMINATED PRIOR TO SECOND
C              COLON, AND LOWBFR WILL BE RETURNED  POINTING
C              TO      THIS     SECOND     COLON.      TEXT
C              DEVICE:NAME.EXTENSION[6001,56][22,56]  WOULD
C              BE  EVALUATED  AS  THOUGH  BUFFER TERMINATED
C              PRIOR TO SECOND BRACKETED FIELD, AND  LOWBFR
C              WOULD  BE  RETURNED  POINTING TO SECOND LEFT
C              BRACKET.
C     INILTR = ARRAY RETURNED CONTAINING SUBSCRIPTS  WITHIN
C              IBUFFR  ARRAY OF INITIAL CHARACTERS OF WORDS
C              FORMING   FILE   SPECIFICATION.    LOCATIONS
C              INILTR(LOWSTR)     THROUGH    INILTR(MAXDSK)
C              CONTAIN  LOCATIONS  IN  BUFFER  OF   INITIAL
C              CHARACTERS   OF   DEVICE  NAMES.   LOCATIONS
C              INILTR(MAXDSK+1)   THROUGH    INILTR(MAXNAM)
C              CONTAIN   LOCATIONS  IN  BUFFER  OF  INITIAL
C              CHARACTERS   OF   WORDS   IN   NAME   FIELD.
C              LOCATIONS      INITLR(MAXNAM+1)      THROUGH
C              INILTR(MAXNUM) CONTAIN LOCATIONS  IN  BUFFER
C              OF  INITIAL CHARACTERS OF WORDS IN BRACKETED
C              FIELD.    LOCATIONS  INILTR(LOWSTR)  THROUGH
C              INILTR(MAXFLG)  CONTAIN  LOCATIONS IN BUFFER
C              OF INITIAL  CHARACTERS  OF  WORDS  AND  TEXT
C              STRINGS APPEARING IN SWITCH FIELDS.  IF TEXT
C              STRING APPEARS IN SWITCH FIELD, LOCATION  IN
C              IBUFFR  ARRAY INDICATED BY INILTR ARRAY WILL
C              CONTAIN APOSTROPHE.
C     KNTLTR = ARRAY   RETURNED   CONTAINING   NUMBERS   OF
C              CHARACTERS  IN EACH OF WORDS FOR WHICH FIRST
C              CHARACTERS ARE IN BUFFER LOCATIONS INDICATED
C              BY  VALUES  IN  INILTR ARRAY.  SUBSCRIPTS OF
C              INILTR  ARRAY  AND  KNTLTR  ARRAY  LOCATIONS
C              DESCRIBING PARTICULAR WORD ARE IDENTICAL.
C     MAXDSK = RETURNED CONTAINING SUBSCRIPT OF INILTR  AND
C              KNTLTR  ARRAY LOCATIONS DESCRIBING RIGHTMOST
C              WORD IN DEVICE FIELD OF FILE  SPECIFICATION.
C              IF  DEVICE  FIELD  IS NOT FOUND, THEN MAXDSK
C              WILL BE RETURNED CONTAINING LOWSTR-1.
C     MAXNAM = RETURNED CONTAINING SUBSCRIPT OF INILTR  AND
C              KNTLTR  ARRAY LOCATIONS DESCRIBING RIGHTMOST
C              WORD IN NAME FIELD  OF  FILE  SPECIFICATION.
C              IF NAME FIELD IS NOT FOUND, THEN MAXNAM WILL
C              BE RETURNED EQUAL TO MAXDSK.
C     MAXNUM = RETURNED CONTAINING SUBSCRIPT OF INILTR  AND
C              KNTLTR  ARRAY LOCATIONS DESCRIBING RIGHTMOST
C              WORD   IN   BRACKETED    FIELD    OF    FILE
C              SPECIFICATION.   IF  BRACKETED  FIELD IS NOT
C              FOUND, THEN MAXNUM WILL BE RETURNED EQUAL TO
C              MAXNAM.
C     MAXFLG = RETURNED CONTAINING SUBSCRIPT OF INILTR  AND
C              KNTLTR  ARRAY LOCATIONS DESCRIBING RIGHTMOST
C              WORD  OF SWITCH FIELD.   IF SWITCH  FIELD IS
C              NOT FOUND,  THEN MAXFLG IS RETURNED EQUAL TO
C              LOWSTR-1.
C     KONTNT = BIT   CODED   NUMBER   RETURNED   DESCRIBING
C              LOCATION  OF  BRACKETED  FIELD  RELATIVE  TO
C              DEVICE AND NAME FIELDS.  RIGHT BIT IS ONE IF
C              AND ONLY IF NAME FIELD IS FOUND.  SECOND BIT
C              FROM RIGHT IS ONE  IF  AND  ONLY  IF  DEVICE
C              FIELD  IS FOUND.  FOURTH AND THIRD BITS FROM
C              RIGHT ARE 00 IF NO BRACKETED FIELD IS FOUND,
C              01  IF  BRACKETED FIELD APPEARS FIRST, 10 IF
C              BRACKETED FIELD FOLLOWS DEVICE FIELD, AND 11
C              IF BRACKETED FIELD FOLLOWS NAME FIELD.
C              FOLLOWING TABLE PRESENTS  VALUES  OF  KONTNT
C              RETURNED  FOR  ALL  POSSIBLE COMBINATIONS OF
C              DEVICE, NAME AND  BRACKETED  FIELDS.   MINUS
C              SIGNS   REPRESENT  VALUES  OF  KONTNT  WHICH
C              CANNOT BE RETURNED.   VALUE  ZERO  INDICATES
C              THAT  NEITHER DEVICE, NOR NAME NOR BRACKETED
C              FIELDS WERE FOUND,  BUT  DOES  NOT  INDICATE
C              WHETHER SWITCH FIELD WAS FOUND.
C
C              DECIMAL BINARY          DECIMAL BINARY
C              0   0  NOTHING         8 1000  ------
C              1   1  NAME            9 1001  ------
C              2  10  DEVICE:        10 1010  DEVICE:[]
C              3  11  DEVICE:NAME    11 1011  DEVICE:[]NAME
C              4 100  []             12 1100  ------
C              5 101  []NAME         13 1101  NAME[]
C              6 110  []DEVICE:      14 1110  ------
C              7 111  []DEVICE:NAME  15 1111  DEVICE:NAME[]
C
C              16 IS ADDED TO KONTNT IF AT  SIGN @ IS FOUND
C              ANYWHERE  IN FILE  SPECIFICATION OTHER  THAN
C              WITHIN A SWITCH FIELD.
C     MINPRT = SUBSCRIPT OF  IBUFFR  ARRAY  LOCATION  WHICH
C              CONTAINS    FIRST    CHARACTER    OF    FILE
C              SPECIFICATION OR SWITCH IF KIND IS  RETURNED
C              CONTAINING  VALUE  OF  6 OR GREATER.  MINPRT
C              AND MAXPRT CAN BE USED AS LIMITS  OF  IBUFFR
C              ARRAY  SUBSCRIPTS  IF TEXT MUST BE DISPLAYED
C              TO USER.  MINPRT  AND  MAXPRT  ARE  RETURNED
C              UNDEFINED  IF  KIND  IS  RETURNED CONTAINING
C              VALUE LESS THAN 6.
C     MAXPRT = SUBSCRIPT OF  IBUFFR  ARRAY  LOCATION  WHICH
C              CONTAINS    FINAL    CHARACTER    OF    FILE
C              SPECIFICATION OR SWITCH IF KIND IS  RETURNED
C              CONTAINING VALUE OF 6 OR GREATER.
C
      DIMENSION KNTLTR(MAXSTR),INILTR(MAXSTR),
     1IBUFFR(MAXBFR)
C
C     CCCC       AAA UU   UU TTTTTTTT IIII  OOOO   NN    NN
C   CC          AAAA UU   UU    TT     II  OO  OO  NNN   NN
C  CC          AA AA UU   UU    TT     II OO    OO NNNN  NN
C  CC         AA  AA UU   UU    TT     II OO    OO NN NN NN
C  CC        AAAAAAA UU   UU    TT     II OO    OO NN  NNNN
C   CC      AA    AA  UU UU     TT     II  OO  OO  NN   NNN
C     CCCC AA     AA   UUU      TT    IIII  OOOO   NN    NN
C
C     LEFT AND RIGHT SQUARE  BRACKETS MUST BE DEFINED USING
C     OCTAL NOTATION FOR PDP10 F40 COMPILER.  LET FOLLOWING
C     COMMENT BE THE COMPILED DATA STATEMENT IF F40 IS USED
C      DATA ILEFT,IRIGHT/"555004020100,"565004020100/
      DATA ILEFT,IRIGHT/1H[,1H]/
C
      DATA ISTAR,ICOLON,IDOT,ICOMMA,ISLASH,IQUOTE,IEND,
     1IAND,KOMENT,IEQUAL,KOMAND,IBLANK,ITAB/1H*,1H:,1H.,
     21H,,1H/,1H',1H;,1H&,1H!,1H=,1H@,1H ,1H	/
C
C     MAJOR  = -1, PROCESSING NAME SECTION
C            = 0, PROCESSING CONTENTS OF BRACKETS
C            = 1, PROCESSING SWITCH
C            = 2, IN TEXT STRING
C
      NEWSPC=1
      MAXDSK=LOWSTR-1
      MAXNAM=MAXDSK
      MAXNUM=MAXDSK
      MAXFLG=MAXDSK
      NONDSK=0
      NONNAM=0
      NONNUM=0
      KONTNT=0
      LOCATN=4
      KIND=1
      LOWBFR=LOWBFR-1
      MIDPRT=LOWBFR
      IF(MANY.GE.0)GO TO 46
      KIND=5
      MANY=1
      GO TO 46
    1 LOWBFR=LOWBFR+1
      MAXPRT=MIDPRT
      IF(LOWBFR.GT.MAXBFR)GO TO 32
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 24
      IF(LETTER.EQ.ITAB)GO TO 24
      IF(KIND.NE.7)MINPRT=LOWBFR
      MIDPRT=LOWBFR
      LSTSPC=NEWSPC
      NEWSPC=0
C
C     CHECK FOR GENERAL PUNCTUATION CHARACTERS
      IF(LETTER.EQ.IEND)GO TO 26
      IF(LETTER.EQ.IAND)GO TO 20
      IF(LETTER.EQ.KOMENT)GO TO 21
      IF(LETTER.EQ.IEQUAL)GO TO 27
      IF(LETTER.EQ.ISLASH)GO TO 10
      IF(LETTER.EQ.IQUOTE)GO TO 11
      IF(LETTER.EQ.ICOMMA)GO TO 22
      IF(MAJOR.GT.0)GO TO 3
      IF(LETTER.EQ.KOMAND)GO TO 19
      IF(MAJOR.EQ.0)GO TO 4
C
C     CHECK FOR KEY CHARACTERS IN NAME FIELD
      IF(KIND.EQ.7)GO TO 2
      INDRCT=MANY
      IF(KIND.EQ.5)INDRCT=-1
      MANY=1
      KIND=7
    2 IF(LETTER.EQ.ICOLON)GO TO 30
      IF(LETTER.EQ.ILEFT)GO TO 9
      IF(NONNAM.GT.0)GO TO 31
      IF(LETTER.EQ.IDOT)GO TO 23
      GO TO 5
C
C     CHECK FOR KEY CHARACTERS IN SWITCH SECTION
    3 IF(KOUNT.LT.0)GO TO 29
      I=MAJOR
      MAJOR=1
      IF(LETTER.EQ.ICOLON)GO TO 23
      IF(I.NE.2)GO TO 5
      GO TO 29
C
C     CHECK FOR KEY CHARACTERS IN BRACKET FIELD
    4 IF(LETTER.EQ.ILEFT)GO TO 31
      IF(LETTER.EQ.IRIGHT)GO TO 25
      IF(LETTER.EQ.IDOT)GO TO 23
      IF(LETTER.EQ.ICOLON)GO TO 23
C
C     EXTEND NAME OR NUMBER OR SWITCH
    5 IF(KOUNT.GT.0)GO TO 6
      LTRLFT=LOWBFR
      KOUNT=1
      GO TO 1
    6 IF(LSTSPC.NE.0)GO TO 7
      IF(IBUFFR(MAXPRT).EQ.ISTAR)GO TO 8
      KOUNT=KOUNT+1
      GO TO 1
    7 IF(MAJOR.GT.0)GO TO 29
    8 LOWBFR=LOWBFR-1
      GO TO 23
C
C     LEFT BRACKET OTHER THAN IN SWITCH FIELD
    9 IF(NONNUM.NE.0)GO TO 31
      NEXT=4
      GO TO 33
C
C     INITIAL SLASH FOUND
   10 IF(KIND.EQ.7)GO TO 29
      IF(KIND.EQ.5)MANY=-1
      KIND=7
      MAJOR=1
      GO TO 44
C
C     APOSTROPHE STARTS TEXT STRING
   11 IF(MAJOR.LE.0)GO TO 12
      IF(KOUNT.EQ.0)GO TO 13
      IF(KOUNT.NE.1)GO TO 29
      IF(LSTSPC.NE.0)GO TO 29
      IF(IBUFFR(MAXPRT).EQ.ISTAR)GO TO 8
      GO TO 29
   12 IF(KIND.EQ.7)GO TO 29
      IF(KIND.EQ.5)MANY=-1
      KIND=7
      MAJOR=2
   13 LTRLFT=LOWBFR
      I=LOWBFR
      MIDPRT=LOWBFR
   14 IF(I.GE.MAXBFR)GO TO 16
      I=I+1
      LOWBFR=LOWBFR+1
      IBUFFR(LOWBFR)=IBUFFR(I)
      IF(IBUFFR(I).EQ.IBLANK)GO TO 14
      IF(IBUFFR(I).EQ.ITAB)GO TO 14
      MIDPRT=LOWBFR
      IF(IBUFFR(I).NE.IQUOTE)GO TO 14
      IF(I.GE.MAXBFR)GO TO 15
      IF(IBUFFR(I+1).NE.IQUOTE)GO TO 15
      I=I+1
      GO TO 14
   15 MIDPRT=MIDPRT-1
   16 KOUNT=MIDPRT-LTRLFT+1
   17 IF(LOWBFR.EQ.I)GO TO 18
      LOWBFR=LOWBFR+1
      IBUFFR(LOWBFR)=IBLANK
      GO TO 17
   18 IF(MAJOR.EQ.2)GO TO 25
      MAJOR=2
      GO TO 1
C
C     AT SIGN
   19 IF(KONTNT.GT.15)GO TO 31
      IF(KIND.EQ.7)MANY=INDRCT
      IF(KIND.EQ.5)MANY=-1
      KIND=7
      KONTNT=KONTNT+16
      GO TO 25
C
C     AMPERSAND FOUND
   20 IF(KIND.EQ.7)GO TO 32
      IF(KIND.EQ.5)MANY=-1
      KIND=4
C
C     EXCLAMATION POINT FOUND
   21 LOWBFR=MAXBFR+1
      GO TO 32
C
C     COMMA FOUND OTHER THAN IN NUMBER SECTION
   22 IF(MAJOR.EQ.0)GO TO 23
      IF(KIND.NE.1)GO TO 32
      KIND=5
      IF(MANY.GT.0)GO TO 1
      GO TO 32
C
C     COMMA IN BRACKET SECTION OR COLON IN SWITCH SECTION
   23 NEXT=3
      IF(KOUNT.LT.0)KOUNT=0
      GO TO 33
C
C     SPACE OR TAB FOUND
   24 IF(NEWSPC.NE.0)GO TO 1
      NEWSPC=1
      IF(KONECT.LT.0)GO TO 1
      IF(MAJOR.GE.0)GO TO 1
      IF(KIND.NE.7)GO TO 1
      IF(KONECT.EQ.0)GO TO 32
   25 NEXT=5
      GO TO 33
C
C     SEMICOLON FOUND
   26 IF(KIND.NE.1)GO TO 32
      KIND=2
      GO TO 28
C
C     EQUALS SIGN FOUND
   27 IF(KIND.NE.1)GO TO 32
      KIND=3
   28 LOWBFR=LOWBFR+1
      GO TO 32
C
C     CURRENT CALL CANNOT RETURN ALL INFORMATION
   29 KIND=6
      GO TO 32
C
C     COLON FOUND IN NAME FIELD
   30 IF(NONDSK.LE.0)GO TO 35
C
C     ILLEGAL CHARACTER, BUT MUST CLEAN UP BEFORE EXIT
   31 KIND=8
C
C     PREPARE TO EXIT TO CALLING PROGRAM
   32 NEXT=1
C
C     TERMINATE GROUP OF NAMES OR NUMBERS
   33 IF(KOUNT.LT.0)GO TO 42
      IF(MAJOR.GT.0)GO TO 40
      IF(MAJOR.EQ.0)GO TO 34
      LOCAL=MAXNAM
      IF(NONNAM.EQ.0)KONTNT=KONTNT+1
      LOCATN=12
      NONNAM=-1
      NONDSK=1
      GO TO 36
   34 LOCAL=MAXNUM
      IF(NONNUM.EQ.0)KONTNT=KONTNT+LOCATN
      NONNUM=-1
      GO TO 37
   35 IF(KOUNT.LT.0)KOUNT=0
      NEXT=2
      LOCAL=MAXDSK
      IF(NONDSK.EQ.0)KONTNT=KONTNT+2
      LOCATN=8
      NONDSK=-1
      IF(MAXDSK.LT.MAXSTR)MAXDSK=MAXDSK+1
   36 IF(MAXNAM.LT.MAXSTR)MAXNAM=MAXNAM+1
   37 IF(MAXNUM.LT.MAXSTR)MAXNUM=MAXNUM+1
      INDEX=MAXNUM
      LOCAL=LOCAL+1
   38 IF(INDEX.LE.LOCAL)GO TO 41
      IF(INDEX.GT.MAXSTR)GO TO 39
      INILTR(INDEX)=INILTR(INDEX-1)
      KNTLTR(INDEX)=KNTLTR(INDEX-1)
   39 INDEX=INDEX-1
      GO TO 38
   40 IF(MAXFLG.GE.MAXSTR)GO TO 42
      MAXFLG=MAXFLG+1
      LOCAL=MAXFLG
   41 IF(LOCAL.GT.MAXSTR)GO TO 42
      KNTLTR(LOCAL)=KOUNT
      INILTR(LOCAL)=LTRLFT
C
C     NEXT   = 1, EXIT
C            = 2, AFTER COLON OF DEVICE FIELD
C            = 3, AFTER PERIOD IN NAME OR COMMA IN
C              BRACKETED SECTION OR COLON IN SWITCH SECTION
C            = 4, MARK THAT ARE IN BRACKETED SECTION
C            = 5, TERMINATE CURRENT SECTION SO ITS TYPE
C              WILL NOT BE PERMITTED
   42 GO TO(49,47,44,43,45),NEXT
C
C     MARK THAT ARE IN BRACKET SECTION
   43 MAJOR=0
   44 KOUNT=0
      GO TO 48
C
C     TERMINATE CURRENT SECTION
   45 IF(MAJOR.GT.0)GO TO 47
      IF(NONDSK.LT.0)NONDSK=1
      IF(NONNAM.LT.0)NONNAM=1
      IF(NONNUM.LT.0)NONNUM=1
   46 MAJOR=-1
C
C     PREPARE FOR NEXT ITEM IN LIST
   47 KOUNT=-1
   48 LTRLFT=LOWBFR+1
      GO TO 1
C
C     RETURN TO CALLING PROGRAM
   49 IF(KIND.EQ.5)MANY=1
      IF(KIND.LT.4)MANY=0
      RETURN
C264038073645[]:';&!@
      END
      SUBROUTINE DATEXT(LINE  ,JSTIFY,IFILL ,INTRVL,MOVE  ,
     1    ISPACE,LTTR  ,LTRBGN,LTREND,LFTCOL,IWIDTH,MAXBFR,
     2    IBUFFR,MAXUSD,MAXLIN,LTRNXT)
C     RENBR(/CONSTRUCT LARGE MULTI-LINE LETTERING)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C     DEVELOPED AT AIKEN COMPUTER LABORATORY
C
C     DDDDD         AAA TTTTTTTT EEEEEEEE XX    XX TTTTTTTT
C     DD   DD      AAAA    TT    EE        XX  XX     TT
C     DD    DD    AA AA    TT    EE         XXXX      TT
C     DD    DD   AA  AA    TT    EEEEE       XX       TT
C     DD    DD  AAAAAAA    TT    EE         XXXX      TT
C     DD   DD  AA    AA    TT    EE        XX  XX     TT
C     DDDDD   AA     AA    TT    EEEEEEEE XX    XX    TT
C
C     ROUTINE TO  PRODUCE MULTIPLE  LINE PRINTED  LETTERING
C     SIMILAR TO THAT USED FOR THE ABOVE TITLE.
C
C     THIS ROUTINE  MUST BE  USED  WITH A  BLOCK  DATA FONT
C     CREATED BY THE PROGRAM DAFONT.
C
C     LINE   = THE LINE WITHIN  THE  LETTER  REPRESENTATION
C              WHICH   IS   TO   BE   PLACED  INTO  IBUFFR.
C              CHARACTERS ARE A TOTAL OF IHIGH LINES  HIGH.
C              TO   PRINT   A  LETTER  OR  LETTERS,  IT  IS
C              NECESSARY TO CALL DATEXT  IHIGH  TIMES  WITH
C              LINE   VALUES  1  THROUGH  IHIGH,  WITH  THE
C              CALLING PROGRAM PRINTING IBUFFR ARRAY  AFTER
C              EACH  RETURN  FROM  DATEXT.  THIS ALLOWS THE
C              INSERTION OF THE  CONSTRUCTED  LETTERS  INTO
C              OTHER TEXT OR OTHER FORMS.
C            = 0, REPRESENT HIGHEST VALUED LINE.  LINE MUST
C              BE SET TO  MAXLIN-1  BEFORE THIS  ROUTINE IS
C              AGAIN CALLED.
C     JSTIFY = -1, LEFT JUSTIFY THE  LETTER REPRESENTATIONS
C              IN A FIELD OF WIDTH IWIDTH.
C            = 0, CENTER  THE LETTER  REPRESENTATIONS  IN A
C              FIELD OF WIDTH IWIDTH.
C            = 1, RIGHT JUSTIFY  THE LETTER REPRESENTATIONS
C              IN A FIELD OF WIDTH IWIDTH.
C     IFILL  = 0, IF  LEFT  JUSITIFYING  OR  CENTERING  THE
C              LETTERING, DO NOT FILL THE UNUSED PORTION OF
C              THE FIELD  RIGHT  OF LETTER  REPRESENTATIONS
C              WITH SPACES. MAXUSD WILL BE LEFT POINTING TO
C              RIGHT END OF RIGHTMOST LETTER REPESENTATION.
C            = 1, IF LEFT JUSIFYING OR CENTERING THE LETTER
C              REPRESENTATIONS,  DO FILL THE UNUSED PORTION
C              OF  FIELD  RIGHT  OF LETTER  REPRESENTATIONS
C              WITH SPACES.  MAXUSD  WILL BE  LEFT POINTING
C              LFTCOL+IWIDTH.
C     INTRVL = THE NUMBER OF SPACE (BLANK) CHARACTERS TO BE
C              INSERTED BETWEEN REPRESENTED CHARACTERS
C     MOVE   = -2, CHARACTERS WHICH  ARE NARROWER THAN  THE
C              WIDEST CHARACTER  ARE CENTERED  WITHIN WIDTH
C              OF WIDEST CHARACTER.  NO WHITE SPACE ADJUST-
C              MENT OF  POSITIONS  IS TO BE  MADE.   SPACES
C              WILL ALSO BE WIDTH OF THE WIDEST CHARACTER.
C            = -1, CHARACTERS WHICH  ARE NARROWER THAN MOST
C              COMMON WIDTH  WILL BE CENTERED  WITHIN  MOST
C              COMMON WIDTH.   NO WHITE SPACE ADJUSTMENT OF
C              POSITIONS  IS TO  BE MADE.  SPACES WILL ALSO
C              BE WIDTH WHICH IS MOST COMMON.
C            = 0, NORMAL INTER-CHARACTER SPACING IS ACCEPT-
C              ABLE WITHOUT WHITE SPACE ADJUSTMENT.
C            = 1, ADJUST SPACE BETWEEN CHARACTERS TO EQUAL-
C              IZE WHITE SPACES.
C     ISPACE = -1, REPRESENT  BOTH INITIAL AND FINAL SPACES
C              IN LTTR ARRAY.
C            = 0, REPRESENT  INITIAL SPACES  IN LTTR ARRAY.
C              SUPPRESS FINAL SPACES IN LTTR ARRAY.
C            = 1, SUPPRESS BOTH INITIAL AND FINAL SPACES IN
C              LTTR ARRAY.
C     LTTR   = ARRAY CONTAINING LETTERS TO BE  REPRESENTED,
C              1 LETTER PER WORD, AS READ BY MULTIPLE OF A1
C              FORMAT.  SINCE  THE  LETTERING  PRODUCED  BY
C              THIS  ROUTINE IS LARGE, TERMINAL SPACES  ARE
C              IGNORED UNLESS  ISPACE=-1.  NOTE THAT MAXUSD
C              EQUALS LFTCOL IF  LTTR CONTAINS ONLY SPACES,
C              AND ISPACE IS GREATER THAN OR EQUAL TO ZERO,
C              AND IFILL IS EQUAL TO ZERO.
C     LTRBGN = SEQUENCE NUMBER WITHIN LTTR ARRAY  OF  FIRST
C              LETTER   TO  BE  REPRESENTED  (THIS  IS  THE
C              SUBSCRIPT OF THE LTTR  ARRAY  AT  WHICH  THE
C              FIRST LETTER IS TO BE FOUND)
C     LTREND = SEQUENCE NUMBER WITHIN LTTR ARRAY  OF  FINAL
C              LETTER   TO  BE  REPRESENTED  (THIS  IS  THE
C              SUBSCRIPT OF THE LTTR  ARRAY  AT  WHICH  THE
C              FINAL LETTER IS TO BE FOUND)
C     LFTCOL = SUBSCRIPT OF OUTPUT BUFFER ARRAY LOCATION TO
C              LEFT OF 1ST LOCATION INTO WHICH THIS ROUTINE
C              CAN PLACE REPRESENTATION OF CONTENTS OF LTTR
C              ARRAY.
C     IWIDTH = THE WIDTH OF THE FIELD INTO WHICH THE LETTER
C              REPRESENTATIONS CAN BE PLACED.   THE MAXIMUM
C              VALUE WITH WHICH MAXUSD CAN THEN BE RETURNED
C              IS LFTCOL+IWIDTH OR MAXBFR, WHICHEVER IS THE
C              SMALLER.
C     MAXBFR = MAXIMUM SUBSCRIPT OF  IBUFFR  ARRAY LOCATION
C              INTO WHICH  CAN BE PLACED  REPRESENTATION
C              OF CONTENTS OF LTTR ARRAY.
C
C     THE FOLLOWING ARGUMENTS ARE USED FOR OUTPUT.
C
C     IBUFFR = THE ARRAY INTO WHICH IS  TO  BE  PLACED  THE
C              REPRESENTATION OF THE LETTERS IN LTTR.
C     MAXUSD = RETURNED BY DATEXT CONTAINING THE NEW NUMBER
C              OF LOCATIONS IN USE  AFTER  THE  LETTERS  IN
C              LTTR HAVE BEEN REPRESENTED IN IBUFFR.
C     MAXLIN = RETURNED CONTAINING THE  MAXIMUM VALUE WHICH
C              LINE CAN  ATTAIN (IHIGH).   THIS WILL DEPEND
C              ON WHICH  FONT HAS  BEEN LOADED.   MAXLIN IS
C              RETURNED AS ZERO IF FONT HAS NOT BEEN LOADED
C     LTRNXT = RETURNED CONTAINING THE SUBSCRIPT WITHIN THE
C              LTTR ARRAY OF THE FIRST LETTER WHICH WAS NOT
C              REPRESENTED.   IF ALL LETTERS REQUESTED WERE
C              REPRESENTED THEN LTRNXT WILL EQUAL LTREND+1.
C              IF NOT ALL LETTERS COULD BE  REPRESENTED DUE
C              TO THE VALUE OF IWIDTH BEING TOO SMALL, THEN
C              LTRNXT WILL POINT TO THE FIRST  LETTER WHICH
C              WOULD NOT FIT.
C
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD(672)
C
      DIMENSION LTTR(LTREND),IBUFFR(MAXBFR),IDIGIT(10)
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA KOMAND,IVRTCL,IHRZNT,IEQUAL,IEND,IUPPER,
     1LOWER,NARROW,IFIXED,IADJST,NWIDE,IBLANK/
     21H$,1HV,1HH,1H=,1HE,1HU,1HL,1HN,1HF,1HA,1HW,1H /
C
      LTRNXT=LTRBGN
      MAXUSD=LFTCOL
      IF(LOCK.NE.999)GO TO 61
      MAXLIN=IHIGH
      NOWLIN=LINE
      IF(NOWLIN.LE.0)NOWLIN=IHIGH
      IF(NOWLIN.GT.IHIGH)GO TO 62
      IUSED=LFTCOL
      IWHITE=MOVE
      KWIDE=IWIDE
      IF(IWHITE.LE.-2)KWIDE=JWIDE
      JSPACE=INTRVL
      IF(JSPACE.LT.0)JSPACE=0
      LAST=0
      KSPACE=0
      NEED=0
      MAXKNT=IUSED+IWIDTH
      IF(MAXKNT.GT.MAXBFR)MAXKNT=MAXBFR
      IFCASE=1
      NOWVRT=1
      NOWHRZ=1
      KASATO=0
      LWIDE=KWIDE
      NOWTST=0
      GO TO 3
C
C     FIND OUT IF CAN REPRESENT THE LETTER
    1 KSPACE=JSPACE
      LAST=MATCH
      LSTVRT=NOWVRT
      LSTHRZ=NOWHRZ
      LSTLNG=NOWLNG
    2 LTRNXT=LTRNXT+1
    3 IF(LTRNXT.GT.LTREND)GO TO 57
      NOWLTR=LTTR(LTRNXT)
      IF(NOWLTR.EQ.IBLANK)GO TO 7
      IF(NOWLTR.EQ.KOMAND)GO TO 13
    4 MATCH=0
      KNTKAS=0
    5 MATCH=MATCH+1
      IF(MATCH.GT.KNTLTR)GO TO 6
      IF(NOWLTR.NE.LETTER(MATCH))GO TO 5
      KNTKAS=KNTKAS+1
      IF(KNTKAS.GE.IFCASE)GO TO 26
      LSTKAS=MATCH
      GO TO 5
    6 IF(KNTKAS.GT.0)GO TO 25
      GO TO 8
C
C     REPRESENT SPACE OR UNKNOWN CHARACTER
    7 IF(KASATO.GE.0)GO TO 8
      KASATO=-KASATO
      IFCASE=KASATO-IFCASE
    8 IF(ISPACE.LE.0)GO TO 9
      IF(LAST.EQ.0)GO TO 2
    9 KSPACE=KSPACE+LWIDE
      IF(ISPACE.GE.0)GO TO 12
      I=KSPACE
      IF(IWHITE.LE.0)GO TO 10
      IF(LAST.NE.0)I=I-JSPACE
   10 IF((IUSED+I).GT.MAXKNT)GO TO 57
   11 IF(I.LE.0)GO TO 12
      I=I-1
      KSPACE=KSPACE-1
      IUSED=IUSED+1
      IBUFFR(IUSED)=IBLANK
      GO TO 11
   12 IF(IWHITE.LE.0)KSPACE=KSPACE+JSPACE
      GO TO 2
C
C     DOLLAR CONTROL CHARACTER FOUND
   13 LTRNXT=LTRNXT+1
      IF(LTRNXT.GT.LTREND)GO TO 57
      NOWLTR=LTTR(LTRNXT)
      IF(NOWLTR.EQ.KOMAND)GO TO 4
      IF(NOWLTR.EQ.IVRTCL)GO TO 16
      IF(NOWLTR.EQ.IHRZNT)GO TO 17
      IF(NOWLTR.EQ.IEQUAL)GO TO 15
      IF(NOWLTR.EQ.IFIXED)GO TO 18
      IF(NOWLTR.EQ.IADJST)GO TO 19
      IF(NOWLTR.EQ.NARROW)GO TO 20
      IF(NOWLTR.EQ.NWIDE)GO TO 21
      IF(NOWLTR.EQ.IEND)GO TO 22
      IF(NOWLTR.EQ.IUPPER)GO TO 23
      IF(NOWLTR.EQ.LOWER)GO TO 24
      DO 14 I=2,10
      IF(NOWLTR.NE.IDIGIT(I))GO TO 14
      IFCASE=I-1
      KASATO=0
      GO TO 2
   14 CONTINUE
      GO TO 2
   15 NOWVRT=1
      NOWHRZ=1
      IFCASE=1
      KASATO=0
      LWIDE=KWIDE
      IWHITE=MOVE
      GO TO 2
   16 NOWVRT=-1
      GO TO 2
   17 NOWHRZ=-1
      GO TO 2
   18 IF(IWHITE.GT.0)IWHITE=0
      GO TO 2
   19 IF(IWHITE.EQ.0)IWHITE=1
      GO TO 2
   20 LWIDE=KWIDE/2
      GO TO 2
   21 LWIDE=(3*KWIDE)/2
      GO TO 2
   22 IF(KASATO.LT.0)IFCASE=-KASATO-IFCASE
      KASATO=0
      GO TO 2
   23 IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
      IF(KASATO.GT.0)GO TO 2
      KASATO=-KASATO
      IFCASE=KASATO-IFCASE
      GO TO 2
   24 IF(KASATO.LT.0)GO TO 2
      IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
      IFCASE=KASATO-IFCASE
      KASATO=-KASATO
      GO TO 2
C
C     PREPARE TO PLOT CHARACTER
   25 MATCH=LSTKAS
   26 IF(KASATO.LE.0)GO TO 27
      IFCASE=KASATO-IFCASE
      KASATO=-KASATO
   27 NOWLNG=LENGTH(MATCH)
C
C     DETERMINE OPTIMUM SPACING
C
C     SKIP AROUND THIS CODE IF NORMAL
C     INTER-CHARACTER SPACING IS ACCEPTABLE
C     WITHOUT WHITE AREA ADJUSTMENT.
C     THE CALCULATIONS ARE DESIGNED TO PRODUCE
C     DISTANCES OF THE SORT
C
C                  4
C                  34
C                  234
C                  1234
C                  01234
C                 X01234
C                  01234
C                  1234
C                  234
C                  34
C                  4
C
C     THE FIRST LOOP CATCHES THE MOST COMMON CASE OF
C     2 CHARACTERS TOUCHING ON THE SAME LINE.  THE
C     SECOND LONGER LOOP CATCHES THIS CASE AND ALL
C     OTHERS AND COULD BE USED BY ITSELF.
      IF(IWHITE.LT.0)GO TO 46
      IF(JSPACE.EQ.0)GO TO 47
      LSTTST=NOWTST
      NOWTST=2**(NOWLNG-1)
      IF(LAST.EQ.0)GO TO 47
      IF(IWHITE.EQ.0)GO TO 47
      MIN=JSPACE
      ISTART=IHIGH*(LAST-1)
      JSTART=IHIGH*(MATCH-1)
      IF(LSTVRT.EQ.NOWVRT)GO TO 28
      LSTVRT=-1
      ISTART=ISTART+IHIGH+1
      GO TO 29
   28 LSTVRT=1
   29 IINDEX=ISTART
      JINDEX=JSTART
      DO 33 I=1,IHIGH
      IINDEX=IINDEX+LSTVRT
      JINDEX=JINDEX+1
      K=IPACKD(IINDEX)
      IF(LSTHRZ.LT.0)GO TO 30
      IF(K.EQ.(2*(K/2)))GO TO 33
      GO TO 31
   30 IF(K.LT.LSTTST)GO TO 33
   31 K=IPACKD(JINDEX)
      IF(NOWHRZ.GT.0)GO TO 32
      IF(K.EQ.(2*(K/2)))GO TO 33
      GO TO 47
   32 IF(K.GE.NOWTST)GO TO 47
   33 CONTINUE
      DO 45 I=1,IHIGH
      ISTART=ISTART+LSTVRT
      K=IPACKD(ISTART)
      IF(K.EQ.0)GO TO 45
      IF(LSTHRZ.GT.0)GO TO 35
      IDIST=LSTLNG
   34 K=K/2
      IDIST=IDIST-1
      IF(K.NE.0)GO TO 34
      GO TO 37
   35 IDIST=0
   36 L=K/2
      IF((L+L).NE.K)GO TO 37
      K=L
      IDIST=IDIST+1
      GO TO 36
   37 N=JSTART
      DO 44 J=1,IHIGH
      N=N+1
      K=IPACKD(N)
      IF(K.EQ.0)GO TO 44
      IF(NOWHRZ.GT.0)GO TO 39
      JDIST=IDIST
   38 L=K/2
      IF((L+L).NE.K)GO TO 41
      K=L
      JDIST=JDIST+1
      GO TO 38
   39 JDIST=IDIST+NOWLNG
   40 K=K/2
      JDIST=JDIST-1
      IF(K.NE.0)GO TO 40
   41 IF(I.GT.J)GO TO 42
      IF(I.EQ.J)GO TO 43
      JDIST=JDIST+J-I-1
      GO TO 43
   42 JDIST=JDIST+I-J-1
   43 IF(MIN.LE.JDIST)GO TO 44
      IF(JDIST.LE.0)GO TO 47
      MIN=JDIST
   44 CONTINUE
   45 CONTINUE
      KSPACE=KSPACE-MIN
      GO TO 47
C
C     ADJUST CENTERING OF NARROW CHARACTERS IF NEEDED
   46 IF(NOWLNG.GE.KWIDE)GO TO 47
      IF((IUSED+KSPACE+KWIDE).GT.MAXKNT)GO TO 57
      NEED=(KWIDE-NOWLNG)/2
      KSPACE=KSPACE+NEED
      NEED=KWIDE-NEED-NOWLNG
C
C     CONSTRUCT LETTER
   47 IF((IUSED+KSPACE+NOWLNG).GT.MAXKNT)GO TO 57
   48 IF(KSPACE.LE.0)GO TO 49
      KSPACE=KSPACE-1
      IUSED=IUSED+1
      IBUFFR(IUSED)=IBLANK
      GO TO 48
   49 I=(IHIGH*(MATCH-1))+NOWLIN
      IF(NOWVRT.LT.0)I=(IHIGH*MATCH)-NOWLIN+1
      I=IPACKD(I)
      LIMIT=NOWLNG
      IF(NOWHRZ.LT.0)GO TO 53
      IUSED=IUSED+NOWLNG
      J=IUSED
   50 IF(LIMIT.LE.0)GO TO 56
      LIMIT=LIMIT-1
      K=I/2
      IF((K+K).EQ.I)GO TO 51
      IBUFFR(J)=NOWLTR
      GO TO 52
   51 IBUFFR(J)=IBLANK
   52 J=J-1
      I=K
      GO TO 50
   53 IF(LIMIT.LE.0)GO TO 56
      LIMIT=LIMIT-1
      IUSED=IUSED+1
      K=I/2
      IF((K+K).EQ.I)GO TO 54
      IBUFFR(IUSED)=NOWLTR
      GO TO 55
   54 IBUFFR(IUSED)=IBLANK
   55 I=K
      GO TO 53
   56 IF(NEED.LE.0)GO TO 1
      NEED=NEED-1
      IUSED=IUSED+1
      IBUFFR(IUSED)=IBLANK
      GO TO 56
C
C     ALL LETTERS REPRESENTED, JUSTIFY AND FILL
   57 NEED=0
      IF(JSTIFY.GE.0)NEED=MAXKNT-IUSED
      IF(JSTIFY.EQ.0)NEED=NEED/2
      NEED=IUSED+NEED
      INIKNT=MAXUSD
      MAXUSD=NEED
      IF(IFILL.GT.0)MAXUSD=MAXKNT
      I=MAXUSD
   58 IF(I.LE.NEED)GO TO 59
      IBUFFR(I)=IBLANK
      I=I-1
      GO TO 58
   59 IF(IUSED.LE.INIKNT)GO TO 60
      IBUFFR(I)=IBUFFR(IUSED)
      I=I-1
      IUSED=IUSED-1
      GO TO 59
   60 IF(I.LE.INIKNT)GO TO 62
      IBUFFR(I)=IBLANK
      I=I-1
      GO TO 60
C
C     RETURN TO CALLING PROGRAM
   61 MAXLIN=0
   62 RETURN
C545790969953$
      END
      SUBROUTINE DATURN(INTRVL,MOVE  ,ISPACE,LTTR  ,LTRBGN,
     1    LTREND,LFTCOL,MAXBFR,IBUFFR,MAXUSD,MAGNFY,INISTR,
     2    MAXSTR,KIND  ,ISTORE)
C     RENBR(/CONSTRUCT LARGE LETTERING TURNED 90 DEGREES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO PRODUCE LARGE LETTERING  EXTENDING  ACROSS
C     FANFOLDS.   EACH  CALL  TO DATURN CONSTRUCTS A SINGLE
C     LINE IN THE REPRESENTATION  OF  A  SINGLE  CHARACTER.
C     DATURN  SIGNALS TO THE CALLING PROGRAM WHEN THE FINAL
C     CHARACTER HAS BEEN  COMPLETELY  REPRESENTATED.   THIS
C     ROUTINE  MUST  BE USED WITH A BLOCK DATA FONT CREATED
C     BY THE PROGRAM DAFONT.
C
C     INTRVL, MOVE, ISPACE, LTTR, LTRBGN,  LTREND,  LFTCOL,
C     MAXBFR,  MAGNFY,  INISTR AND MAXSTR ARE USED ONLY FOR
C     INPUT AND ARE RETURNED UNCHANGED.   KIND  AND  ISTORE
C     ARE USED BOTH FOR INPUT AND FOR RETURNING INFORMATION
C     TO CALLING PROGRAM AND TO SUBSEQUENT  CALLS  TO  THIS
C     ROUTINE.  IBUFFR AND MAXUSD ARE USED ONLY FOR OUTPUT.
C
C     INTRVL = NUMBER OF BLANK LINES TO BE INSERTED BETWEEN
C              REPRESENTED CHARACTERS
C     MOVE   = -2, CHARACTERS WHICH ARE NARROWER  THAN  THE
C              WIDEST  CHARACTER  ARE CENTERED WITHIN WIDTH
C              OF WIDEST CHARACTER.  NO WHITE SPACE ADJUST-
C              MENT  OF  POSITIONS  IS  TO BE MADE.  SPACES
C              WILL ALSO BE WIDTH OF WIDEST CHARACTER.
C            = -1, CHARACTERS WHICH ARE NARROWER THAN  MOST
C              COMMON  WIDTH  WILL  BE CENTERED WITHIN MOST
C              COMMON WIDTH.  NO WHITE SPACE ADJUSTMENT  OF
C              POSITIONS  IS  TO BE MADE.  SPACES WILL ALSO
C              BE WIDTH WHICH IS MOST COMMON.
C            = 0, NORMAL INTER-CHARACTER SPACING IS ACCEPT-
C              ABLE WITHOUT WHITE SPACE ADJUSTMENT.
C            = 1, ADJUST SPACE BETWEEN CHARACTERS TO EQUAL-
C              IZE WHITE SPACES.
C     ISPACE = -1 OR 0, REPRESENT INITIAL  SPACES  IN  LTTR
C              ARRAY.  SUPPRESS FINAL SPACES IN LTTR ARRAY.
C            = 1, SUPPRESS BOTH INITIAL AND FINAL SPACES IN
C              LTTR ARRAY.
C     LTTR   = ARRAY CONTAINING LETTERS TO BE  REPRESENTED,
C              1 LETTER PER WORD, AS READ BY MULTIPLE OF A1
C              FORMAT.  SINCE LETTERING  PRODUCED  BY  THIS
C              ROUTINE   IS   LARGE,  TERMINAL  SPACES  ARE
C              IGNORED BUT BLANK LINES WILL BE GENERATED IF
C              DATURN  IS  CALLED TO CONTINUE THE LETTERING
C              REPRESENTATION ONCE ALL PRINTING  CHARACTERS
C              IN LTTR HAVE BEEN REPRESENTED.
C     LTRBGN = SEQUENCE NUMBER WITHIN LTTR ARRAY  OF  FIRST
C              LETTER   TO  BE  REPRESENTED  (THIS  IS  THE
C              SUBSCRIPT OF LTTR ARRAY AT WHICH  THE  FIRST
C              LETTER IS TO BE FOUND)
C     LTREND = SEQUENCE NUMBER WITHIN LTTR ARRAY  OF  FINAL
C              LETTER   TO  BE  REPRESENTED  (THIS  IS  THE
C              SUBSCRIPT OF LTTR ARRAY AT WHICH  THE  FINAL
C              LETTER IS TO BE FOUND)
C     LFTCOL = SUBSCRIPT OF OUTPUT BUFFER ARRAY LOCATION TO
C              LEFT OF 1ST LOCATION INTO WHICH THIS ROUTINE
C              CAN PLACE REPRESENTATION OF CONTENTS OF LTTR
C              ARRAY.
C     MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR  ARRAY  LOCATION
C              INTO  WHICH  CAN BE PLACED REPRESENTATION OF
C              CONTENTS OF LTTR ARRAY.
C     IBUFFR = ARRAY  INTO  WHICH  IS  TO  BE  PLACED   THE
C              REPRESENTATION OF LETTERS IN LTTR.
C     MAXUSD = RETURNED BY DATURN CONTAINING NEW NUMBER  OF
C              LOCATIONS  IN  USE  AFTER  NEXT  SECTION  OF
C              CHARACTER   IN   LTTR   ARRAY    HAS    BEEN
C              REPRESENTED.
C     MAGNFY = INPUT CONTAINING MAGNIFICATION FACTOR  WHICH
C              IS  APPLIED  TO  HEIGHT  OF  LETTERING.   IF
C              MAGNFY HAS  VALUE  2,  THEN  EACH  CHARACTER
C              WHICH  WOULD  BE  GENERATED TO FORM SHAPE IS
C              REPEATED TWICE.  SINCE  FONTS  ARE  DESIGNED
C              FOR  6  LINES PER INCH AND 10 CHARACTERS PER
C              INCH  FORMAT,  LETTERING,  WHEN  TURNED   90
C              DEGREES,  WILL  APPEAR  EXTREMELY  ELONGATED
C              UNLESS HEIGHT IS MAGNIFIED.  MAGNFY VALUE OF
C              3   WOULD   PRODUCE  APPROXIMATELY  NORMALLY
C              PROPORTIONED  LETTERING.    IF   EACH   LINE
C              RETURNED  BY  DATURN  IS PRINTED TWICE, THEN
C              EXTREMELY LARGE LETTERING CAN BE PRODUCED BY
C              SETTING  MAGNFY  TO  5.   IT  IS  OF  COURSE
C              NECESSARY THAT IBUFFR ARRAY BE LARGE  ENOUGH
C              TO CONTAIN MAGNIFIED IMAGE OF LETTERING.
C     INISTR = INPUT CONTAINING SUBSCRIPT OF FIRST LOCATION
C              IN   ISTORE  ARRAY  WHICH  CAN  BE  USED  TO
C              TRANSFER INFORMATION ABOUT CURRENT STATE  OF
C              LETTERING PROCESS TO SUBSEQUENT CALL OF THIS
C              ROUTINE WHICH IS TO CONTINUE  REPRESENTATION
C              OF SAME LINE OF TEXT.
C     MAXSTR = INPUT CONTAINING SUBSCRIPT OF FINAL LOCATION
C              IN   ISTORE  ARRAY  WHICH  CAN  BE  USED  TO
C              TRANSFER INFORMATION ABOUT CURRENT STATE  OF
C              LETTERING PROCESS TO SUBSEQUENT CALL OF THIS
C              ROUTINE WHICH IS TO CONTINUE  REPRESENTATION
C              OF SAME LINE OF TEXT.  AT LEAST 18 LOCATIONS
C              IN ISTORE ARRAY ARE NEEDED FOR THIS PURPOSE,
C              BUT   IT  IS  REQUESTED  THAT  AT  LEAST  24
C              LOCATIONS BE RESERVED TO  ALLOW  FOR  FUTURE
C              ENHANCEMENT OF ROUTINE.
C     KIND   = MUST BE  INPUT  CONTAINING  ZERO  WHEN  THIS
C              ROUTINE   IS   FIRST   CALLED  TO  REPRESENT
C              PARTICULAR LINE OF TEXT.  THEREAFTER,  VALUE
C              OF  KIND  RETURNED BY THIS ROUTINE SHOULD BE
C              SUPPLIED  TO  SUBSEQUENT   CALL   WHICH   IS
C              CONTINUING  REPRESENTATION  OF  SAME LINE OF
C              TEXT.  KIND IS RETURNED  CONTAINING  ONE  OF
C              FOLLOWING VALUES.
C            = 1,  RETURNED  IF  LINE  OF  TEXT  HAS   BEEN
C              COMPLETELY   REPRESENTED.   IBUFFR(LFTCOL+1)
C              THROUGH  AND  INCLUDING  IBUFFR(MAXUSD)   IS
C              RETURNED CONTAINING SPACES.  THIS PORTION OF
C              IBUFFR  ARRAY   WILL   AGAIN   BE   RETURNED
C              CONTAINING  SPACES IF DATURN IS SUBSEQUENTLY
C              CALLED WITH VALUE OF KIND BEING UNCHANGED.
C            = 2, RETURNED IF IBUFFR(LFTCOL+1) THROUGH  AND
C              INCLUDING    IBUFFR(MAXUSD)    IS   RETURNED
C              CONTAINING  PORTION  OF  REPRESENTATION   OF
C              SINGLE CHARACTER.
C            = 3, RETURNED IF AVAILABLE PORTION  OF  IBUFFR
C              ARRAY    WAS    INSUFFICIENT    TO   CONTAIN
C              REPRESENTATION OF LETTERING.   MAXBFR-LFTCOL
C              IS LESS THAN MAGNFY TIMES CHARACTER HEIGHT.
C            = 4, RETURNED IF AVAILABLE PORTION  OF  ISTORE
C              ARRAY    WAS    INSUFFICIENT    TO   CONTAIN
C              DESCRIPTION OF CURRENT  STATE  OF  LETTERING
C              PROCESS  FOR  TRANSFER TO SUBSEQUENT CALL TO
C              THIS ROUTINE WHICH IS TO CONTINUE  LETTERING
C              OF SAME LINE OF TEXT.
C            = 5, RETURNED IF FONT WAS NOT LOADED.
C     ISTORE = ARRAY  USED  TO  TRANSFER   DESCRIPTION   OF
C              CURRENT   STATE   OF  LETTERING  PROCESS  TO
C              SUBSEQUENT CALL OF THIS ROUTINE WHICH IS  TO
C              CONTINUE  REPRESENTATION  OF  SAME  LINE  OF
C              TEXT.  THE ORIGINAL CONTENTS OF ISTORE ARRAY
C              ARE IGNORED AND ARE DESTROYED.
C
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD(672)
C
      DIMENSION LTTR(LTREND),IBUFFR(MAXBFR),ISTORE(MAXSTR),
     1IDIGIT(10)
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA KOMAND,IVRTCL,IHRZNT,IEQUAL,IEND,IUPPER,
     1LOWER,NARROW,IFIXED,IADJST,NWIDE,IBLANK/
     21H$,1HV,1HH,1H=,1HE,1HU,1HL,1HN,1HF,1HA,1HW,1H /
C
      MAXUSD=LFTCOL
      IF(LOCK.NE.999)GO TO 56
      IF((MAXSTR-INISTR).LT.17)GO TO 55
      MULTPL=MAGNFY
      IF(MULTPL.LE.0)MULTPL=1
      IF((LFTCOL+(MULTPL*IHIGH)).GT.MAXBFR)GO TO 54
      JSPACE=INTRVL
      IF(JSPACE.LT.0)JSPACE=0
      KWIDE=IWIDE
      IF(MOVE.LE.-2)KWIDE=JWIDE
      IF(KIND.GT.0)GO TO 44
      KIND=2
      LTRNXT=LTRBGN
      IWHITE=MOVE
      LAST=0
      KSPACE=0
      NEED=0
      IFCASE=1
      NOWVRT=1
      NOWHRZ=1
      KASATO=0
      LWIDE=KWIDE
      NOWTST=0
      GO TO 3
C
C     FIND OUT IF CAN REPRESENT THE LETTER
    1 KSPACE=JSPACE+NEED
      NEED=0
      LAST=MATCH
      LSTVRT=NOWVRT
      LSTHRZ=NOWHRZ
      LSTLNG=NOWLNG
    2 LTRNXT=LTRNXT+1
    3 IF(LTRNXT.GT.LTREND)GO TO 50
      NOWLTR=LTTR(LTRNXT)
      IF(NOWLTR.EQ.IBLANK)GO TO 7
      IF(NOWLTR.EQ.KOMAND)GO TO 10
    4 MATCH=0
      KNTKAS=0
    5 MATCH=MATCH+1
      IF(MATCH.GT.KNTLTR)GO TO 6
      IF(NOWLTR.NE.LETTER(MATCH))GO TO 5
      KNTKAS=KNTKAS+1
      IF(KNTKAS.GE.IFCASE)GO TO 23
      LSTKAS=MATCH
      GO TO 5
    6 IF(KNTKAS.GT.0)GO TO 22
      GO TO 8
C
C     REPRESENT SPACE OR UNKNOWN CHARACTER
    7 IF(KASATO.GE.0)GO TO 8
      KASATO=-KASATO
      IFCASE=KASATO-IFCASE
    8 IF(ISPACE.LE.0)GO TO 9
      IF(LAST.EQ.0)GO TO 2
    9 KSPACE=KSPACE+LWIDE
      IF(IWHITE.LE.0)KSPACE=KSPACE+JSPACE
      GO TO 2
C
C     DOLLAR CONTROL CHARACTER FOUND
   10 LTRNXT=LTRNXT+1
      IF(LTRNXT.GT.LTREND)GO TO 57
      NOWLTR=LTTR(LTRNXT)
      IF(NOWLTR.EQ.KOMAND)GO TO 4
      IF(NOWLTR.EQ.IVRTCL)GO TO 13
      IF(NOWLTR.EQ.IHRZNT)GO TO 14
      IF(NOWLTR.EQ.IEQUAL)GO TO 12
      IF(NOWLTR.EQ.IFIXED)GO TO 15
      IF(NOWLTR.EQ.IADJST)GO TO 16
      IF(NOWLTR.EQ.NARROW)GO TO 17
      IF(NOWLTR.EQ.NWIDE)GO TO 18
      IF(NOWLTR.EQ.IEND)GO TO 19
      IF(NOWLTR.EQ.IUPPER)GO TO 20
      IF(NOWLTR.EQ.LOWER)GO TO 21
      DO 11 I=2,10
      IF(NOWLTR.NE.IDIGIT(I))GO TO 11
      IFCASE=I-1
      KASATO=0
      GO TO 2
   11 CONTINUE
      GO TO 2
   12 NOWVRT=1
      NOWHRZ=1
      IFCASE=1
      KASATO=0
      LWIDE=KWIDE
      IWHITE=MOVE
      GO TO 2
   13 NOWVRT=-1
      GO TO 2
   14 NOWHRZ=-1
      GO TO 2
   15 IF(IWHITE.GT.0)IWHITE=0
      GO TO 2
   16 IF(IWHITE.EQ.0)IWHITE=1
      GO TO 2
   17 LWIDE=KWIDE/2
      GO TO 2
   18 LWIDE=(3*KWIDE)/2
      GO TO 2
   19 IF(KASATO.LT.0)IFCASE=-KASATO-IFCASE
      KASATO=0
      GO TO 2
   20 IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
      IF(KASATO.GT.0)GO TO 2
      KASATO=-KASATO
      IFCASE=KASATO-IFCASE
      GO TO 2
   21 IF(KASATO.LT.0)GO TO 2
      IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
      IFCASE=KASATO-IFCASE
      KASATO=-KASATO
      GO TO 2
C
C     PREPARE TO PLOT CHARACTER
   22 MATCH=LSTKAS
   23 IF(KASATO.LE.0)GO TO 24
      IFCASE=KASATO-IFCASE
      KASATO=-KASATO
   24 NOWLNG=LENGTH(MATCH)
      LSTTST=NOWTST
      NOWTST=2**(NOWLNG-1)
C
C     DETERMINE OPTIMUM SPACING
C
C     SKIP AROUND THIS CODE IF NORMAL
C     INTER-CHARACTER SPACING IS ACCEPTABLE
C     WITHOUT WHITE AREA ADJUSTMENT.
C     THE CALCULATIONS ARE DESIGNED TO PRODUCE
C     DISTANCES OF THE SORT
C
C                  4
C                  34
C                  234
C                  1234
C                  01234
C                 X01234
C                  01234
C                  1234
C                  234
C                  34
C                  4
C
C     THE FIRST LOOP CATCHES THE MOST COMMON CASE OF
C     2 CHARACTERS TOUCHING ON THE SAME LINE.  THE
C     SECOND LONGER LOOP CATCHES THIS CASE AND ALL
C     OTHERS AND COULD BE USED BY ITSELF.
      IF(IWHITE.LT.0)GO TO 43
      IF(JSPACE.EQ.0)GO TO 45
      IF(LAST.EQ.0)GO TO 45
      IF(IWHITE.EQ.0)GO TO 45
      MIN=JSPACE
      ISTART=IHIGH*(LAST-1)
      JSTART=IHIGH*(MATCH-1)
      IF(LSTVRT.EQ.NOWVRT)GO TO 25
      LSTVRT=-1
      ISTART=ISTART+IHIGH+1
      GO TO 26
   25 LSTVRT=1
   26 IINDEX=ISTART
      JINDEX=JSTART
      DO 30 I=1,IHIGH
      IINDEX=IINDEX+LSTVRT
      JINDEX=JINDEX+1
      K=IPACKD(IINDEX)
      IF(LSTHRZ.LT.0)GO TO 27
      IF(K.EQ.(2*(K/2)))GO TO 30
      GO TO 28
   27 IF(K.LT.LSTTST)GO TO 30
   28 K=IPACKD(JINDEX)
      IF(NOWHRZ.GT.0)GO TO 29
      IF(K.EQ.(2*(K/2)))GO TO 30
      GO TO 45
   29 IF(K.GE.NOWTST)GO TO 45
   30 CONTINUE
      DO 42 I=1,IHIGH
      ISTART=ISTART+LSTVRT
      K=IPACKD(ISTART)
      IF(K.EQ.0)GO TO 42
      IF(LSTHRZ.GT.0)GO TO 32
      IDIST=LSTLNG
   31 K=K/2
      IDIST=IDIST-1
      IF(K.NE.0)GO TO 31
      GO TO 34
   32 IDIST=0
   33 L=K/2
      IF((L+L).NE.K)GO TO 34
      K=L
      IDIST=IDIST+1
      GO TO 33
   34 N=JSTART
      DO 41 J=1,IHIGH
      N=N+1
      K=IPACKD(N)
      IF(K.EQ.0)GO TO 41
      IF(NOWHRZ.GT.0)GO TO 36
      JDIST=IDIST
   35 L=K/2
      IF((L+L).NE.K)GO TO 38
      K=L
      JDIST=JDIST+1
      GO TO 35
   36 JDIST=IDIST+NOWLNG
   37 K=K/2
      JDIST=JDIST-1
      IF(K.NE.0)GO TO 37
   38 IF(I.GT.J)GO TO 39
      IF(I.EQ.J)GO TO 40
      JDIST=JDIST+J-I-1
      GO TO 40
   39 JDIST=JDIST+I-J-1
   40 IF(MIN.LE.JDIST)GO TO 41
      IF(JDIST.LE.0)GO TO 45
      MIN=JDIST
   41 CONTINUE
   42 CONTINUE
      KSPACE=KSPACE-MIN
      GO TO 45
C
C     ADJUST CENTERING OF NARROW CHARACTERS IF NEEDED
   43 IF(NOWLNG.GE.KWIDE)GO TO 45
      NEED=(KWIDE-NOWLNG)/2
      KSPACE=KSPACE+NEED
      NEED=KWIDE-NEED-NOWLNG
      GO TO 45
C
C     SECOND OR SUBSEQUENT LINE
   44 IF(KIND.NE.2)GO TO 50
      IFCASE=ISTORE(INISTR)
      IWHITE=ISTORE(INISTR+1)
      KASATO=ISTORE(INISTR+2)
      KSPACE=ISTORE(INISTR+3)
      LAST  =ISTORE(INISTR+4)
      LSTHRZ=ISTORE(INISTR+5)
      LSTKAS=ISTORE(INISTR+6)
      LSTLNG=ISTORE(INISTR+7)
      LSTTST=ISTORE(INISTR+8)
      LSTVRT=ISTORE(INISTR+9)
      LTRNXT=ISTORE(INISTR+10)
      LWIDE =ISTORE(INISTR+11)
      MATCH =ISTORE(INISTR+12)
      NEED  =ISTORE(INISTR+13)
      NOWHRZ=ISTORE(INISTR+14)
      NOWLNG=ISTORE(INISTR+15)
      NOWTST=ISTORE(INISTR+16)
      NOWVRT=ISTORE(INISTR+17)
      IF(KSPACE.LE.0)GO TO 46
      KSPACE=KSPACE-1
C
C     CONSTRUCT LETTER
   45 IF(KSPACE.GT.0)GO TO 51
      LSTTST=1
      IF(NOWHRZ.GT.0)LSTTST=NOWTST
      LSTLNG=NOWLNG
   46 IF(LSTLNG.LE.0)GO TO 1
      INITAL=IHIGH*(MATCH-1)
      IF(NOWVRT.GT.0)INITAL=INITAL+IHIGH+1
      NOWLTR=LTTR(LTRNXT)
      DO 48 I=1,IHIGH
      INITAL=INITAL-NOWVRT
      K=IPACKD(INITAL)/LSTTST
      K=K-(2*(K/2))
      DO 47 J=1,MULTPL
      MAXUSD=MAXUSD+1
      IBUFFR(MAXUSD)=IBLANK
      IF(K.NE.0)IBUFFR(MAXUSD)=NOWLTR
   47 CONTINUE
   48 CONTINUE
      LSTLNG=LSTLNG-1
      IF(NOWHRZ.LT.0)GO TO 49
      LSTTST=LSTTST/2
      GO TO 53
   49 LSTTST=2*LSTTST
      GO TO 53
C
C     CONSTRUCT LINE OF BLANKS
   50 KIND=1
   51 I=LFTCOL+(MULTPL*IHIGH)
   52 MAXUSD=MAXUSD+1
      IBUFFR(MAXUSD)=IBLANK
      IF(MAXUSD.LT.I)GO TO 52
      IF(KIND.NE.2)GO TO 57
C
C     STORE VARIABLES NEEDED TO PRODUCE NEXT LINE
   53 ISTORE(INISTR)=IFCASE
      ISTORE(INISTR+1)=IWHITE
      ISTORE(INISTR+2)=KASATO
      ISTORE(INISTR+3)=KSPACE
      ISTORE(INISTR+4)=LAST
      ISTORE(INISTR+5)=LSTHRZ
      ISTORE(INISTR+6)=LSTKAS
      ISTORE(INISTR+7)=LSTLNG
      ISTORE(INISTR+8)=LSTTST
      ISTORE(INISTR+9)=LSTVRT
      ISTORE(INISTR+10)=LTRNXT
      ISTORE(INISTR+11)=LWIDE
      ISTORE(INISTR+12)=MATCH
      ISTORE(INISTR+13)=NEED
      ISTORE(INISTR+14)=NOWHRZ
      ISTORE(INISTR+15)=NOWLNG
      ISTORE(INISTR+16)=NOWTST
      ISTORE(INISTR+17)=NOWVRT
      GO TO 57
C
C     RETURN TO CALLING PROGRAM
   54 KIND=3
      GO TO 57
   55 KIND=4
      GO TO 57
   56 KIND=5
   57 RETURN
C736047020160$
      END
      SUBROUTINE DATALL(LSTLIN,MRKLIN,MAXWID,IFLTTR,LETTER,
     1    IFCNCT,KONECT,XPOINT,MINSUB,MAXSUB, XLEFT,YVALUE,
     2    XRIGHT, IGRID, IEDGE,MARGIN,MSHWID,MSHHIH,LTROFF,
     3    LINPRT, IDISK,IRESET,LSTORE,XSTORE)
C     RENBR(/TIME SERIES PLOT ROUTINE FOR PRINTER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DATALL  IS  A  FORTRAN  SUBROUTINE  WHICH  CONSTRUCTS
C     PRINTABLE  PLOTS  WITH  A  VERTICAL  TIME  (OR  OTHER
C     CONSTANT INCREMENT UNIT) AXIS EXTENDING ONTO AS  MANY
C     LINES  AND  PAGES  AS  ARE NECESSARY TO REPRESENT THE
C     DATA.  THE POINTS WHICH REPRESENT A  PARTICULAR  DATA
C     ITEM  IN  CONSECUTIVE  TIME  PERIODS CAN BE CONNECTED
C     WITH LINE SEGMENTS TO FORM A CURVE.  A CURVE DOES NOT
C     NEED TO EXTEND ACROSS ALL TIME PERIODS.  THE SECTIONS
C     OF A CURVE WHICH ARE OUTSIDE THE PLOT  AREA  ARE  NOT
C     REPRESENTED.     A   MAXIMUM   OF   26   CURVES   ARE
C     DISTINGUISHABLE  BY  BEING  PLOTTED  WITH   DIFFERENT
C     CHARACTERS, BUT THERE IS NO LIMIT TO THE TOTAL NUMBER
C     OF CURVES WHICH CAN BE INCLUDED  IN  THE  PLOT  OF  A
C     PARTICULAR  TIME  PERIOD  OR  IN THE PLOT OF ALL TIME
C     PERIODS.  OVERLAPPING SECTIONS OF CURVES  REPRESENTED
C     BY DIFFERENT CHARACTERS ARE INDICATED BY AMPERSANDS.
C
C     DATALL IS CALLED ONCE FOR EACH TIME PERIOD TO  APPEND
C     A  REPRESENTATION OF THE DATA FOR THAT TIME PERIOD TO
C     THE PLOT OF THE DATA FOR THE  PREVIOUS  TIME  PERIOD.
C     ARRAYS  INPUT  TO  DATALL  SPECIFY  THE HORIZONTAL OR
C     NON-TIME  COORDINATE  OF  EACH  POINT  FOR  THE  TIME
C     PERIOD, THE LETTERS WITH WHICH THESE POINTS ARE TO BE
C     PLOTTED, AND THE LETTERS WITH WHICH THE POINTS ARE TO
C     BE  CONNECTED  WITH  THE POINTS FOR THE PREVIOUS TIME
C     PERIOD.  THE  SEGMENT  OF  THE  PLOT  REPRESENTING  A
C     SINGLE  TIME PERIOD CAN CONTAIN SEVERAL POINTS AND/OR
C     LINES.  IT  IS  OPTIONAL  WHETHER  THE  PLOT  SEGMENT
C     REPRESENTING  A TIME PERIOD IS RULED WITH A GRID LINE
C     AND IS IDENTIFIED BY A SCALE NUMBER.
C
C     DATALL IS A RELATIVELY  SHORT  ROUTINE  WHICH  RELIES
C     UPON  DAPLAT  FOR  ITS  PLOTTING  CAPABILITIES.   THE
C     ROUTINES DARITE AND PLTCUT MUST  ALSO  BE  LOADED  AS
C     THESE  ARE  CALLED  BY  DAPLAT.   DAPLAT  MUST NOT BE
C     CALLED BY ANY OTHER PROGRAM UNTIL THE PLOTTING OF ALL
C     TIME  PERIODS  HAS  BEEN  COMPLETED  SINCE DAPLAT HAS
C     INTERNAL STORAGE WHICH IS USED  BY  DATALL.   IF  THE
C     USER'S  PROGRAM  CALLS  DAPLAT  TO  DO OTHER PLOTTING
C     AFTER THE PLOTTING OF THE DATA FOR ALL  TIME  PERIODS
C     HAS  BEEN  COMPLETED,  THEN  THIS  SUBSEQUENT CALL TO
C     DAPLAT MUST USE NON-ZERO  VALUES  FOR  THE  ARGUMENTS
C     MAXWID,  MAXHIH,  MSHWID AND MSHHIH SINCE THE DEFAULT
C     VALUES OF  THESE  DAPLAT  ARGUMENTS  ARE  CHANGED  BY
C     DATALL.  THE CHARACTER SET USED FOR PLOTS PRODUCED BY
C     DATALL  CAN  BE  MANIPULATED  AS  DESCRIBED  IN   THE
C     INSTRUCTION MANUAL FOR DAPLAT.  THE MAXIMUM PLOT SIZE
C     LIMITATION FOR DAPLAT APPLIES TO  EACH  TIME  PERIOD,
C     NOT  TO  THE  ENTIRE PLOT OF ALL TIME PERIODS, AND SO
C     SHOULD BE OF NO CONCERN TO THE USER.
C
C     ARGUMENTS USED TO INPUT VALUES TO DATALL.
C
C     LSTLIN = 0, CURRENT TIME PERIOD IS FINAL TIME  PERIOD
C              TO  BE  REPRESENTED  IN PLOT.  SCALE NUMBERS
C              RANGING IN VALUE FROM THAT OF XLEFT  THROUGH
C              THAT  OF  XRIGHT  ARE  TO  BE  WRITTEN BELOW
C              REPRESENTATION OF CURRENT TIME  PERIOD,  AND
C              INTERNAL  STORAGE  IN  DATALL  AND DAPLAT IS
C              THEN TO BE CLEARED.
C            = GREATER THAN ZERO, CURRENT  TIME  PERIOD  IS
C              NOT  FINAL  TIME PERIOD IN PLOT.  SUBSEQUENT
C              CALLS TO DATALL WILL ADD ADDITIONAL SEGMENTS
C              TO CURRENT PLOT.  VALUE OF LSTLIN IS IGNORED
C              OTHER  THAN  TO  DETERIMINE  WHETHER  IT  IS
C              GREATER  THAN  ZERO.   IF MAIN PROGRAM KNOWS
C              TOTAL NUMBER OF TIME PERIODS, IT  CAN  COUNT
C              LSTLIN  DOWN  TO ZERO.  IF MAIN PROGRAM DOES
C              NOT KNOW TOTAL NUMBER OF TIME PERIODS, IT IS
C              SUFFICIENT  TO  SET  LSTLIN TO 1 UNTIL FINAL
C              TIME PERIOD.
C     MRKLIN = 0, CURRENT VALUE OF ARGUMENT YVALUE IS TO BE
C              PRINTED   TO   LEFT   OF   BOTTOM   LINE  IN
C              REPRESENTATION OF CURRENT  TIME  PERIOD  AND
C              SCALE  LINE CAN BE DRAWN THROUGH THIS BOTTOM
C              LINE.
C            = GREATER THAN ZERO, SCALE NUMBER IS NOT BE BE
C              PLACED  BESIDE BOTTOM LINE IN REPRESENTATION
C              OF CURRENT TIME PERIOD AND THIS BOTTOM  LINE
C              CANNOT  BE  RULED  AS  GRID  LINE.  VALUE OF
C              MRKLIN IS IGNORED OTHER THAN  TO  DETERIMINE
C              WHETHER  IT  IS GREATER THAN ZERO.  IF VALUE
C              OF ARGUMENT YVALUE  IS  NOT  TO  BE  PRINTED
C              BESIDE  EACH TIME PERIOD, THEN MRKLIN CAN BE
C              COUNTED DOWN TO ZERO BY MAIN PROGRAM.
C     MAXWID = WIDTH OF PLOT STATED AS NUMBER OF COLUMNS OF
C              CHARACTERS  FORMING PLOTTING AREA UPON WHICH
C              DATA CAN BE PLOTTED.  MAXWID IS  NORMALLY  1
C              PLUS  MULTIPLE OF MSHWID.  MAXIMUM EFFECTIVE
C              VALUE OF MAXWID IS 131.  IT SHOULD BE  NOTED
C              THAT   PLOT  HAS  ADDITIONAL  MARGIN  OF  12
C              CHARACTERS ALONG LEFT SIDE  IN  WHICH  SCALE
C              NUMBERS AND CARRIAGE CONTROL ARE PRINTED.
C            = 0, USE THE LAST NONZERO VALUE SPECIFIED  FOR
C              MAXWID AS  THE WIDTH OF THE PLOT, OR USE THE
C              VALUE 101  IF A NONZERO  VALUE OF MAXWID HAS
C              NOT BEEN SPECIFIED.
C     IFLTTR = SELECTS WHETHER CHARACTERS TO BE PLOTTED  AT
C              POINTS  ARE TO BE IDENTIFIED BY LETTER ARRAY
C              OR  BY  LOCATION  OF  THEIR  COORDINATES  IN
C              XPOINT ARRAY.
C            = 0, LETTER ARRAY IDENTIFIES CHARACTERS TO  BE
C              PLOTTED AT POINTS.
C            = 1, POINTS ARE PLOTTED USING  LETTERS  HAVING
C              SAME   SEQUENCE   NUMBER   IN   ALPHABET  AS
C              SUBSCRIPTS  OF  LOCATION  IN  XPOINT   ARRAY
C              CONTAINING  COORDINATES.   POINT  HAVING ITS
C              NON-TIME COORDINATE IN  XPOINT(3)  WOULD  BE
C              REPRESENTED  BY  LETTER  C,  3RD  LETTER  IN
C              ALPHABET.  POINTS HAVING SUBSCRIPTS EQUAL TO
C              OR  GREATER  THAN  27   ARE  REPRESENTED  BY
C              ASTERISKS.   CONTENTS  OF  LETTER  ARRAY ARE
C              IGNORED.
C     LETTER = ARRAY IDENTIFYING CHARACTERS WITH  WHICH  TO
C              REPRESENT  POINTS HAVING AS THEIR HORIZONTAL
C              OR NON-TIME  COORDINATES  VALUES  IN  XPOINT
C              ARRAY  WITH  SAME  SUBSCRIPTS.  LETTER ARRAY
C              VALUES OF  -1  INDICATE  THAT  CORRESPONDING
C              POINTS  ARE NOT TO BE PLOTTED.  LETTER ARRAY
C              VALUES OF ZERO INDICATE  THAT  CORRESPONDING
C              POINTS  ARE  TO  BE  PLOTTED WITH ASTERISKS.
C              VALUES  GREATER  THAN  ZERO   ARE   SEQUENCE
C              NUMBERS  WITHIN  ALPHABET  OF  LETTERS TO BE
C              USED TO REPRESENT POINTS.  IF  ASTERISK  AND
C              LETTER ARE TO OCCUPY SAME PRINTING CHARACTER
C              POSITION ON PLOT, THEN LETTER  APPEARS.   IF
C              DIFFERENT   LETTERS   ARE   TO  OCCUPY  SAME
C              PRINTING CHARACTER POSITION  ON  PLOT,  THEN
C              AMPERSAND  APPEARS  INSTEAD.   IF  IFLTTR IS
C              NON-ZERO, THEN LETTER ARRAY IS NOT USED  AND
C              NEED NOT BE DIMENSIONED.
C     IFCNCT = SELECTS WHETHER  CHARACTERS  TO  BE  PLOTTED
C              ALONG LINE SEGMENTS CONNECTING POINTS ARE TO
C              BE IDENTIFIED BY KONECT ARRAY OR ARE  TO  BE
C              SAME AS THOSE USED TO REPRESENT POINTS.
C            = -1, POINTS IN CURRENT TIME PERIOD ARE NOT TO
C              BE  CONNECTED  TO  POINTS  OF  PREVIOUS TIME
C              PERIOD.   CONTENTS  OF  KONECT   ARRAY   ARE
C              IGNORED.
C            = 0, KONECT ARRAY IDENTIFIES CHARACTERS TO  BE
C              PLOTTED ALONG LINE SEGMENTS.
C            = 1, LINE SEGMENTS ARE TO BE  FORMED  OF  SAME
C              CHARACTERS  AS  ARE  USED  TO PLOT POINTS IN
C              CURRENT PERIOD.  CONTENTS  OF  KONECT  ARRAY
C              ARE IGNORED.
C     KONECT = ARRAY IDENTIFYING CHARACTERS WITH  WHICH  TO
C              CONNECT  POINTS  OF CURRENT TIME PERIOD WITH
C              POINTS OF PREVIOUS  TIME  PERIOD  WHICH  HAD
C              SAME  SUBSCRIPTS.   IF  POINTS  HAVING  SAME
C              SUBSCRIPT WERE NOT PLOTTED IN  BOTH  CURRENT
C              TIME  PERIOD  AND PREVIOUS TIME PERIOD, THEN
C              VALUE IN KONECT ARRAY IS  IGNORED.   LETTERS
C              ARE  SELECTED BY KONECT ARRAY IN SAME MANNER
C              AS BY  LETTER  ARRAY,  WITH  EXCEPTION  THAT
C              KONECT    ARRAY    VALUE    OF   -1   CAUSES
C              CORRESPONDING POINTS,  IF  ANY,  TO  NOT  BE
C              CONNECTED.   IF  IFCNCT  IS  NON-ZERO,  THEN
C              KONECT ARRAY IS NOT USED  AND  NEED  NOT  BE
C              DIMENSIONED.
C     XPOINT = ARRAY  CONTAINING  HORIZONTAL  OR   NON-TIME
C              COORDINATES  OF  POINTS  TO  BE  PLOTTED FOR
C              CURRENT TIME PERIOD.  COORDINATE SYSTEM USED
C              FOR  XPOINT  ARRAY MUST BE SAME AS THAT USED
C              FOR ARGUMENTS XLEFT AND XRIGHT WHICH  SELECT
C              COORDINATES TO BE PLACED AT LEFT EDGE AND AT
C              RIGHT  EDGE  OF  PLOT  RESPECTIVELY.    ONLY
C              VALUES  OF  LETTER, KONECT AND XPOINT HAVING
C              SUBSCRIPTS IN RANGE STARTING WITH MINSUB AND
C              EXTENDING THROUGH MAXSUB ARE USED.
C     MINSUB = LOWEST VALUED SUBSCRIPT TO BE PLOTTED  USING
C              INFORMATION  IN  LETTER,  KONECT  AND XPOINT
C              ARRAYS.  SUBSCRIPT RANGE CAN VARY  FROM  ONE
C              TIME PERIOD TO NEXT.
C     MAXSUB = HIGHEST VALUED SUBSCRIPT TO BE PLOTTED USING
C              INFORMATION  IN  LETTER,  KONECT  AND XPOINT
C              ARRAYS.  SUBSCRIPT RANGE CAN VARY  FROM  ONE
C              TIME  PERIOD  TO  NEXT.  IF NO DATA IS TO BE
C              PLOTTED FOR CURRENT TIME PERIOD, THEN MAXSUB
C              CAN BE LESS THAN MINSUB.  IT SHOULD BE NOTED
C              THAT EMPTY TIME PERIODS  AT  START  OF  TIME
C              SERIES  PLOT  ARE  DISCARDED,  BUT THAT ONCE
C              NON-EMPTY TIME PERIOD HAS BEEN  ENCOUNTERED,
C              THEN  ALL REMAINING TIME PERIODS ARE PLOTTED
C              WHETHER EMPTY OR  NOT.   ARRAYS  XSTORE  AND
C              LSTORE  MUST ALSO BE DIMENSIONED TO AT LEAST
C              MAXIMUM VALUE OF MAXSUB.
C     XLEFT  = HORIZONTAL OR NON-TIME DATA COORDINATE TO BE
C              PLACED  AT  LEFT EDGE OF PLOT.  ONLY PORTION
C              OF CURVES HAVING VALUES  BETWEEN  XLEFT  AND
C              XRIGHT  WILL  BE  SHOWN  ON  PLOT.   IF LINE
C              SEGMENT  CROSSES  PLOT,  PORTION   OF   LINE
C              SEGMENT  WHICH IS OUTSIDE PLOT AREA WILL NOT
C              BE REPRESENTED.  DATA COORDINATES CAN EITHER
C              INCREASE OR DECREASE FROM LEFT TO RIGHT.
C     YVALUE = NUMBER  IDENTIFYING  CURRENT  TIME   PERIOD.
C              THIS  VALUE  MUST  CHANGE  FROM  ONE CALL TO
C              DATALL TO NEXT, BUT CAN EITHER  INCREASE  OR
C              DECREASE.   IF  CURRENT  VALUE  OF MRKLIN IS
C              ZERO, THEN VALUE OF YVALUE WILL  BE  PRINTED
C              TO  LEFT  OF  LOWEST  LINE  OF  CURRENT PLOT
C              SEGMENT.
C     XRIGHT = HORIZONTAL OR NON-TIME DATA COORDINATE TO BE
C              PLACED AT RIGHT EDGE OF PLOT.
C     IGRID  = 0,  PLOT  WILL  SHOW  INTERNAL  GRID.   THIS
C              INTERNAL GRID WILL BE RULED VERTICALLY EVERY
C              MSHWID CHARACTERS AND, IF MRKLIN IS EQUAL TO
C              ZERO, HORIZONTALLY EVERY MHSHIH LINES.
C            = 1, PLOT WILL SHOW INTERSECTIONS OF LINES  OF
C              INTERNAL  GRID, BUT WILL NOT SHOW GRID LINES
C              THEMSELVES.  INTERNAL GRID WOULD, IF  SHOWN,
C              HAVE  VERTICAL LINES EVERY MSHWID CHARACTERS
C              ACROSS WIDTH OF PLOT AND WOULD, IF MRKLIN IS
C              EQUAL  TO  ZERO,  HAVE  HORIZONTAL  LINES ON
C              BOTTOM LINE OF EACH PLOT SEGMENT.  EACH PLOT
C              SEGMENT   CONSISTS   OF   MSHHIH  LINES,  SO
C              HORIZONTAL LINES CAN BE RULED  EVERY  MSHHIH
C              LINES IF MRKLIN IS ALWAYS ZERO.
C            = 2, PLOT WILL NOT SHOW INTERNAL GRID.
C     IEDGE  = 0, IF MRKLIN IS EQUAL  TO  ZERO  THEN  PLACE
C              SCALE  NUMBER  TO  LEFT  OF  LINE DISPLAYING
C              CURRENT POINTS.  IF LSTLIN IS EQUAL TO ZERO,
C              THEN PLACE SCALE NUMBERS BELOW PLOT.
C            = 1, IF MRKLIN IS EQUAL  TO  ZERO  THEN  PLACE
C              SCALE  NUMBER  TO  LEFT  OF  LINE DISPLAYING
C              CURRENT POINTS.  DO NOT PLACE SCALE  NUMBERS
C              BELOW PLOT.
C            = 2, IF LSTLIN IS EQUAL TO  ZERO,  THEN  PLACE
C              SCALE  NUMBERS  BELOW  PLOT.   DO  NOT PLACE
C              SCALE NUMBERS TO LEFT OF PLOT.
C            = 3, DO NOT PLACE SCALE NUMBERS EITHER TO LEFT
C              OF OR BELOW PLOT.
C     MARGIN = MINIMUM   NUMBER   OF   CHARACTERS   BETWEEN
C              CARRIAGE  CONTROL  CHARACTER  IN COLUMN 1 OF
C              OUTPUT AND LEFT EDGE OF PLOT.   THIS  MARGIN
C              INCLUDES  LEFT  SCALE  NUMBERS AND SPACES TO
C              THEIR LEFT.
C     MSHWID = WIDTH OF GRID DIVISIONS STATED AS NUMBER  OF
C              COLUMNS OF CHARACTERS.  MSHWID=10 WOULD GIVE
C              VERTICAL  GRID  LINES  EVERY  10  CHARACTERS
C              ACROSS WIDTH OF PLOT AREA.
C            = 0, USE THE LAST NONZERO  VALUE SPECIFIED FOR
C              MSHWID AS  THE GRID  DIVISION  WIDTH, OR USE
C              THE VALUE  10 IF A  NONZERO VALUE  OF MSHWID
C              HAS NOT BEEN SPECIFIED BY A PREVIOUS CALL TO
C              THIS ROUTINE.
C     MSHHIH = NUMBER OF LINES OF PRINTING TO  BE  INCLUDED
C              IN  PLOT  SEGMENT  REPRESENTING CURRENT TIME
C              PERIOD.   IF  POINTS  FOR  SUCCESSIVE   TIME
C              PERIODS   ARE   BEING   CONNECTED   BY  LINE
C              SEGMENTS,  THEN  THESE  LINE  SEGMENTS  WILL
C              EXTEND   ACROSS  THESE  LINES  OF  PRINTING.
C              POINTS THEMSELVES ARE REPRESENTED IN  BOTTOM
C              LINE OF PLOT SEGMENT.
C            = 0, ASSUME THAT MSHHIH=1 IS MEANT.  EACH TIME
C              PERIOD WILL BE REPRESENTED BY SINGLE LINE OF
C              TIME SERIES PLOT.
C     LTROFF = DISTANCE  STATED  AS  NUMBER  OF  CHARACTERS
C              BETWEEN  LEFT  EDGE  OF  PLOT AND LEFT SCALE
C              LINE.  IF LTROFF=0,  THEN  LEFT  SCALE  LINE
C              WILL BE AT LEFT EDGE OF PLOT.
C     LINPRT = -1, THE PLOT IS NOT  TO INCLUDE ANY CARRIAGE
C              CONTROL CHARACTER AT LEFT END OF EACH LINE.
C            = 0, PLOT WILL BE VIEWED BY USER ON  TERMINAL,
C              EITHER TYPED DIRECTLY WITH IDISK BEING GIVEN
C              TERMINAL UNIT NUMBER, OR TYPED BY USER AFTER
C              THIS  ROUTINE  HAS WRITTEN PLOT INTO FILE ON
C              UNIT NUMBER OF WHICH IS CONTAINED IN  IDISK.
C              BLANK  OR  SPACE  WILL  BE  USED AS CARRIAGE
C              CONTROL CHARACTER TO GIVE SINGLE SPACING.
C            = 1, PLOT WILL BE PRINTED ON LINE  PRINTER  BY
C              USER  AFTER  PROGRAM  HAS  WRITTEN PLOT INTO
C              FILE.  ASTERISK WILL  BE  USED  AS  CARRIAGE
C              CONTROL  CHARACTER  TO  GIVE  SINGLE SPACING
C              WITH SUPPRESSION OF SKIPPING EXTRA LINES  AT
C              PAGE  BOUNDARIES.   ON  PDP-10,  ASTERISK AS
C              CARRIAGE     CONTROL     CHARACTER     GIVES
C              OVERPRINTING   ON  TERMINAL  AS  OPPOSED  TO
C              SINGLE SPACING.
C     IDISK  = UNIT NUMBER OF DEVICE ONTO WHICH  PLOTS  ARE
C              TO  BE  WRITTEN.   THIS  ROUTINE  WILL  ONLY
C              GENERATE  PLOT.   IT  IS  RESPONSIBLITY   OF
C              CALLING  PROGRAM  TO OPEN OUTPUT FILE AND TO
C              WRITE CAPTIONS, FORM FEEDS AND/OR SEPARATING
C              LINES.
C
C     FOLLOWING ARGUMENT IS USED BOTH FOR INPUT AND OUTPUT.
C
C     IRESET = 1 (OR GREATER), NEITHER  DATALL  NOR  DAPLAT
C              HAVE  BEEN CALLED BEFORE.  INTERNAL STORAGES
C              IN  BOTH  DATALL  AND  DAPLAT  ARE   TO   BE
C              INITIALIZED.   IRESET  CAN  BE  GIVEN  VALUE
C              GREATER THAN ONE TO  SELECTIVELY  INITIALIZE
C              STORAGE    IN    DAPLAT.    CONSULT   DAPLAT
C              DOCUMENTATION FOR  THESE VALUES.   IRESET IS
C              RETURNED SET TO -1.
C            = 0,  DAPLAT  HAS  ALREADY  BEEN  CALLED,  BUT
C              DATALL  HAS  NOT  BEEN  CALLED.   IRESET  IS
C              RETURNED SET TO -1.
C            = -1, DATALL HAS BEEN PREVIOUSLY CALLED.
C
C     ARGUMENTS USED ONLY FOR INTERMEDIATE DATA STORAGE
C
C     VALUES INITIALLY IN ARRAY ARGUMENTS XSTORE AND LSTORE
C     ARE IGNORED AND ARE DESTROYED.  THESE ARRAYS ARE USED
C     BY DATALL TO STORE COORDINATES OF POINTS AND TO STORE
C     LETTERS  USED TO PLOT THESE POINTS SO THAT SUBSEQUENT
C     CALL TO DATALL CAN EXTEND LINE SEGMENTS  FROM  POINTS
C     OF  TIME PERIOD PREVIOUS TO IT.  CALLING PROGRAM MUST
C     NOT MODIFY CONTENTS OF THESE ARRAYS WHILE TIME SERIES
C     PLOT   IS  BEING  GENERATED.   BOTH  ARRAYS  MUST  BE
C     DIMENSIONED TO AT  LEAST  MAXIMUM  VALUE  OF  MAXSUB.
C     THIS  ARRAY  SPACE  CAN BE USED FOR OTHER PURPOSES BY
C     CALLING PROGRAM AFTER DATALL  HAS  BEEN  CALLED  WITH
C     LSTLIN EQUAL TO ZERO.
C
C     LSTORE = USED TO  STORE  CONTENTS  OF  LETTER  ARRAY.
C              DIMENSION  OF  LSTORE  ARRAY MUST BE MAXIMUM
C              VALUE OF MAXSUB ENCOUNTERED WHILE IFLTTR  IS
C              ZERO.  IF IFLTTR IS ALWAYS 1, THEN LSTORE IS
C              NEVER USED AND NEED NOT BE DIMENSIONED.
C     XSTORE = USED TO STORE CONTENTS OF XPOINT ARRAY.
C
C     THE ITEMS IN  COMMON/FASPF/  STORE  INFORMATION ABOUT
C     PREVIOUS CALL TO DAHIST AND MUST BE PRESERVED BETWEEN
C     CALLS
      COMMON/FASPF/KRESET,LINKNT,JRESET,MRKSTR,IFLSTR,
     1             MINSTR,MAXSTR,YVASTR,LTRERR,LINERR
C
      DIMENSION LETTER(MAXSUB),KONECT(MAXSUB),
     1XPOINT(MAXSUB),LSTORE(MAXSUB),XSTORE(MAXSUB)
      DIMENSION XDOUBL(2),YDOUBL(2)
C
C     DETERMINE WHETHER THIS IS FIRST PANEL OF PLOT
      IF(IRESET.GE.0)GO TO 23
      IF(KRESET.NE.999)GO TO 23
C
C     GET CURRENT HEIGHT
      JHIGH=2
      IF(MSHHIH.GT.0)JHIGH=MSHHIH+1
C
C     MASK OUT THE HUNDREDS DIGIT OF IGRID
      JGRID=IGRID
      IF(JGRID.LT.0)JGRID=0
      KGRID=JGRID/100
      JGRID=JGRID-(100*KGRID)
C
C     MASK OUT THE HUNDREDS DIGIT OF IEDGE
      JEDGE=IEDGE
      IF(JEDGE.LT.0)JEDGE=0
      KEDGE=JEDGE/100
      JEDGE=JEDGE-(100*KEDGE)+300
C
C     DETERMINE PLACEMENT OF EDGE LINES
      IF(LINKNT.GT.1)GO TO 1
      IF(KEDGE.EQ.0)JEDGE=JEDGE-100
      IF(KEDGE.EQ.2)JEDGE=JEDGE-100
    1 IF(LSTLIN.GT.0)GO TO 2
      IF(KEDGE.LE.1)JEDGE=JEDGE-200
C
C     DETERMINE PLACEMENT OF GRID LINES
    2 LINOFF=0
      IHIGH=JHIGH
      IF(MRKSTR.EQ.0)GO TO 3
      IF(MRKLIN.EQ.0)GO TO 5
      IHIGH=IHIGH+1
      GO TO 6
    3 IF(MRKLIN.EQ.0)GO TO 4
      LINOFF=-1
      IF(LINKNT.GT.1)GO TO 6
      IF(KGRID.EQ.1)GO TO 6
      IF(KGRID.GE.3)GO TO 6
      JGRID=JGRID+200
      GO TO 7
    4 IHIGH=IHIGH-1
      IF(LINKNT.GT.1)GO TO 5
      IF(KGRID.GT.3)GO TO 6
      JGRID=IGRID
      GO TO 7
    5 IF(LSTLIN.GT.0)GO TO 6
      IF(KGRID.GE.2)GO TO 6
      JGRID=JGRID+100
      GO TO 7
    6 JGRID=JGRID+300
C
C     IF SECOND LINE, ADD FIRST SEQUENCE OF POINTS TO PLOT.
C     SOME OF THESE  MIGHT NOT BE  INCLUDED IN SECOND LINE.
    7 IF(LSTLIN.GT.0)JGRID=-JGRID-1
      IPLOT=-1
      IF(LINKNT.GT.1)GO TO 12
      IPASS=1
      YDOUBL(1)=YVASTR
      INDEX=MINSTR
      KOUNT=1
    8 IF(INDEX.GT.MAXSTR)GO TO 12
      IF(IFLSTR.NE.0)GO TO 9
      IF(LSTORE(INDEX).LT.0)GO TO 11
      ILTTR=LSTORE(INDEX)
      GO TO 10
    9 ILTTR=INDEX
   10 XDOUBL(1)=XSTORE(INDEX)
      GO TO 19
   11 INDEX=INDEX+1
      GO TO 8
C
C     ADD CURRENT LINE SEGMENT TO THE PLOT
   12 YDOUBL(1)=YVALUE
      YDOUBL(2)=YVASTR
      IPASS=0
      INDEX=MINSUB
   13 IF(INDEX.GT.MAXSUB)GO TO 21
      IF(IFLTTR.NE.0)GO TO 14
      IF(LETTER(INDEX).LT.0)GO TO 20
      ILTTR=LETTER(INDEX)
      GO TO 15
   14 ILTTR=INDEX
   15 XDOUBL(1)=XPOINT(INDEX)
      KOUNT=1
      IF(IFCNCT.LT.0)GO TO 19
      IF(IFCNCT.GT.0)GO TO 16
      IF(KONECT(INDEX).LT.0)GO TO 19
   16 IF(INDEX.LT.MINSTR)GO TO 19
      IF(INDEX.GT.MAXSTR)GO TO 19
      IF(IFLSTR.NE.0)GO TO 17
      IF(LSTORE(INDEX).LT.0)GO TO 19
      IKNCT=KONECT(INDEX)
      GO TO 18
   17 IKNCT=ILTTR
   18 KOUNT=2
      XDOUBL(2)=XSTORE(INDEX)
   19 CALL DAPLAT(IPLOT,MAXWID,JHIGH,ILTTR,IKNCT,
     1XDOUBL,YDOUBL,1,KOUNT,XLEFT,YVALUE,XRIGHT,
     2YVASTR,JGRID,JEDGE,MARGIN,MSHWID,IHIGH,LTROFF,
     3LINOFF,LINPRT,IDISK,JRESET,LTRERR,LINERR)
      IF(IPLOT.EQ.0)GO TO 22
      IF(IPASS.NE.0)GO TO 11
      XSTORE(INDEX)=XPOINT(INDEX)
   20 IF(IFLTTR.EQ.0)LSTORE(INDEX)=LETTER(INDEX)
      INDEX=INDEX+1
      GO TO 13
C
C     CONSTRUCT THE PLOT
   21 KOUNT=0
      IPLOT=0
      GO TO 19
C
C     STORE INFORMATION NEEDED BY SUBSEQUENT CALL TO DATALL
   22 IF(LSTLIN.GT.0)GO TO 25
      KRESET=0
      GO TO 26
   23 KRESET=999
      LINKNT=0
      LTRERR=0
      LINERR=0
      JRESET=0
      IF(IRESET.GT.0)JRESET=IRESET
      IRESET=-1
      INDEX=MINSUB
   24 IF(INDEX.GT.MAXSUB)GO TO 25
      XSTORE(INDEX)=XPOINT(INDEX)
      IF(IFLTTR.EQ.0)LSTORE(INDEX)=LETTER(INDEX)
      INDEX=INDEX+1
      GO TO 24
   25 LINKNT=LINKNT+1
      MINSTR=MINSUB
      MAXSTR=MAXSUB
      YVASTR=YVALUE
      MRKSTR=MRKLIN
      IFLSTR=IFLTTR
   26 RETURN
C922140683991
      END
      SUBROUTINE DAPLAT( IPLOT,MAXWID,MAXHIH,LETTER,KONECT,
     1    XPOINT,YPOINT,MINSUB,MAXSUB, XLEFT,YLOWER,XRIGHT,
     2    YUPPER, IGRID, IEDGE,MARGIN,MSHWID,MSHHIH,LTROFF,
     3    LINOFF,LINPRT, IDISK,IRESET,LTRERR,LINERR)
C     RENBR(/POINT, CURVE AND PIN MAP PLOTTER FOR PRINTER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE  TO  CONSTRUCT  A  PLOT  OF   USER   SELECTED
C     PROPORTIONS AND WHICH CAN CONTAIN ONE OR MORE CURVES,
C     EACH CURVE BEING REPRESENTED BY  ITS  OWN  ALPHABETIC
C     LETTER.    POINTS   ON  A  CURVE  CAN  OPTIONALLY  BE
C     CONNECTED EITHER BY ASTERISKS OR BY  SOME  ALPHABETIC
C     LETTER  WHICH  NEED  NOT  BE THE SAME AS THAT USED TO
C     REPRESENT THE  POINTS THEMSELVES.  IF PLOTTING POINTS
C     NOT CONNECTED BY LINES, A PIN MAP CAN BE SIMULATED BY
C     USING THE  CLOSEST  EMPTY  LOCATION  IF THE  LOCATION
C     REPRESENTING THE POINT IS ALREADY USED.  THE PLOT CAN
C     BE RULED  WITH GRID LINES EVERY 10  CHARACTERS ACROSS
C     ITS WIDTH AND EVERY 5 LINES ACROSS ITS HEIGHT.  THESE
C     GRID DIVISION  WIDTHS AND HEIGHTS  ARE ALSO UNDER THE
C     USER'S CONTROL.   NUMBERS PRINTED ALONGSIDE  THE PLOT
C     ARE REPRESENTED  WITH 5 SIGNIFICANT  DIGITS, BUT WITH
C     SUPPRESSION  OF RIGHTHAND  ZEROES TO THE RIGHT OF THE
C     DECIMAL POINT.   IF THE  NUMBER CANNOT  BE PRINTED IN
C     FLOATING POINT FORM,  THEN THE  NUMBER IS REPRESENTED
C     IN SCIENTIFIC NOTATION INSTEAD.
C
C     IF TWO OR MORE DIFFERENT ALPHABETIC  LETTERS  ARE  TO
C     APPEAR  IN  THE SAME LOCATION IN THE PRINTED PLOT, AN
C     AMPERSAND  WILL  APPEAR  INSTEAD.   HOWEVER,  IF  THE
C     POINTS  AND THE  LINES  OPTIONALLY  CONNECTING  THESE
C     POINTS ARE TO APPEAR AS DIFFERENT LETTERS, THEN THESE
C     LETTERS, WHERE USED FOR PREVIOUS CURVES OR WHERE USED
C     ELSEWHERE ON  THE CURRENT CURVE,  ARE  NOT CHANGED TO
C     AMPERSANDS BY COINCIDENCE WITH THE PRESENT CURVE.
C
C     THIS ROUTINE  CALLS THE WINDOWING  ROUTINE PLTCUT AND
C     THE GENERALIZED FLOATING POINT OUTPUT ROUTINE DARITE.
C
C     THE FOLLOWING INPUT  ARGUMENTS ARE  USED BY EACH CALL
C     TO DAPLAT WHETHER OR NOT A PLOT IS GENERATED
C
C     IPLOT  = -1, ADD THE POINTS AND/OR LINES  REPRESENTED
C              BY  THE COORDINATES IN THE XPOINT AND YPOINT
C              ARRAYS TO THE PLOT STORAGE, THEN  RETURN  TO
C              THE  CALLING  PROGRAM WITHOUT GENERATING THE
C              PLOT.   ADDITIONAL  DAPLAT  CALLS  WILL   BE
C              EXECUTED BEFORE THE PLOT IS TO BE PRINTED.
C            = 0, ADD THE POINTS AND/OR LINES IN THE XPOINT
C              AND  YPOINT ARRAYS TO THE PLOT STORAGE, THEN
C              GENERATE  THE  PLOT  AND  CLEAR   THE   PLOT
C              STORAGE.   ADDITIONAL  CALLS  TO  DAPLAT, IF
C              ANY, WILL STORE UPON A BLANK PLOT SURFACE.
C            = 1, ADD THE POINTS AND/OR LINES IN THE XPOINT
C              AND  YPOINT ARRAYS TO THE PLOT STORAGE, THEN
C              GENERATE THE PLOT BUT DO NOT CLEAR THE  PLOT
C              STORAGE.   THE CURRENTLY STORED PLOT WILL BE
C              ADDED TO BY ADDITIONAL CALLS TO DAPLAT.
C     MAXWID = WIDTH OF THE PLOT STATED AS  THE  NUMBER  OF
C              COLUMNS OF  CHARACTERS FORMING  THE PLOTTING
C              AREA UPON WHICH DATA CAN BE PLOTTED.  MAXWID
C              IS NORMALLY  1 PLUS  A MULTIPLE  OF  MSHWID.
C              MAXIMUM RECOMMENDED  VALUE OF MAXWID IS 101.
C              NOTE THAT THE PLOT HAS AN ADDITIONAL  MARGIN
C              OF 12  CHARACTERS ALONG  THE  LEFT  SIDE  IN
C              WHICH SCALE NUMBERS  ARE  PRINTED.  AN ADDI-
C              TIONAL 4 CHARACTERS  CAN APPEAR TO THE RIGHT
C              OF THE PLOT IN THE LOWER-RIGHT SCALE NUMBER.
C              THE LARGEST ACCEPTED VALUE OF MAXWID IS 131,
C              WHICH CAN LEAD TO LOWER SCALE 147 CHARACTERS
C              WIDE WHICH  IS TOO LARGE  TO OUTPUT ON  MOST
C              LINE-PRINTERS.  IF THE  VALUE OF IGRID TURNS
C              OFF BOTH  LEFT SCALE NUMBERS AND LOWER SCALE
C              NUMBERS,  THEN ONLY 1  CHARACTER  (EITHER AN
C              ASTERISK OR A SPACE) WILL APPEAR TO THE LEFT
C              OF THE  PLOT SO MAXIMUM  WIDTH  OF A PRINTED
C              WOULD THEN BE MERELY 1 PLUS MAXWID.
C            = 0, USE THE LAST NONZERO VALUE SPECIFIED  FOR
C              MAXWID AS  THE WIDTH OF THE PLOT, OR USE THE
C              VALUE 101  IF A NONZERO  VALUE OF MAXWID HAS
C              NOT BEEN SPECIFIED.
C     MAXHIH = HEIGHT OF THE PLOT STATED AS THE  NUMBER  OF
C              LINES FORMING  THE PLOTTING AREA  UPON WHICH
C              DATA CAN BE PLOTTED.   NORMALLY MAXHIH WOULD
C              BE 1 PLUS  A MULTIPLE  OF MSHHIH.   THE PLOT
C              HAS AN  ADDITIONAL  LOWER MARGIN  OF 2 LINES
C              (OR 3  LINES  IF THE  SCALE  NUMBERS  ARE IN
C              SCIENTIFIC  NOTATION).
C            = 0, USE THE LAST NONZERO VALUE SPECIFIED  FOR
C              MAXHIH AS THE HEIGHT OF THE PLOT, OR USE THE
C              VALUE 51  IF A NONZERO  VALUE OF  MAXHIH HAS
C              NOT BEEN SPECIFIED.
C     LETTER = 0, PLOT THE POINTS HAVING COORDINATES IN THE
C              XPOINT AND YPOINT ARRAYS WITH ASTERISKS.  IF
C              ONE (OR MORE)  OF THESE POINTS  IS TO APPEAR
C              AT THE  SAME  LOCATION  ON THE PLOT  AS SOME
C              OTHER  POINT OR  PORTION OF A  LINE SEGMENT,
C              THE OTHER POINT OR PORTION OF A LINE SEGMENT
C              IS SHOWN INSTEAD OF THE CURRENT POINT.
C            = 1 THRU 26, IDENTIFIES ALPHABETIC LETTER USED
C              TO PLOT THE POINTS HAVING COORDINATES IN THE
C              XPOINT AND YPOINT  ARRAYS.   LETTER  IS  THE
C              SERIAL NUMBER OF THE LETTER IN THE ALPHABET.
C              LETTER=3 WOULD CAUSE THE PLOTTED  POINTS  TO
C              BE REPRESENTED WITH C'S.
C            = 27, PLOT  THE POINTS  HAVING  COORDINATES IN
C              THE XPOINT AND YPOINT ARRAYS WITH ASTERISKS.
C              IF  ONE  (OR  MORE)  OF  THESE  POINTS IS TO
C              APPEAR AT THE SAME  LOCATION ON THE PLOT  AS
C              SOME  OTHER  POINT  OR  PORTION  OF  A  LINE
C              SEGMENT,  THEN THE ASTERISK  APPEARS INSTEAD
C              OF  THE  OTHER  POINT  OR PORTION  OF A LINE
C              SEGMENT.
C     KONECT = .LT.-1,  SIMULATE  PIN  MAP.   STORE  POINTS
C              HAVING  COORDINATES  IN  XPOINT  AND  YPOINT
C              ARRAYS FOR PLOTTING (EITHER BY CURRENT  CALL
C              TO  DAPLAT  IF  IPLOT.GE.0  OR BY SUBSEQUENT
C              CALL TO DAPLAT IF IPLOT.NE.0).  IF LETTER IS
C              GREATER   THAN   ZERO,   AND   IF   LOCATION
C              REPRESENTING POINT ALREADY CONTAINS PRINTING
C              CHARACTER  OTHER  THAN NONDOMINANT ASTERISK,
C              THEN SEARCH FOR CLOSEST  LOCATION  WHICH  IS
C              EMPTY    OR   WHICH   CONTAINS   NONDOMINANT
C              ASTERISK.  IF LETTER IS  ZERO  AND  LOCATION
C              REPRESENTING POINT ALREADY CONTAINS PRINTING
C              CHARACTER, THEN SEARCH FOR CLOSEST  LOCATION
C              WHICH  CONTAINS  SPACE.   IF,  AFTER  HAVING
C              SEARCHED NUMBER OF CONCENTRIC BOXES EQUAL TO
C              ABSOLUTE   VALUE  OF  KONECT,  NO  AVAILABLE
C              LOCATION HAS YET BEEN  FOUND,  THEN  ABANDON
C              ATTEMPT.    NOTE   THAT  IF  SEVERAL  POINTS
C              COINCIDE, IT IS MUCH MORE EFFICIENT TO  HAVE
C              THEM ADJACENT IN XPOINT AND YPOINT ARRAYS IF
C              PIN  MAP  OPTION  IS  USED.   FOLLOWING  ARE
C              EXAMPLES OF SIZES OF PIN GROUPS POSSIBLE FOR
C              VARIOUS VALUES OF KONECT.
C
C               KONECT=-2  KONECT=-3  KONECT=-4  KONECT=-5
C
C                                                555555555
C                                      4444444   544444445
C                            33333     4333334   543333345
C                  222       32223     4322234   543222345
C                  212       32123     4321234   543212345
C                  222       32223     4322234   543222345
C                            33333     4333334   543333345
C                                      4444444   544444445
C                                                555555555
C
C            = -1,  STORE  POINTS  HAVING  COORDINATES   IN
C              XPOINT   AND   YPOINT  ARRAYS  FOR  PLOTTING
C              (EITHER  BY  CURRENT  CALL  TO   DAPLAT   IF
C              IPLOT.GE.0  OR  BY SUBSEQUENT CALL TO DAPLAT
C              IF IPLOT.NE.0).  IF LETTER  IS IN   RANGE  1
C              THROUGH   26,   AND   IF  THERE  ALREADY  IS
C              CHARACTER OTHER THAN SPACE  OR  ASTERISK  AT
C              LOCATION   REPRESENTING  POINT,  THEN  PLACE
C              AMPERSAND AT LOCATION INSTEAD.
C            = 0, STORE POINTS HAVING COORDINATES IN XPOINT
C              AND  YPOINT ARRAYS FOR PLOTTING, AND CONNECT
C              THESE WITH  LINES  FORMED  FROM  NONDOMINANT
C              ASTERISKS.   IF SOME OTHER CHARACTER ALREADY
C              IS IN PLOT, OR IS LATER  ADDED  TO  PLOT  AT
C              LOCATIONS   ALONG   LINE,  THEN  THIS  OTHER
C              CHARACTER IS SEEN INSTEAD OF ASTERISK.
C            = 1 THRU 26, CONNECT POINTS WITH LINES  FORMED
C              OF ALPHABETIC LETTER WHICH HAS KONECT AS ITS
C              SERIAL NUMBER IN ALPHABET.
C            = 27, SAME AS KONECT=0, EXCEPT THAT  ASTERISKS
C              ARE  DOMINANT OVER ALL OTHER CHARACTERS.  IF
C              SOME OTHER CHARACTER ALREADY IS IN PLOT,  OR
C              IS  LATER  ADDED  TO PLOT AT LOCATIONS ALONG
C              LINE, THEN IT IS ASTERISK WHICH IS SEEN.
C     XPOINT = THE ARRAY OF X (HORIZONTAL)  COORDINATES  OF
C              THE DATA POINTS TO BE PLOTTED.
C     YPOINT = THE ARRAY OF Y (VERTICAL) COORDINATES OF THE
C              DATA POINTS TO BE PLOTTED.
C     MINSUB = THE SUBSCRIPT IN XPOINT AND YPOINT ARRAYS OF
C              THE  COORDINATES  OF  THE  FIRST POINT TO BE
C              PLOTTED
C     MAXSUB = THE SUBSCRIPT IN XPOINT AND YPOINT ARRAYS OF
C              THE  COORDINATES  OF  THE  FINAL POINT TO BE
C              PLOTTED
C     XLEFT  = THE HORIZONTAL DATA COORDINATE TO BE  PLACED
C              AT  THE  LEFT  EDGE  OF  THE PLOT.  ONLY THE
C              PORTION  OF  THE  CURVE  INSIDE  THE  WINDOW
C              DEFINED  BY XLEFT, YLOWER, XRIGHT AND YUPPER
C              WILL BE  SHOWN  IN  THE  PLOT.   IF  A  LINE
C              SEGMENT  CROSSES  THE WINDOW, THE PORTION OF
C              THE LINE SEGMENT WHICH IS OUTSIDE THE WINDOW
C              WILL   NOT   BE   REPRESENTED.    THE   DATA
C              COORDINATES CAN EITHER INCREASE OR  DECREASE
C              FROM  LEFT  TO  RIGHT OR FROM BOTTOM TO TOP.
C              IF MULTIPLE CURVES ARE BEING SUPERIMPOSED ON
C              A  SINGLE PLOT, THE CURVES NEED NOT ALL HAVE
C              THE SAME DATA  COORDINATE  LIMITS,  HOWEVER,
C              THE  SCALE  NUMBERS  ON THE PLOT ITSELF WILL
C              CORRESPOND TO THE DATA COORDINATE LIMITS  OF
C              THE FINAL CURVE.
C     YLOWER = THE VERTICAL DATA COORDINATE TO BE PLACED AT
C              THE LOWER EDGE OF THE PLOT
C     XRIGHT = THE HORIZONTAL DATA COORDINATE TO BE  PLACED
C              AT THE RIGHT EDGE OF THE PLOT
C     YUPPER = THE VERTICAL DATA COORDINATE TO BE PLACED AT
C              THE UPPER EDGE OF THE PLOT
C
C     THE FOLLOWING ARGUMENTS ARE  IGNORED UNLESS A PLOT IS
C     GENERATED BY THE CURRENT CALL TO DAPLAT
C
C     IGRID  = 0, IF THE PLOT IS GENERATED,  THE PLOT  WILL
C              SHOW  AN  INTERNAL GRID.  THIS INTERNAL GRID
C              WILL  BE  RULED  VERTICALLY   EVERY   MSHWID
C              CHARACTERS  ACROSS THE WIDTH OF THE PLOT AND
C              WILL  BE  RULED  HORIZONTALLY  EVERY  MSHHIH
C              LINES ACROSS THE HEIGHT OF THE PLOT.
C            = 1, IF THE PLOT IS GENERATED,  THE PLOT  WILL
C              SHOW  THE  INTERSECTIONS  OF THE LINES OF AN
C              INTERNAL GRID, BUT WILL NOT SHOW GRID  LINES
C              THEMSELVES.   THE  INTERNAL  GRID  WOULD, IF
C              SHOWN,  HAVE  VERTICAL  LINES  EVERY  MSHWID
C              CHARACTERS  ACROSS THE WIDTH OF THE PLOT AND
C              HORIZONTAL LINES EVERY MSHHIH  LINES  ACROSS
C              THE HEIGHT OF THE PLOT.
C            = 2, IF THE PLOT  IS GENERATED,  THE PLOT WILL
C              NOT   SHOW   AN   INTERNAL  GRID.   HOWEVER,
C              REGARDLESS OF  THE  VALUE  OF  IGRID,  SCALE
C              NUMBERS  WILL BE PRINTED ALONG THE SCALES AT
C              THE  INTERVALS  INDICATED  BY   MSHWID   AND
C              MSHHIH.
C     IEDGE  = PLACE NUMBERS BOTH TO LEFT OF AND BELOW PLOT
C              TO IDENTIFY COORDINATE RANGES.
C            = 1, PLACE NUMBERS TO LEFT OF PLOT, BUT DO NOT
C              PLACE NUMBERS BELOW PLOT.
C            = 2, PLACE NUMBERS BELOW PLOT, BUT NOT TO LEFT
C              OF  PLOT.   UNLESS  PREVENTED  BY  VALUE  OF
C              MARGIN,  THE   DISTANCE   BETWEEN   CARRIAGE
C              CONTROL  CHARACTER IN COLUMN 1 AND LEFT EDGE
C              OF PLOT WILL BE JUST LARGE ENOUGH  TO  ALLOW
C              SCALE  NUMBER IMMEDIATELY BELOW LEFT EDGE OF
C              PLOT.
C            = 3, DO NOT PLACE NUMBERS EITHER TO LEFT OF OR
C              BELOW  PLOT.   UNLESS  PREVENTED BY VALUE OF
C              MARGIN, NO CHARACTERS  WILL  APPEAR  BETWEEN
C              CARRIAGE  CONTROL  CHARACTER IN COLUMN 1 AND
C              LEFT EDGE OF PLOT.
C     MARGIN = MINIMUM   NUMBER   OF   CHARACTERS   BETWEEN
C              CARRIAGE  CONTROL  CHARACTER  IN COLUMN 1 OF
C              OUTPUT AND LEFT EDGE OF PLOT.   THIS  MARGIN
C              INCLUDES  LEFT  SCALE  NUMBERS AND SPACES TO
C              THEIR LEFT.
C     MSHWID = WIDTH OF  THE GRID  DIVISIONS  STATED AS THE
C              NUMBER OF COLUMNS OF CHARACTERS.   MSHWID=10
C              WOULD GIVE THE  VERTICAL GRID LINES EVERY 10
C              CHARACTERS  ACROSS  THE  WIDTH  OF THE  PLOT
C              AREA.
C            = 0, USE THE LAST NONZERO  VALUE SPECIFIED FOR
C              MSHWID AS  THE GRID  DIVISION  WIDTH, OR USE
C              THE VALUE  10 IF A  NONZERO VALUE  OF MSHWID
C              HAS NOT BEEN SPECIFIED BY A PREVIOUS CALL TO
C              THIS ROUTINE.
C     MSHHIH = HEIGHT OF  THE GRID DIVISIONS  STATED AS THE
C              NUMBER OF  LINES.   MSHHIH=5 WOULD  GIVE THE
C              HORIZONTAL GRID  LINES EVERY 5  LINES ACROSS
C              THE HEIGHT OF THE PLOT AREA.
C            = 0, USE THE LAST  NONZERO VALUE SPECIFIED FOR
C              MSHHIH AS  THE GRID DIVISION  HEIGHT, OR USE
C              THE VALUE  5 IF A  NONZERO VALUE  OF  MSHHIH
C              HAS NOT BEEN SPECIFIED BY A PREVIOUS CALL TO
C              THIS ROUTINE.
C     LTROFF = DISTANCE  STATED  AS  NUMBER  OF  CHARACTERS
C              BETWEEN  LEFT  EDGE  OF  PLOT AND LEFT SCALE
C              LINE.  IF LTROFF=0,  THEN  LEFT  SCALE  LINE
C              WILL BE AT LEFT EDGE OF PLOT.
C     LINOFF = DISTANCE STATED AS NUMBER OF  LINES  BETWEEN
C              LOWER  EDGE  OF THE PLOT AND THE LOWER SCALE
C              LINE.  IF LINOFF=0, THEN  LOWER  SCALE  LINE
C              WILL BE AT LOWER EDGE OF PLOT.
C     LINPRT = -1, THE PLOT IS NOT  TO INCLUDE ANY CARRIAGE
C              CONTROL CHARACTER AT LEFT END OF EACH LINE.
C            = 0, THE PLOT WILL BE VIEWED  BY THE USER ON A
C              TERMINAL,  EITHER TYPED DIRECTLY  WITH IDISK
C              BEING  GIVEN THE  TERMINAL  UNIT  NUMBER, OR
C              TYPED  BY THE  USER AFTER  THIS ROUTINE  HAS
C              WRITTEN  THE PLOT  INTO A  FILE ON  THE UNIT
C              THE NUMBER OF  WHICH IS CONTAINED  IN IDISK.
C              A BLANK  OR SPACE  WILL BE USED  AS CARRIAGE
C              CONTROL  CHARACTER  TO GIVE  SINGLE SPACING.
C            = 1,  THE PLOT  WILL BE  PRINTED  ON THE  LINE
C              PRINTER  BY THE USER  AFTER THE  PROGRAM HAS
C              WRITTEN THE  PLOT INTO A FILE.   AN ASTERISK
C              WILL BE USED  AS CARRIAGE  CONTROL CHARACTER
C              TO GIVE SINGLE  SPACING WITH  SUPPRESSION OF
C              SKIPPING EXTRA LINES AT THE PAGE BOUNDARIES.
C              ON THE PDP-10,  AN ASTERISK AS  THE CARRIAGE
C              CONTROL CHARACTER GIVES  OVERPRINTING ON THE
C              TERMINAL AS OPPOSED TO SINGLE SPACING.
C     IDISK  = THE UNIT NUMBER OF THE DEVICE ONTO WHICH THE
C              PLOTS  ARE TO BE WRITTEN.  THIS ROUTINE WILL
C              ONLY  GENERATE  THE   PLOT.    IT   IS   THE
C              RESPONSIBLITY OF THE CALLING PROGRAM TO OPEN
C              THE OUTPUT FILE AND TO WRITE  THE  CAPTIONS,
C              THE FORM FEEDS AND/OR  THE SEPARATING LINES.
C              IDISK SHOULD  ALWAYS BE  GIVEN  A LEGAL UNIT
C              NUMBER SINCE DAPLAT WILL GENERATE THE STORED
C              PLOT, IF ANY,  USING THE NEW  VALUE OF IDISK
C              BEFORE STORING THE NEW CURVE IF THE NEW PLOT
C              SIZE  DIFFERS  FROM THAT  USED TO  STORE THE
C              PREVIOUS CURVES EVEN IF IPLOT=-1.
C
C     FOLLOWING ARGUMENT IS USED BOTH FOR INPUT AND OUTPUT.
C
C     IRESET = SHOULD BE INPUT GREATER  THAN ZERO THE FIRST
C              TIME THIS ROUTINE IS CALLED.  IRESET IS THEN
C              RETURNED SET TO ZERO  AND SHOULD RETAIN THIS
C              VALUE  FOR  ALL  SUBSEQUENT  CALLS  TO  THIS
C              ROUTINE.
C            = 0, CHARACTER TEMPLATE AND PLOT STORAGE  HAVE
C              ALREADY BEEN INITIALIZED.
C            = 1, INITIALIZE CHARACTER TEMPLATE AND ALL  OF
C              PLOT STORAGE.
C            = 2, INITIALIZE  CHARACTER  TEMPLATE  AND  ALL
C              EXCEPT FIRST 3 LOCATIONS IN PLOT STORAGE.
C            = 3, INITIALIZE CHARACTER TEMPLATE.
C            = 4, INITIALIZE ALL OF PLOT STORAGE.
C            = 5, INITIALIZE ALL  OF  PLOT  STORAGE  EXCEPT
C              FIRST 3 LOCATIONS.
C
C     THE FOLLOWING ARGUMENTS ARE RETURNED AS OUTPUT
C
C     LTRERR = RETURNED  CONTAINING NUMBER  OF POINTS WHICH
C              WERE OUTSIDE THE CURRENT PLOT.
C     LINERR = RETURNED CONTAINING  NUMBER OF LINE SEGMENTS
C              WHICH WERE  COMPLETELY  OUTSIDE  THE CURRENT
C              PLOT.   ALSO CONTAINS  NUMBER OF POINTS IN A
C              PIN MAP  WHICH WERE  NOT SHOWN  DUE TO THERE
C              BEING NO EMPTY  LOCATION WITHIN  THE ALLOWED
C              DISTANCE.
C
C
C     AS AN  EXAMPLE  OF THE  USAGE  OF THIS  ROUTINE,  THE
C     FOLLOWING PROGRAM WAS USED TO GENERATE THE PLOT SHOWN
C     BELOW THE PROGRAM (ALONG WITH 2 NOT SHOWN).
C
C      DIMENSION XPOINT(10),YPOINT(10)
C      DATA XPOINT/0. ,1. ,2. ,3. ,4. ,0. ,1. ,2. ,3. ,4. /
C      DATA YPOINT/1. ,1.5,2.5,2.5,1.5,2. ,2.3,3. ,2.5,2. /
C      DATA IRESET,IDISK/1,1/
C      DO 2 JGRID=1,3
C      IGRID=JGRID-1
C      WRITE(IDISK,1)IGRID
C    1 FORMAT(7H IGRID=,I2)
CC
CC  IPLOT=-1 MAXWID=41 MAXHIH=16 LETTER=1  KONECT=2
CC MINSUB=1  MAXSUB=5   XLEFT=0  YLOWER=.5 XRIGHT=4
CC YUPPER=3.5 IEDGE=0  MARGIN=0  MSHWID=0  MSHHIH=0LTROFF=0
CC LINOFF=0  LINPRT=1
C      CALL DAPLAT(-1,41,16,1,2,
C     1XPOINT,YPOINT,1,5,0.,.5,4.,
C     23.5,IGRID,0,0,0,0,0,
C     30,1,IDISK,IRESET,LTRERR,LINERR)
CCHANGING IPLOT=0, LETTER=3, KONECT=4, MINSUB=6, MAXSUB=10
C      CALL DAPLAT(0,41,16,3,4,
C     1XPOINT,YPOINT,6,10,0.,.5,4.,
C     23.5,IGRID,0,0,0,0,0,
C     30,1,IDISK,IRESET,LTRERR,LINERR)
C    2 WRITE(IDISK,3)
C    3 FORMAT(//)
C      STOP
C      END
C
C IGRID= 0
C*      3.5 -+---------+---------+---------+---------+
C*           !         !         !         !         !
C*           !         !         !         !         !
C*           !         !        DCDD       !         !
C*           !         !     DDD !  DDDDD  !         !
C*      2.5 -+---------+-DDDD----ABBBBBBB&&&D--------+
C*           !       DDCD      BB!         !B&DD     !
C*           !  DDDDD  !     BB  !         !  BBDDDD !
C*           CDD       !   BB    !         !    BB  DC
C*           !         ! BB      !         !      BB !
C*      1.5 -+--------BAB--------+---------+--------BA
C*           !     BBB !         !         !         !
C*           ! BBBB    !         !         !         !
C*           AB        !         !         !         !
C*           !         !         !         !         !
C*      0.5 -+---------+---------+---------+---------+
C*           !         !         !         !         !
C*           0         1         2         3         4
C
C     AS SUPPLIED, DAPLAT CONTAINS A  STORAGE  ARRAY  LARGE
C     ENOUGH TO HOLD 5151 CHARACTERS, THIS BEING THE NUMBER
C     OF CHARACTERS NEEDED FOR A PLOT OF THE  DEFAULT  SIZE
C     OF  51  LINES  EACH  OF  101  CHARACTERS.   THIS PLOT
C     STORAGE   IS   CONTAINED   IN   THE   LABELED   BLOCK
C     COMMON/FASPA/  WHICH  MUST CONTAIN AT LEAST  20 WORDS
C     MORE THAN THE WORDS  NEEDED  TO  STORE  MAXWID*MAXHIH
C     CHARACTERS, SIX CHARACTERS BEING HELD IN THE RIGHT 30
C     BITS  OF  EACH  WORD.    THE   20   ADDITIONAL  WORDS
C     STORE  INFORMATION  ABOUT PLOT SIZE AND SCALING.  THE
C     LABELED COMMON BLOCK CAN BE MADE LARGER THAN THE  879
C     LOCATIONS  (CALCULATED  AS 20+(((51*101)+5)/6) WORDS)
C     PROVIDED IN THIS ROUTINE IF THE LABELED COMMON  BLOCK
C     IS LOADED FIRST BY THE USER'S PROGRAM, IF THE  USER'S
C     PROGRAM  DEFINES  THE  1ST  3 LOCATIONS IN THIS ARRAY
C     BEFORE THIS ROUTINE IS FIRST CALLED,  AND  IF  IRESET
C     HAS  EITHER OF THE VALUES 2 OR 5 WHEN THIS ROUTINE IS
C     FIRST CALLED.  THE 3 LOCATIONS WHICH MUST BE  DEFINED
C     IN COMMON/FASPA/ ARE DEFINED AS FOLLOW
C     KDMNSN = 15 LESS THAN  THE  NUMBER  OF  LOCATIONS  IN
C              COMMON/FASPA/
C     LRGBYT = NUMBER   OF   DIFFERENT   CHARACTER   CODES,
C              INCLUDING  0  FOR BLANK AND 1 FOR AMPERSAND,
C              THAT MUST BE STORED  IN  EACH  BYTE  OF  THE
C              ARRAY  WHICH  IS DIMENSIONED AT KDMNSN.  THE
C              MASTER ARRAY MUST BE DIMENSIONED TO AT LEAST
C              LRGBYT-1.
C     MAXBYT = NUMBER OF BYTES WHICH CAN  BE  STORED  IN  A
C              SINGLE  COMPUTER  WORD.   (LRGBYT**MAXBYT)-1
C              MUST BE SMALL ENOUGH TO BE REPRESENTED AS  A
C              POSITIVE  NUMBER.   THE ISHIFT ARRAY MUST BE
C              DIMENSIONED TO AT LEAST MAXBYT.
C     IF A PLOT IS REQUESTED WHICH IS LARGER  THAN  CAN  BE
C     HELD IN THE LABELED  COMMON BLOCK, THEN THE EFFECTIVE
C     VALUE OF MAXHIH IS REDUCED SO THAT THE PLOT WILL FIT.
C
C     THE LABELED COMMON BLOCK COMMON/FASPA/  CONTAINS  ALL
C     THE  INFORMATION NECESSARY TO GENERATE THE PLOT, WITH
C     THE EXCEPTION OF THE ARGUMENTS LINPRT AND  IDISK  AND
C     THE  CHARACTER  LIST.   IF  A  LATER EXECUTION OF THE
C     PROGRAM IS TO ADD TO THE CURRENT PLOT,  THE  CONTENTS
C     OF  THE  LABELED  COMMON  BLOCK CAN BE WRITTEN INTO A
C     BINARY FILE, THEN BE RESTORED  WHEN  NEEDED  PROVIDED
C     THAT  DAPLAT  HAS BEEN CALLED WITH A NONZERO VALUE OF
C     IPLOT WHICH WOULD NOT CLEAR THE PLOT STORAGE.
C
C     COMMON USED TO STORE THE INTERMEDIATE PLOTS
      COMMON/FASPA/ KDMNSN,LRGBYT,MAXBYT,JRESET,KONTNT,
     1 KWIDE, KHIGH,XFIRST,YFIRST,XFINAL,YFINAL, MGRID,
     2 MEDGE, MMRGN, IWIDE, IHIGH, IOVER,   IUP,  IERR,
     3  JERR,ISTORE(859)
C
C     COMMON CONTAINING CHARACTERS CORRESPONDING TO VALUES
      COMMON/FASPB/LTRALL(35)
C
C     COMMON CONTAINING DOMINANCE RULES
      COMMON/FASPC/MASTER(29)
C
C     COMMON CONTAINING DESCRIPTION OF BYTE PACKING
      COMMON/FASPD/ISHIFT(22)
C
C     COMMON CONTAINING PRINT BUFFER FOR 1 LINE
      COMMON/FASPE/LTRBUF(146)
C
C     NONARRAY ITEMS IN COMMON/FASPB/
      EQUIVALENCE (JSPACE,LTRALL(1)),(ISTAR ,LTRALL(2)),
     1            (IVRTCL,LTRALL(3)),(IHRZNT,LTRALL(4)),
     2            (ICORNR,LTRALL(5)),(ISPACE,LTRALL(6))
C
C     ARRAYS NOT IN COMMON
      DIMENSION XPOINT(MAXSUB),YPOINT(MAXSUB),LTRBGN(35)
C
C     NUMBER OF CHARACTERS IN COMMON/FASPE/ BUFFER
      DATA MAXBFR/146/
C
C     INITIAL DEFINITION OF CHARACTERS IN COMMON/FASPB/
      DATA LTRBGN/1H ,1H*,1H!,1H-,1H+,1H ,1H&,1H*,1HA,1HB,
     1            1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,
     2            1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,
     3            1HW,1HX,1HY,1HZ,1H*/
      DATA KSPACE/1H /
C
C     ****************************************
C     *                                      *
C     *  FIND SIZE AND CHECK IF HAS CHANGED  *
C     *                                      *
C     ****************************************
C
      IF(IRESET.NE.0)GO TO 1
      IF(JRESET.EQ.999)GO TO 9
    1 IF(IRESET.NE.3)GO TO 2
      IF(JRESET.EQ.999)GO TO 5
    2 JRESET=999
      IF(IRESET.EQ.2)GO TO 3
      IF(IRESET.EQ.5)GO TO 3
C
C     INITIALIZE FIRST 3 LOCATIONS IN PLOT STORAGE
      KDMNSN=859
      LRGBYT=30
      MAXBYT=6
C
C     INITIALIZE REST OF PLOT STORAGE
    3 IWIDE=10
      IHIGH=5
      KWIDE=MAXBFR-15
      IF(KWIDE.GT.101)KWIDE=101
      KHIGH=51
      KONTNT=0
      DO 4 I=1,KDMNSN
    4 ISTORE(I)=0
      IF(IRESET.GE.4)GO TO 8
C
C     INITIALIZE CHARACTERS AND DOMINANCE RULES
    5 DO 6 I=1,35
    6 LTRALL(I)=LTRBGN(I)
      MASTER(1)=1
      MASTER(2)=-1
      DO 7 I=3,28
    7 MASTER(I)=0
      MASTER(29)=2
    8 IRESET=0
C
C     ESTABLISH THE SHIFTING ARRAY.  MUST DO EACH TIME
C     SINCE NOT HELD IN COMMON AND USER MIGHT HAVE
C     REESTABLISHED COMMON WITHOUT EVER CALLING DAPLAT.
    9 I=1
      J=1
   10 ISHIFT(I)=J
      IF(I.GE.MAXBYT)GO TO 11
      I=I+1
      J=J*LRGBYT
      GO TO 10
C
C     FIND SIZE REQUESTED FOR THIS PLOT
   11 JWIDE=KWIDE
      IF(MAXWID.GT.0)JWIDE=MAXWID
      IF(JWIDE.GT.(MAXBFR-15))JWIDE=MAXBFR-15
      JHIGH=KHIGH
      IF(MAXHIH.GT.0)JHIGH=MAXHIH
      I=(MAXBYT*KDMNSN)/JWIDE
      IF(JHIGH.GT.I)JHIGH=I
C
C     PLOT CURRENT STORAGE IF NEW SIZE REQUESTED
      IPASS=0
      IF(KONTNT.EQ.0)GO TO 12
      IF(JWIDE.NE.KWIDE)GO TO 40
      IF(JHIGH.NE.KHIGH)GO TO 40
      GO TO 13
C
C     ZERO OUT ERROR COUNTS IF PLOT IS EMPTY
   12 IERR=0
      JERR=0
C
C     GET THE VARIOUS ITEMS NEEDED TO STORE CURVE
   13 XFIRST=XLEFT
      XFINAL=XRIGHT
      YFIRST=YLOWER
      YFINAL=YUPPER
      IF(MSHWID.GT.0)IWIDE=MSHWID
      IF(MSHHIH.GT.0)IHIGH=MSHHIH
      IOVER=LTROFF
      IUP=LINOFF
      MGRID=IGRID
      MEDGE=IEDGE
      MMRGN=MARGIN
      KWIDE=JWIDE
      KHIGH=JHIGH
      WIDE=KWIDE-1
      HIGH=KHIGH-1
      LTRPNT=0
      IF(LETTER.GE.0)LTRPNT=LETTER+2
      IF(LTRPNT.GE.LRGBYT)LTRPNT=LRGBYT-1
      LTRLIN=0
      IF(LTRPNT.GT.0)LTRLIN=KONECT+2
      IF(LTRLIN.GE.LRGBYT)LTRLIN=LRGBYT-1
C
C     **********************
C     *                    *
C     *  STORE THE POINTS  *
C     *                    *
C     **********************
C
      IF(MAXSUB.LT.MINSUB)GO TO 39
      XSCALE=WIDE/(XFINAL-XFIRST)
      YSCALE=HIGH/(YFINAL-YFIRST)
      INSERT=LTRPNT
      KONTNT=1
      KRD=MINSUB
      MAXSQR=1
   14 IX=1.5+(XSCALE*(XPOINT(KRD)-XFIRST))
      IY=1.5+HIGH-(YSCALE*(YPOINT(KRD)-YFIRST))
      IF(IPASS.GT.0)GO TO 16
C
C     IF PLOT POINTS, CHECK IF POINT IS INSIDE WINDOW
      IF(IX.LE.0)GO TO 15
      IF(IX.GT.KWIDE)GO TO 15
      IF(IY.LE.0)GO TO 15
      IF(IY.GT.KHIGH)GO TO 15
      IF(KONECT.GE.-1)GO TO 29
      GO TO 22
   15 IERR=IERR+1
      GO TO 38
C
C     IF PLOT LINES, FIND PART OF LINE INSIDE WINDOW
   16 NEWX=IX
      NEWY=IY
      CALL PLTCUT(IPLCUT,IX,IY,LASTX,LASTY,1,1,KWIDE,KHIGH)
      IF(IPLCUT.NE.0)GO TO 17
      JERR=JERR+1
      GO TO 37
C
C     PROVIDE FOR INTEGER ROUNDING ALONG LINE SEGMENT
   17 IF(IY.GE.LASTY)GO TO 18
      I=IX
      IX=LASTX
      LASTX=I
      I=IY
      IY=LASTY
      LASTY=I
   18 MOVEX=IX-LASTX
      MOVEY=IY-LASTY
      LAGX=0
      LAGY=0
      IUSED=0
      IF(MOVEX.NE.0)GO TO 19
      IF(MOVEY.NE.0)GO TO 20
      MULT=0
      GO TO 29
   19 MULT=MOVEX
      IF(MULT.LT.0)MULT=-MULT
      IF(MOVEY.EQ.0)GO TO 21
      LAGX=MOVEY/2
      LAGY=MULT/2
      IF(MULT.GT.MOVEY)GO TO 21
   20 MULT=MOVEY
C
C     GET NEXT POINT ALONG THE LINE SEGMENT
   21 IF(MOVEX.LT.0)IX=LASTX-((LAGX-(IUSED*MOVEX))/MULT)
      IF(MOVEX.GT.0)IX=LASTX+((LAGX+(IUSED*MOVEX))/MULT)
      IY=LASTY+(((IUSED*MOVEY)+LAGY)/MULT)
      GO TO 29
C
C     TEST IF ALREADY WITHIN PROPER SET OF TERRACES
   22 IF(MAXSQR.GT.0)GO TO 23
      IF(KEEPX.NE.IX)GO TO 23
      IF(KEEPY.NE.IY)GO TO 23
      IF(MAXSQR.EQ.0)GO TO 28
      IX=LASTX
      IY=LASTY
      GO TO 25
C
C     PREPARE FOR TERRACE ZERO
   23 MAXSQR=KONECT
      KEEPX=IX
      KEEPY=IY
      MOVEX=0
      MOVEY=1
      MAXPIN=0
      KNTPIN=1
      IF(LETTER.NE.-1)GO TO 24
C
C     IF ERASING, MOVE DIRECTLY TO OUTER TERRACE
      MOVEY=0
      MOVEX=1
      MAXSQR=-1
      MAXPIN=-KONECT-KONECT-2
      KNTPIN=MAXPIN+1
      IX=IX+KONECT+1
      IY=IY-KONECT-1
C
C     TEST IF POINT ON TERRACE IS AVAILABLE FOR USE
   24 KNTPIN=KNTPIN-1
      IF(IX.LE.0)GO TO 25
      IF(IX.GT.KWIDE)GO TO 25
      IF(IY.LE.0)GO TO 25
      IF(IY.LE.KHIGH)GO TO 29
   25 IF(KNTPIN.GT.0)GO TO 26
C
C     TURN AT CORNER OF TERRACE
      I=MOVEX
      MOVEX=MOVEY
      MOVEY=-I
      IF(MOVEX.GT.0)GO TO 27
      KNTPIN=MAXPIN
C
C     TRAVEL ALONG SIDE OF TERRACE
   26 IX=IX+MOVEX
      IY=IY+MOVEY
      GO TO 24
C
C     EXPAND OUT TO NEXT TERRACE
   27 MAXSQR=MAXSQR+1
      IF(MAXSQR.GE.0)GO TO 28
      MAXPIN=MAXPIN+2
      IY=IY+1
      KNTPIN=MAXPIN
      GO TO 24
   28 IF(INSERT.NE.0)JERR=JERR+1
      GO TO 38
C
C     CALCULATE WORD COUNT AND BYTE COUNT IN WORD
   29 IBYTE=IX-1+(KWIDE*(IY-1))
      IWORD=IBYTE/MAXBYT
      IBYTE=IBYTE-(MAXBYT*IWORD)+1
      IWORD=IWORD+1
C
C     GET CURRENT CONTENTS OF BYTE.
      IRIGHT=ISTORE(IWORD)
      IF(IBYTE.GE.MAXBYT)GO TO 30
      ILEFT=IRIGHT/ISHIFT(IBYTE+1)
      IRIGHT=IRIGHT-(ISHIFT(IBYTE+1)*ILEFT)
   30 KOMPAR=IRIGHT/ISHIFT(IBYTE)
      I=INSERT
      IF(KONECT.GE.-1)GO TO 32
C
C     DECIDE CHARACTER TO INSERT ON TERRACE
      IF(INSERT.GT.0)GO TO 31
      IF(KOMPAR.EQ.0)GO TO 25
      GO TO 35
   31 IF(KOMPAR.EQ.0)GO TO 35
      IF(MASTER(KOMPAR).LT.MASTER(INSERT))GO TO 35
      GO TO 25
C
C     DECIDE CHARACTER TO INSERT AT POINT OR LINE SEGMENT
   32 IF(KOMPAR.EQ.INSERT)GO TO 36
      IF(KOMPAR.EQ.0)GO TO 35
      IF(INSERT.EQ.0)GO TO 35
      IF(IPASS.GT.0)GO TO 33
      IF(KOMPAR.EQ.LTRLIN)GO TO 35
      GO TO 34
   33 IF(KOMPAR.EQ.LTRPNT)GO TO 36
   34 IF(MASTER(KOMPAR).GT.MASTER(INSERT))GO TO 36
      IF(MASTER(KOMPAR).EQ.MASTER(INSERT))I=1
C
C     INSERT THE NEW CHARACTER
   35 IRIGHT=IRIGHT-(ISHIFT(IBYTE)*KOMPAR)
      ISTORE(IWORD)=(I*ISHIFT(IBYTE))+IRIGHT
      IF(IBYTE.LT.MAXBYT)ISTORE(IWORD)=
     1ISTORE(IWORD)+(ILEFT*ISHIFT(IBYTE+1))
C
C     IF CLEARING OUT A SET OF TERRACES, RETURN FOR NEXT
      IF(KONECT.GE.-1)GO TO 36
      LASTX=IX
      LASTY=IY
      IF(INSERT.EQ.0)GO TO 25
      GO TO 38
C
C     CHECK IF LINE SEGMENT IS DONE
   36 IF(IPASS.LE.0)GO TO 38
      IUSED=IUSED+1
      IF(IUSED.LE.MULT)GO TO 21
C
C     NEW END OF THIS LINE BECOMES OLD END FOR NEXT LINE
   37 LASTX=NEWX
      LASTY=NEWY
   38 KRD=KRD+1
      IF(KRD.LE.MAXSUB)GO TO 14
C
C     DONE WITH THIS PASS, CHECK IF MUST MAKE LINE SEGMENTS
      IF(IPASS.GT.0)GO TO 39
      IPASS=1
      IF(KONECT.LT.0)GO TO 39
      LASTX=1.5+(XSCALE*(XPOINT(MINSUB)-XFIRST))
      LASTY=1.5+HIGH-(YSCALE*(YPOINT(MINSUB)-YFIRST))
      INSERT=LTRLIN
      KRD=MINSUB
      GO TO 38
C
C     ************************
C     *                      *
C     *  CONSTRUCT THE PLOT  *
C     *                      *
C     ************************
C
   39 LTRERR=IERR
      LINERR=JERR
      IF(IPLOT.LT.0)GO TO 93
      IF(KONTNT.EQ.0)GO TO 93
      IPASS=1
      IF(IPLOT.GT.0)GO TO 41
C
C     MARK THAT PLOT AREA IS EMPTY
   40 KONTNT=0
C
C     GET SWITCHES SET BY IGRID
C     JGRID  = ONES DIGIT
C     KGRID  = TENS DIGIT
C     LGRID  = HUNDREDS DIGIT
   41 LGRID=MGRID
      IF(LGRID.LT.0)LGRID=-LGRID-1
      KGRID=LGRID/10
      JGRID=LGRID-10*KGRID
      LGRID=LGRID/100
      KGRID=KGRID-10*LGRID
C
C     GET SWITCHES SET BY IEDGE
C     JEDGE  = ONES DIGIT
C     KEDGE  = TENS DIGIT
C     LEDGE  = HUNDREDS DIGIT
      LEDGE=MEDGE
      IF(LEDGE.LT.0)LEDGE=-LEDGE-1
      KEDGE=LEDGE/10
      JEDGE=LEDGE-10*KEDGE
      LEDGE=LEDGE/100
      KEDGE=KEDGE-10*LEDGE
C
C     DETERMINE LOCATIONS OF LEFT AND RIGHT PLOT EDGES
      IWIDTH=10
      IF(IWIDTH.GT.IWIDE)IWIDTH=IWIDE
      JWIDTH=IWIDTH/2
      IF(JEDGE.LE.1)GO TO 42
      IFIRST=1
      IF(JEDGE.EQ.2)IFIRST=JWIDTH+1
      GO TO 43
   42 IFIRST=12
   43 IF(IFIRST.LE.MMRGN)IFIRST=MMRGN+1
C     THIS LINE PROTECT AGAINST OVERRUN OF BUFFER
C     TEST IS AGAINST LENGTH OF BUFFER MINUS 4 CHARACTERS
C     WHICH COULD APPEAR RIGHT OF PLOT IN SCALE NUMBERS
      IF(IFIRST.GT.(MAXBFR-3-KWIDE))IFIRST=MAXBFR-3-KWIDE
      LEAVE=IFIRST-3
      IFINAL=IFIRST+KWIDE-1
C
C     DETERMINE LOCATIONS OF LEFT AND RIGHT GRID LINES
      IF(IWIDE.GT.KWIDE)GO TO 48
      LOSSX=IOVER
      IF(LOSSX.LE.-KWIDE)GO TO 48
      IF(LOSSX.GE.KWIDE)GO TO 48
   44 IF(LOSSX.GE.0)GO TO 45
      LOSSX=LOSSX+IWIDE
      GO TO 44
   45 IF(LOSSX.LT.IWIDE)GO TO 46
      LOSSX=LOSSX-IWIDE
      GO TO 45
   46 LTRLFT=IFIRST+LOSSX
      LTRRIT=LTRLFT
   47 LTRRIT=LTRRIT+IWIDE
      IF(LTRRIT.LE.IFINAL)GO TO 47
      LTRRIT=LTRRIT-IWIDE
      GO TO 49
   48 LTRLFT=IFIRST-1
      LTRRIT=IFINAL+1
      LOSSX=KWIDE
      IF(JEDGE.EQ.0)JEDGE=1
      IF(JEDGE.EQ.2)JEDGE=3
   49 IF(IHIGH.GT.KHIGH)GO TO 54
      LOSSY=IUP
      IF(LOSSY.LE.-KHIGH)GO TO 54
      IF(LOSSY.GE.KHIGH)GO TO 54
   50 IF(LOSSY.GE.0)GO TO 51
      LOSSY=LOSSY+IHIGH
      GO TO 50
   51 IF(LOSSY.LT.IHIGH)GO TO 52
      LOSSY=LOSSY-IHIGH
      GO TO 51
   52 LINLOW=KHIGH-LOSSY
      LOSSY=LINLOW-1
   53 LOSSY=LOSSY-IHIGH
      IF(LOSSY.GE.0)GO TO 53
      LOSSY=IHIGH+LOSSY
      LINHIH=LOSSY+1
      GO TO 55
   54 LINHIH=0
      LINLOW=KHIGH+1
      LOSSY=KHIGH
C
C     RESET LIMITS WHICH PREVENT CERTAIN BORDER LINES
   55 IF(JGRID.EQ.0)GO TO 56
      IF(KGRID.LE.1)GO TO 57
   56 LTRLFT=IFIRST
      IF(KEDGE.GT.1)LTRLFT=LTRLFT-1
   57 IF(JGRID.EQ.0)GO TO 58
      IF(KGRID.EQ.0)GO TO 59
      IF(KGRID.EQ.2)GO TO 59
   58 LTRRIT=IFINAL
      IF(KEDGE.EQ.0)GO TO 59
      IF(KEDGE.NE.2)LTRRIT=LTRRIT+1
   59 IF(JGRID.EQ.0)GO TO 60
      IF(LGRID.LE.1)GO TO 61
   60 LINLOW=KHIGH
      IF(LEDGE.GT.1)LINLOW=LINLOW+1
   61 IF(JGRID.EQ.0)GO TO 62
      IF(LGRID.EQ.0)GO TO 63
      IF(LGRID.EQ.2)GO TO 63
   62 LINHIH=1
      IF(LEDGE.EQ.0)GO TO 63
      IF(LEDGE.NE.2)LINHIH=0
   63 JGRID=JGRID-1
C
C     FLOATING POINT WIDTH OF PLOT
      WIDE=KWIDE-1
      HIGH=KHIGH-1
C
C     DEFINE HEIGHT OF REGION CONSIDERED TO CONTAIN ZERO
      IF(KHIGH.LE.1)GO TO 64
      ZERO=0.25*((YFINAL-YFIRST)/HIGH)
      IF(ZERO.LT.0.0)ZERO=-ZERO
C
C     DEFINE VALUE IN CASE PLOT IS ONLY 1 LINE HIGH
   64 VALUE=YFINAL
C
C     SET CARRIAGE CONTROL CHARACTER
      KONTRL=JSPACE
      IF(LINPRT.GT.0)KONTRL=ISTAR
C
C     DEFINE THE STARTING INDEXES
C     KNTLIN = CURRENT LINE NUMBER
C     KNTWRD = SUBSCRIPT IN STORAGE ARRAY OF WORD BEING
C              UNPACKED
C     KNTBYT = BYTE COUNT IN THE WORD BEING UNPACKED
C     LOSSX AND LOSSY ARE USED TO PLACE GRIDS ON PLOT
C     LOSSX  = FROM NOW IS INITIAL VALUE OF COLUMN COUNT
C              RELATIVE TO NEXT COLUMN TO BEAR GRID LINE
C     LOSSY  = FROM NOW IS VALUE OF LINE COUNT RELATIVE
C              TO NEXT LINE TO BEAR A GRID LINE.
      KNTLIN=1
      KNTWRD=0
      KNTBYT=MAXBYT
C
C     HIDDEN SWITCH FOR TIME SERIES PLOT CONSTRUCTION
C
C     IEDGE.LT.0 DO NOT PLOT  BOTTOM LINE OF PLOT.  DO  NOT
C                PLOT  SCALE NUMBERS   BELOW PLOT.   BOTTOM
C                LINE IS ROLLED  INTO  TOP LINE AND REST OF
C                PLOT STORAGE IS LEFT EMPTY.
C
C     IKNTBY = BYTE INTO WHICH  TO SAVE NEXT  UNPACKED BYTE
C              IF ROLLING LAST LINE INTO FIRST
C     IKNTWR = WORD INTO WHICH  TO SAVE NEXT  UNPACKED BYTE
C              IF ROLLING LAST LINE INTO FIRST
C
      IF(MGRID.GE.0)GO TO 65
      IKNTWR=0
      IKNTBY=MAXBYT
      KONTNT=0
C
C     CONSTANTS RESET AT START OF EACH LINE
   65 KNTLTR=IFIRST
      KNTCLM=LOSSX
      IF(LOSSY.NE.0)GO TO 67
      IF(JEDGE.GT.1)GO TO 67
C
C     CONSTRUCT SCALE NUMBER ON LINE WHICH CAN BE GRID
      IF(KNTLIN.LE.1)GO TO 66
      VALUE=(YFINAL*(FLOAT(KHIGH-KNTLIN)/HIGH))+
     1(YFIRST*(FLOAT(KNTLIN-1)/HIGH))
      IF(VALUE.GE.ZERO)GO TO 66
      IF(VALUE.GT.(-ZERO))VALUE=0.0
   66 CALL DARITE(VALUE,1,0,0,1,-3,0,LEAVE,-2,7,
     15,5,0,0,4,0,0,-1,0,MAXBFR,LTRBUF,I,KERR)
      IUSED=LEAVE+2
      LTRBUF(LEAVE+1)=KSPACE
      LTRBUF(IUSED)=IHRZNT
      GO TO 69
C
C     FILL SPACE TO LEFT WITH SPACES IF NO SCALE NUMBER
   67 IUSED=1
      I=0
   68 I=I+1
      IF(I.GE.IFIRST)GO TO 69
      LTRBUF(I)=KSPACE
      GO TO 68
C
C     UNPACK NEXT BYTE
   69 KNTBYT=KNTBYT+1
      IF(KNTBYT.LE.MAXBYT)GO TO 70
      KNTWRD=KNTWRD+1
      KNTBYT=1
      IVALUE=ISTORE(KNTWRD)
      IF(KONTNT.EQ.0)ISTORE(KNTWRD)=0
   70 JVALUE=IVALUE
      IVALUE=IVALUE/LRGBYT
      JVALUE=JVALUE-(LRGBYT*IVALUE)
C
C     IF ROLLING LAST LINE INTO FIRST, SAVE BYTE
      IF(MGRID.GE.0)GO TO 72
      IF(KNTLIN.LT.KHIGH)GO TO 72
      IKNTBY=IKNTBY+1
      IF(IKNTBY.LE.MAXBYT)GO TO 71
      IKNTBY=1
      IKNTWR=IKNTWR+1
   71 ISTORE(IKNTWR)=ISTORE(IKNTWR)+(JVALUE*ISHIFT(IKNTBY))
C
C     DECIDE WHAT CHARACTER TO PLACE INTO OUTPUT BUFFER
   72 IF(JVALUE.GT.0)GO TO 79
      IF(KNTLIN.EQ.LINLOW)GO TO 74
      IF(KNTLIN.EQ.LINHIH)GO TO 74
      IF(LOSSY.EQ.0)GO TO 75
      IF(KNTLTR.EQ.LTRLFT)GO TO 73
      IF(KNTLTR.EQ.LTRRIT)GO TO 73
      IF(JGRID.GE.0)GO TO 81
      IF(KNTCLM.GT.0)GO TO 81
   73 LTRBUF(KNTLTR)=IVRTCL
      GO TO 80
   74 IF(KNTLTR.EQ.LTRLFT)GO TO 78
      IF(KNTLTR.EQ.LTRRIT)GO TO 78
      GO TO 76
   75 IF(KNTLTR.EQ.LTRLFT)GO TO 78
      IF(KNTLTR.EQ.LTRRIT)GO TO 78
      IF(JGRID.GE.0)GO TO 77
   76 IF(KNTCLM.LE.0)GO TO 78
      LTRBUF(KNTLTR)=IHRZNT
      GO TO 80
   77 IF(JGRID.GT.0)GO TO 81
      IF(KNTCLM.GT.0)GO TO 81
   78 LTRBUF(KNTLTR)=ICORNR
      GO TO 80
   79 LTRBUF(KNTLTR)=LTRALL(JVALUE+6)
   80 IUSED=KNTLTR
      GO TO 82
   81 LTRBUF(KNTLTR)=ISPACE
   82 IF(KNTCLM.LE.0)KNTCLM=IWIDE
      KNTCLM=KNTCLM-1
      KNTLTR=KNTLTR+1
      IF(KNTLTR.LE.IFINAL)GO TO 69
C
C     OUTPUT THE COMPLETED LINE
      KNTLIN=KNTLIN+1
      IF(KNTLIN.LE.KHIGH)GO TO 83
      IF(MGRID.GE.0)GO TO 83
      KONTNT=1
      GO TO 92
   83 IF(LINPRT.LT.0)WRITE(IDISK,84)(LTRBUF(I),I=1,IUSED)
      IF(LINPRT.GE.0)WRITE(IDISK,84)KONTRL,
     1(LTRBUF(I),I=1,IUSED)
   84 FORMAT(147A1)
      IF(LOSSY.LE.0)LOSSY=IHIGH
      LOSSY=LOSSY-1
      IF(KNTLIN.LE.KHIGH)GO TO 65
C
C     PRINT GRID LINE EXTENSIONS BELOW PLOT
      IF(JEDGE.EQ.1)GO TO 92
      IF(JEDGE.GE.3)GO TO 92
      IF(IWIDE.GT.KWIDE)GO TO 92
      IFIRST=IFIRST+LOSSX
      KNTLTR=0
      I=IFIRST
   85 KNTLTR=KNTLTR+1
      IF(KNTLTR.GE.I)GO TO 86
      LTRBUF(KNTLTR)=KSPACE
      GO TO 85
   86 LTRBUF(KNTLTR)=IVRTCL
      I=I+IWIDE
      IF(I.LE.IFINAL)GO TO 85
      IF(LINPRT.LT.0)WRITE(IDISK,84)(LTRBUF(I),I=1,KNTLTR)
      IF(LINPRT.GE.0)WRITE(IDISK,84)KONTRL,
     1(LTRBUF(I),I=1,KNTLTR)
C
C     PRINT SCALE NUMBERS BELOW GRID LINE EXTENSIONS
      LERR=-1
      MINSIG=5
      IF(MINSIG.GT.(IWIDTH-2))MINSIG=IWIDTH-2
      IF(MINSIG.LE.0)MINSIG=1
      IF(KWIDE.LE.1)GO TO 87
      ZERO=0.25*((XFINAL-XFIRST)/WIDE)
      IF(ZERO.LT.0.0)ZERO=-ZERO
   87 KIND=LERR
      KNTLTR=IFIRST-JWIDTH-1
      I=LOSSX+1
      VALUE=XFIRST
   88 NEED=KNTLTR+IWIDE
      IF(I.LE.1)GO TO 89
      VALUE=(XFIRST*(FLOAT(KWIDE-I)/WIDE))+
     1(XFINAL*(FLOAT(I-1)/WIDE))
      IF(VALUE.GE.ZERO)GO TO 89
      IF(VALUE.GT.(-ZERO))VALUE=0.0
   89 CALL DARITE(VALUE,0,0,KIND,1,-3,0,IWIDTH,-2,-2,
     1MINSIG,5,0,0,4,0,0,-1,KNTLTR,MAXBFR,LTRBUF,KNTOUT,
     2KERR)
      KNTLTR=KNTOUT
      IF(KERR.GT.0)LERR=1
      I=I+IWIDE
      IF(I.GT.KWIDE)GO TO 91
   90 IF(NEED.LE.KNTLTR)GO TO 88
      KNTLTR=KNTLTR+1
      LTRBUF(KNTLTR)=KSPACE
      GO TO 90
   91 IF(LINPRT.LT.0)WRITE(IDISK,84)(LTRBUF(I),I=1,KNTLTR)
      IF(LINPRT.GE.0)WRITE(IDISK,84)KONTRL,
     1(LTRBUF(I),I=1,KNTLTR)
      IF(KIND.NE.LERR)GO TO 87
   92 IF(IPASS.LE.0)GO TO 12
   93 RETURN
C581314532331!&
      END
      SUBROUTINE DAGRID(JSTIFY,MAXWID,XLEFT,XRIGHT,MSHWID,
     1    LTROFF)
C     RENBR(/RATIONALIZE SCALE OF PRINTER PLOT)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     PROPORTIONS OF GRID SUPERIMPOSED UPON  PLOT  AREA  BY
C     DAPLAT  ROUTINE MUST BE SPECIFIED BY CALLING PROGRAM.
C     NUMBERS WHICH  ARE  PRINTED  BESIDE  AND  BELOW  PLOT
C     MERELY  REPRESENT  DATA  UNIT  COORDINATES PLOTTED AT
C     CENTERS OF COLUMNS AND LINES WHICH BEAR  GRID  LINES.
C     RANGE  OF  DATA UNIT COORDINATES REPRESENTED BY THESE
C     SCALES CAN  BE  DIFFICULT  TO  INTERPRET  IF  CALLING
C     PROGRAM   HOLDS   GRID   PROPORTIONS  CONSTANT  WHILE
C     ATTEMPTING TO OBTAIN MAXIMUM RESOLUTION BY  ADJUSTING
C     MINIMUM  AND  MAXIMUM  COORDINATES  TO  SPREAD CURVES
C     ACROSS FULL WIDTH OR HEIGHT OF PLOT.   DAPLAT  CANNOT
C     ITSELF CALCULATE GRID PROPORTIONS WHICH WOULD PRODUCE
C     MINIMUM  NUMBER  OF  NONZERO  DIGITS  IN  EACH  SCALE
C     NUMBER.   IF  PREDETERMINED GRID SPACINGS AND OFFSETS
C     ARE NOT NECESSARY, THEN ROUTINE DAGRID CAN BE  CALLED
C     ONCE  FOR EACH SCALE BEFORE DATA IS PLOTTED TO SELECT
C     GRID PROPORTIONS  AND  TO  EXPAND  COORDINATE  RANGES
C     SLIGHTLY TO GIVE NEATER SCALE NUMBERS.
C
C     JSTIFY = -2, LEFT JUSTIFY LEFT GRID LINE
C            = -1, LEFT JUSTIFY XLEFT
C            = 0, CENTER RANGE
C            = 1, RIGHT JUSTIFY XRIGHT
C            = 2, RIGHT JUSTIFY RIGHT GRID LINE
C     MAXWID = WIDTH (OR HEIGHT) OF PLOT STATED  AS  NUMBER
C              OF COLUMNS (OR LINES).
C     XLEFT  = INPUT CONTAINING DATA UNIT COORDINATE TO  BE
C              REPRESENTED  BY CENTER OF LEFT COLUMN (OR OF
C              LOWER LINE) OF PLOT.
C            = RETURNED  CONTAINING  DATA  UNIT  COORDINATE
C              WHICH  WOULD  GIVE RATIONAL SCALE IF USED AS
C              DATA UNIT COORDINATE REPRESENTED  BY  CENTER
C              OF LEFT COLUMN (OR OF LOWER LINE) OF PLOT.
C     XRIGHT = INPUT CONTAINING DATA UNIT COORDINATE TO  BE
C              REPRESENTED BY CENTER OF RIGHT COLUMN (OR OF
C              UPPER LINE) OF PLOT.
C            = RETURNED  CONTAINING  DATA  UNIT  COORDINATE
C              WHICH  WOULD  GIVE RATIONAL SCALE IF USED AS
C              DATA UNIT COORDINATE REPRESENTED  BY  CENTER
C              OF RIGHT COLUMN (OR OF UPPER LINE) OF PLOT.
C     MSHWID = RETURNED CONTAINING THE GRID DIVISION  WIDTH
C              STATED  AS  THE NUMBER OF COLUMNS (OR HEIGHT
C              STATED AS NUMBER OF LINES).  INPUT VALUE  OF
C              MSHWID  IS  IGNORED.  A LINE SHOULD BE RULED
C              EVERY MSHWID CHARACTERS ACROSS THE WIDTH (OR
C              HEIGHT)  OF THE PLOT.  IF MSHWID IS RETURNED
C              CONTAINING 10, THEN  9  COLUMNS  (OR  LINES)
C              SHOULD APPEAR BETWEEN THE COLUMNS (OR LINES)
C              BEARING GRID LINES.
C            = 0,  RETURNED  IF  THIS  ROUTINE  COULD   NOT
C              RATIONALIZE  THE  SCALE,  AS  FOR EXAMPLE IF
C              XLEFT IS INPUT CONTAINING THE SAME VALUE  AS
C              XRIGHT, OR IF MAXWID IS INPUT TOO SMALL.
C     LTROFF = RETURNED CONTAINING THE  NUMBER  OF  COLUMNS
C              (OR LINES) BY WHICH THE LEFT (OR LOWER) GRID
C              LINE IS TO  BE  OFFSET  FROM  THE  LEFT  (OR
C              LOWER)  EDGE  OF  THE  PLOT.  INPUT VALUE OF
C              LTROFF IS IGNORED.  IF  LTROFF  IS  RETURNED
C              CONTAINING  ZERO,  THEN  THE LEFT (OR LOWER)
C              GRID LINE SHOULD  APPEAR  IN  THE  LEFT  (OR
C              LOWER)  COLUMN  OF  THE  PLOT.  IF LTROFF IS
C              RETURNED CONTAINING 5, THEN  5  COLUMNS  (OR
C              LINES) OF THE PLOT AREA SHOULD APPEAR TO THE
C              LEFT OF (OR BELOW) THE LEFTMOST (OR  LOWEST)
C              GRID LINE.
C
C     SCALE RANGE TO BE BETWEEN 1.0 AND 9.999...
      IF(MAXWID.LE.0)GO TO 19
      KNTJST=0
      IF(JSTIFY.LE.0)GO TO 1
      FORMER=XLEFT
      XLEFT=XRIGHT
      XRIGHT=FORMER
    1 RANGE=XRIGHT-XLEFT
      IF(RANGE.LT.0.0)RANGE=-RANGE
      IF(RANGE.LE.0.0)GO TO 19
      SHIFTD=RANGE
      IPOWER=0
    2 IF(SHIFTD.GE.10.0)GO TO 3
      IF(SHIFTD.GE.1.0)GO TO 4
      IF(IPOWER.LT.-99)GO TO 19
      IF(IPOWER.GT.0)GO TO 4
      IPOWER=IPOWER-1
      SHIFTD=10.0*SHIFTD
      GO TO 2
    3 IF(IPOWER.GT.99)GO TO 19
      IF(IPOWER.LT.0)GO TO 4
      IPOWER=IPOWER+1
      SHIFTD=SHIFTD/10.0
      GO TO 2
C
C     CALCULATE WIDTH OF EACH GRID DIVISION
    4 STEP=0.25
      IF(SHIFTD.GT.2.5)STEP=0.5
      IF(SHIFTD.GT.5.0)STEP=1.0
      STEP=STEP*(10.0**IPOWER)
      MSHWID=FLOAT(MAXWID-1)*(STEP/RANGE)
      IF(MSHWID.LE.0)GO TO 19
      IF(JSTIFY.NE.0)GO TO 5
      HLFWID=0.5*STEP*(FLOAT(MAXWID-1)/FLOAT(MSHWID))
      IF(XLEFT.GT.XRIGHT)HLFWID=-HLFWID
      CENTER=(XLEFT+XRIGHT)/2.0
      XLEFT=CENTER-HLFWID
      XRIGHT=CENTER+HLFWID
C
C     GET INTEGRAL MULTIPLE OF STEP WHICH IS JUST GREATER
C     THAN OR EQUAL TO ABSOLUTE VALUE OF LEFT EDGE OF PLOT
    5 ORIGIN=STEP
      KOUNT=0
      COMPAR=XLEFT
      IF(COMPAR.LT.0.0)COMPAR=-COMPAR
    6 IF(ORIGIN.GE.COMPAR)GO TO 7
      IF(KOUNT.GE.10)GO TO 19
      KOUNT=KOUNT+1
      ORIGIN=10.0*ORIGIN
      GO TO 6
    7 SEARCH=ORIGIN
    8 LIMIT=10
    9 FORMER=ORIGIN
      ORIGIN=ORIGIN-SEARCH
      IF(ORIGIN.LT.COMPAR)GO TO 10
      LIMIT=LIMIT-1
      IF(LIMIT.GT.0)GO TO 9
      GO TO 11
   10 ORIGIN=FORMER
   11 IF(KOUNT.LE.0)GO TO 12
      SEARCH=SEARCH/10.0
      KOUNT=KOUNT-1
      GO TO 8
C
C     ADJUST ORIGIN FOR DIRECTION AND SIGN OF LEFT EDGE
   12 IF(XLEFT.LE.XRIGHT)GO TO 14
      STEP=-STEP
      IF(XLEFT.LT.0.0)GO TO 13
      ORIGIN=ORIGIN+STEP
      GO TO 15
   13 ORIGIN=-ORIGIN
      GO TO 15
   14 IF(XLEFT.GE.0.0)GO TO 15
      ORIGIN=-ORIGIN+STEP
C
C     CALCULATE GRID PROPORTIONS
   15 LTROFF=0.5+(FLOAT(MSHWID)*((ORIGIN-XLEFT)/STEP))
      IF(LTROFF.LT.MSHWID)GO TO 16
      LTROFF=LTROFF-MSHWID
      ORIGIN=ORIGIN-STEP
   16 IF(LTROFF.LE.0)GO TO 17
      IF(JSTIFY.LT.-1)GO TO 18
      IF(JSTIFY.GT.1)GO TO 18
   17 XLEFT=ORIGIN-(STEP*(FLOAT(LTROFF)/FLOAT(MSHWID)))
      XRIGHT=ORIGIN+(STEP*(FLOAT(MAXWID-1-LTROFF)/
     1FLOAT(MSHWID)))
      IF(JSTIFY.LE.0)GO TO 20
      FORMER=XLEFT
      XLEFT=XRIGHT
      XRIGHT=FORMER
      LTROFF=MAXWID-LTROFF-1
      LTROFF=LTROFF-(MSHWID*(LTROFF/MSHWID))
      GO TO 20
C
C     LOOP BACK IF NEED TO JUSTIFY GRID
   18 XLEFT=ORIGIN-STEP
      KNTJST=KNTJST+1
      IF(KNTJST.LE.5)GO TO 1
C
C     ERROR CONDITION
   19 MSHWID=0
      LTROFF=0
C
C     RETURN TO CALLING PROGRAM
   20 RETURN
C635919530735
      END
      SUBROUTINE DALINE(IGRID ,KNDBAR,LSTLIN,MARGIN,MSHLFT,
     1    MSHRIT,LNGLFT,LNGRIT,XLEFT ,XRIGHT,SEGMNT,MINSEG,
     2    MAXSEG,LETTER,MINLTR,MAXLTR,YVALUE,LABEL ,MINLBL,
     3    MAXLBL,LINPRT,IDISK )
C     RENBR(/HORIZONTAL BAR CHART PLOTTER FOR PRINTER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DALINE   CONSTRUCTS   PRINTABLE   PLOTS    CONTAINING
C     HORIZONTAL  BARS  FORMED  OF SEGMENTS, THE LENGTHS OF
C     WHICH REPRESENT MAGNITUDES OF  CORRESPONDING  VALUES.
C     BARS CAN BE SUPERIMPOSED UPON BACKGROUND GRID AND CAN
C     EXTEND TO EITHER SIDE OF CENTRAL COLUMN CORRESPONDING
C     TO  ZERO.  NEGATIVE SEGMENTS (DEBITS) ARE ACCUMULATED
C     TO ONE SIDE OF ZERO  COLUMN,  AND  POSITIVE  SEGMENTS
C     (CREDITS)  TO  OTHER,  ALTHOUGH  USER  HAS  OPTION OF
C     SUPPRESSING DISPLAY OF  EITHER  PORTION.   DALINE  IS
C     CALLED AS MANY TIMES AS THERE ARE LINES IN PLOT, EACH
C     SUBSEQUENT CALL GENERATING NEXT LOWER LINE OF PLOT.
C
C     ARGUMENTS OF THIS ROUTINE ARE USED ONLY FOR INPUT.
C
C     IGRID  = SELECTS BACKGROUND CHARACTERS  TO  BE  SHOWN
C              WHERE  NOT  HIDDEN  BY  CHARACTERS  USED  TO
C              REPRESENT BAR SEGMENTS,  SELECTS  CHARACTER,
C              IF  ANY,  TO  APPEAR IN CENTRAL ZERO COLUMN,
C              AND SELECTS TYPE OF CAPTION, EITHER  NUMERIC
C              OR  ALPHABETIC,  TO  BE  SHOWN  TO  LEFT  OF
C              CURRENTLY  GENERATED  PANEL  OF  BAR  CHART.
C              THESE  OPTIONS  ARE  SELECTED  BY  DIGITS IN
C              ONES,   TENS,   AND    HUNDREDS    POSITIONS
C              RESPECTIVELY  IN  DECIMAL  INTEGER  VALUE OF
C              IGRID.  MEANINGS ASSIGNED TO  EACH  POSITION
C              IN VALUE OF IGRID ARE AS FOLLOW
C
C            ONES DIGIT OF IGRID
C
C              SELECTS CHARACTERS  TO  BE  INCLUDED  ACROSS
C              WIDTH  OF  PLOT  IN  COLUMNS NOT OCCUPIED BY
C              CHARACTERS USED TO REPRESENT  BAR  SEGMENTS,
C              BUT DOES NOT DICTATE CHARACTERS APPEARING IN
C              EITHER LEFT MARGIN OR IN COLUMN REPRESENTING
C              ZERO.
C
C              0  SPACES WILL BE SHOWN WHERE NOT HIDDEN  BY
C                 CHARACTERS    USED   TO   REPRESENT   BAR
C                 SEGMENTS.
C              1  MINUS  SIGNS  WILL  BE  SHOWN  WHERE  NOT
C                 HIDDEN  BY  CHARACTERS  USED TO REPRESENT
C                 BAR SEGMENTS.
C              2  IF  NOT  HIDDEN  BY  CHARACTERS  USED  TO
C                 REPRESENT  BAR SEGMENTS, THEN EXCLAMATION
C                 POINTS WILL BE SHOWN IN  LEFTMOST  COLUMN
C                 WHICH  COULD  BEAR  LOWER SCALE NUMBER TO
C                 LEFT OF ZERO  COLUMN,  AND  IN  RIGHTMOST
C                 COLUMN   WHICH  COULD  BEAR  LOWER  SCALE
C                 NUMBER TO RIGHT OF ZERO COLUMN.
C              3  SAME AS IGRID=2, EXCEPT THAT MINUS  SIGNS
C                 ARE INCLUDED INSTEAD OF SPACES IN COLUMNS
C                 WHICH CONTAIN NEITHER EXCLAMATION  POINTS
C                 NOR   CHARACTERS   WHICH   REPRESENT  BAR
C                 SEGMENTS.
C              4  SAME  AS  IGRID=2,  EXCEPT  THAT  IF  NOT
C                 HIDDEN  BY  CHARACTERS  USED TO REPRESENT
C                 BAR SEGMENTS, THEN  PLUS  SIGNS  WILL  BE
C                 SHOWN IN LEFTMOST COLUMN WHICH COULD BEAR
C                 LOWER  SCALE  NUMBER  TO  LEFT  OF   ZERO
C                 COLUMN,  AND  IN  RIGHTMOST  COLUMN WHICH
C                 COULD BEAR LOWER SCALE NUMBER TO RIGHT OF
C                 ZERO COLUMN.
C              5  SAME AS IGRID=4, EXCEPT THAT MINUS  SIGNS
C                 ARE INCLUDED INSTEAD OF SPACES IN COLUMNS
C                 WHICH  CONTAIN  NEITHER  PLUS  SIGNS  NOR
C                 CHARACTERS WHICH REPRESENT BAR SEGMENTS.
C              6  IF  NOT  HIDDEN  BY  CHARACTERS  USED  TO
C                 REPRESENT  BAR SEGMENTS, THEN EXCLAMATION
C                 POINTS WILL BE SHOWN IN EACH COLUMN WHICH
C                 COULD BEAR LOWER SCALE NUMBER.
C              7  SAME AS IGRID=6, EXCEPT THAT MINUS  SIGNS
C                 ARE INCLUDED INSTEAD OF SPACES IN COLUMNS
C                 WHICH CONTAIN NEITHER EXCLAMATION  POINTS
C                 NOR   CHARACTERS   WHICH   REPRESENT  BAR
C                 SEGMENTS.
C              8  SAME  AS  IGRID=6,  EXCEPT  THAT  IF  NOT
C                 HIDDEN  BY  CHARACTERS  USED TO REPRESENT
C                 BAR SEGMENTS, THEN  PLUS  SIGNS  WILL  BE
C                 SHOWN  IN  EACH  COLUMN  WHICH COULD BEAR
C                 LOWER SCALE NUMBER.
C              9  SAME AS IGRID=8, EXCEPT THAT MINUS  SIGNS
C                 ARE INCLUDED INSTEAD OF SPACES IN COLUMNS
C                 WHICH  CONTAIN  NEITHER  PLUS  SIGNS  NOR
C                 CHARACTERS WHICH REPRESENT BAR SEGMENTS.
C
C              FOLLOWING   EXAMPLES   DEMONSTRATE   RESULTS
C              PRODUCED BY VARIOUS VALUES OF ONES DIGIT.
C
C       ONES DIGIT = 0
C                  = 1    --------------- ---------------
C                  = 2    !                             !
C                  = 3    !-------------- --------------!
C                  = 4    +                             +
C                  = 5    +-------------- --------------+
C                  = 6    !    !    !         !    !    !
C                  = 7    !----!----!---- ----!----!----!
C                  = 8    +    +    +         +    +    +
C                  = 9    +----+----+---- ----+----+----+
C           TICK MARKS    !    !    !    !    !    !    !
C        SCALE NUMBERS  -15.0-10.0-5.0   0   5.0  10.0 15.0
C
C            TENS DIGIT OF IGRID
C
C              SELECTS CHARACTER, IF ANY, TO  BE  SHOWN  IN
C              ZERO   COLUMN,   AND   WHETHER  LOWER  SCALE
C              NUMBERS, IF GENERATED  BY  CURRENT  CALL  TO
C              THIS ROUTINE, IDENTIFY ZERO COLUMN.
C
C              0  ZERO COLUMN IS NOT REPRESENTED.
C              1, 2, 3 OR 4, ZERO COLUMN IS REPRESENTED  BY
C                 CHARACTER INDICATED BY TENS DIGIT, BUT IS
C                 NOT  TO  BE  IDENTIFIED  IN  LOWER  SCALE
C                 NUMBERS   WHICH  MIGHT  BE  GENERATED  BY
C                 CURRENT CALL TO THIS ROUTINE.
C              1  ZERO COLUMN REPRESENTED BY SPACE.
C              2  ZERO COLUMN REPRESENTED BY MINUS SIGN.
C              3  ZERO COLUMN  REPRESENTED  BY  EXCLAMATION
C                 POINT.
C              4  ZERO COLUMN REPRESENTED BY PLUS SIGN.
C              5, 6, 7 OR 8, ZERO COLUMN IS REPRESENTED  BY
C                 SAME    CHARACTER    AS    SELECTED    BY
C                 1, 2, 3 OR 4  RESPECTIVELY.   IF  CURRENT
C                 CALL TO THIS ROUTINE ALSO GENERATES LOWER
C                 SCALE NUMBERS, THEN ZERO COLUMN  WILL  BE
C                 IDENTIFIED  BY  SCALE NUMBER HAVING VALUE
C                 ZERO.
C
C              FOLLOWING   EXAMPLES   DEMONSTRATE   RESULTS
C              PRODUCED BY VARIOUS VALUES OF TENS DIGIT.
C
C       TENS DIGIT = 0
C
C                +-+--+-+
C                ! !  ! !
C               -4-2  2 4
C
C       TENS DIGIT = 1          2          3          4
C
C                +-+- -+-+  +-+---+-+  +-+-!-+-+  +-+-+-+-+
C                ! !   ! !  ! !   ! !  ! !   ! !  ! !   ! !
C               -4-2   2 4 -4-2   2 4 -4-2   2 4 -4-2   2 4
C
C       TENS DIGIT = 5          6          7          8
C
C                +-+- -+-+  +-+---+-+  +-+-!-+-+  +-+-+-+-+
C                ! ! ! ! !  ! ! ! ! !  ! ! ! ! !  ! ! ! ! !
C               -4-2 0 2 4 -4-2 0 2 4 -4-2 0 2 4 -4-2 0 2 4
C
C            HUNDREDS DIGIT OF IGRID
C
C              SELECTS TYPE OF CAPTION, EITHER  NUMERIC  OR
C              ALPHABETIC, TO BE SHOWN TO LEFT OF CURRENTLY
C              GENERATED PANEL OF BAR CHART.
C
C              0  LEFT MARGIN IS TO CONTAIN SPACES.
C              1  REPRESENTATION OF VALUE INPUT AS ARGUMENT
C                 NAMED  YVALUE IS TO BE RIGHT JUSTIFIED IN
C                 MARGIN TO LEFT  OF  LEFT  BORDER  OF  BAR
C                 CHART.
C              2  CHARACTERS INPUT IN LABEL(MINLBL) THROUGH
C                 AND  INCLUDING  LABEL(MAXLBL)  ARE  TO BE
C                 RIGHT JUSTIFIED IN MARGIN TO LEFT OF LEFT
C                 BORDER OF BAR CHART.
C              3 OR 4, SAME AS 1 OR 2 RESPECTIVELY,  EXCEPT
C                 THAT  SPACE  CHARACTER  IS PLACED BETWEEN
C                 RIGHT JUSTIFIED NUMBER OR WORD  AND  LEFT
C                 BORDER OF PLOT.
C              5 OR 6, SAME AS 3 OR 4 RESPECTIVELY,  EXCEPT
C                 THAT  MINUS  SIGN  IS  TO  BE PLACED INTO
C                 COLUMN TO IMMEDIATE LEFT OF  LEFT  BORDER
C                 OF BAR CHART.
C
C              FOLLOWING   EXAMPLES   DEMONSTRATE   RESULTS
C              PRODUCED   BY  VARIOUS  VALUES  OF  HUNDREDS
C              DIGIT.
C
C       HUNDREDS DIGIT = 0          +----+---- ----+----+
C                      = 1     12.34+----+---- ----+----+
C                      = 2     LABEL+----+---- ----+----+
C                      = 3    12.34 +----+---- ----+----+
C                      = 4    LABEL +----+---- ----+----+
C                      = 5    12.34-+----+---- ----+----+
C                      = 6    LABEL-+----+---- ----+----+
C               TICK MARKS          !    !         !    !
C            SCALE NUMBERS        -10.0-5.0       5.0  10.0
C
C     KNDBAR = SPECIFIES  WHICH  BAR  SEGMENT  IS   TO   BE
C              REPRESENTED  IF  MORE  THAN  ONE BAR SEGMENT
C              APPEARS IN SINGLE COLUMN OF PLOT, AND  WHICH
C              COLUMNS  ARE  TO  REPRESENT  ANY BAR SEGMENT
C              WHICH  EXTENDS  ACROSS  MORE   THAN   SINGLE
C              COLUMN.
C            = -1, NO BAR SEGMENTS ARE  TO  BE  PLOTTED  IN
C              CURRENT PANEL.  RESULTING PANEL IS IDENTICAL
C              TO THAT WHICH WOULD BE PRODUCED IF MINSEG IS
C              SET GREATER THAN MAXSEG.
C            = 0, EACH BAR SEGMENT  IS  TO  BE  REPRESENTED
C              ONLY  IN  FINAL  COLUMN  (THAT FURTHEST FROM
C              ZERO  COLUMN)  IN  WHICH   IT   IS   LARGEST
C              COMPONENT.   SPACES  ARE  INSERTED  INTO ANY
C              OTHER  COLUMNS  IN  WHICH  BAR  SEGMENT   IS
C              DOMINANT.
C            = 1, EACH BAR SEGMENT  IS  TO  BE  REPRESENTED
C              ONLY  IN  FINAL  COLUMN  (THAT FURTHEST FROM
C              ZERO  COLUMN)  IN  WHICH   IT   IS   LARGEST
C              COMPONENT.  GRID CHARACTERS SELECTED BY ONES
C              DIGIT OF DECIMAL INTEGER VALUE OF IGRID  ARE
C              INSERTED INTO ANY OTHER COLUMNS IN WHICH BAR
C              SEGMENT IS DOMINANT.
C            = 2, EACH BAR SEGMENT IS TO BE REPRESENTED  IN
C              ALL   COLUMNS   IN   WHICH   IT  IS  LARGEST
C              COMPONENT.
C            = 3,  4  OR  5,  SAME  AS  KIND=0,  1   OR   2
C              RESPECTIVELY,   EXCEPT  THAT  FINAL  COLUMNS
C              (THOSE FURTHEST TO LEFT AND TO RIGHT OF ZERO
C              COLUMN)  WHICH  CONTAIN  FINAL  NEGATIVE AND
C              FINAL POSITIVE VALUES  SPECIFIED  BY  SEGMNT
C              ARRAY   INSTEAD   CONTAIN   GRID  CHARACTERS
C              SELECTED BY ONES DIGIT  OF  DECIMAL  INTEGER
C              VALUE  OF IGRID IF LARGEST COMPONENTS WITHIN
C              THESE  COLUMNS  ARE   SMALLER   THAN   SPACE
C              REMAINING IN THESE COLUMNS.
C            = 6, EACH BAR SEGMENT  IS  TO  BE  REPRESENTED
C              ONLY  IN  FINAL  COLUMN  (THAT FURTHEST FROM
C              ZERO COLUMN) IN WHICH BAR  SEGMENT  APPEARS.
C              IF  TWO  OR  MORE  BAR SEGMENTS TERMINATE IN
C              SAME COLUMN, THEN BAR SEGMENT  SPECIFIED  BY
C              SEGMNT    ARRAY   LOCATION   HAVING   HIGHER
C              SUBSCRIPT IS REPRESENTED,  AND  BAR  SEGMENT
C              SPECIFIED  BY  THE  SEGMENT  ARRAY  LOCATION
C              HAVING   LOWER    SUBSCRIPT    IS    INSTEAD
C              REPRESENTED  IN  ADJACENT COLUMN NEXT CLOSER
C              TO ZERO COLUMN IF THIS LOWER BAR SEGMENT  IS
C              ONLY  BAR  SEGMENT  WHICH  APPEARS  IN  THIS
C              ADJACENT COLUMN.  SPACES ARE  INSERTED  INTO
C              ANY  OTHER  COLUMNS ACROSS WHICH BAR SEGMENT
C              EXTENDS.
C            = 7,  SAME  AS  KNDBAR=6,  EXCEPT  THAT   GRID
C              CHARACTERS SELECTED BY ONES DIGIT OF DECIMAL
C              INTEGER VALUE OF IGRID ARE INSERTED INTO ANY
C              OTHER   COLUMNS   WHICH   DO   NOT   CONTAIN
C              TERMINATION OF BAR SEGMENT.
C            = 8, EACH BAR SEGMENT IS REPRESENTED IN  FINAL
C              COLUMN  (THAT  FURTHEST FROM ZERO COLUMN) IN
C              WHICH  BAR  SEGMENT  APPEARS,  AND  IN  EACH
C              COLUMN   IN   WHICH   BAR  SEGMENT  IS  ONLY
C              COMPONENT.
C
C              AS DEMONSTRATION OF  PLOTTING  MODIFICATIONS
C              CAUSED BY VARIOUS VALUES OF KNDBAR, NUMBERS
C
C         .3  .4  .2  3.5  .1  .3  3.5  .2  .1  3.5  .3  .2
C
C              AND
C
C        -.3 -.4 -.2 -3.5 -.1 -.3 -3.5 -.2 -.1 -3.5 -.3 -.2
C
C              ARE PLOTTED  BELOW  REPRESENTED  BY  LETTERS
C              THROUGH       X       RESPECTIVELY      WITH
C              LNGLFT=LNGRIT=15,  XLEFT=-15  AND  XRIGHT=15
C              FOR ALL POSSIBLE VALUES OF KNDBAR
C
C            KNDBAR =-1   +----+----+----+----+----+----+
C                   = 0   +-WV   S  P   N+B   D  G   JK-+
C                   = 1   +-WV-+-S--P---N+B---D--G-+-JK-+
C                   = 2   +-WVVVVSSSPPPPN+BDDDDGGGJJJJK-+
C                   = 3   +--V   S  P   N+B   D  G   J--+
C                   = 4   +--V-+-S--P---N+B---D--G-+-J--+
C                   = 5   +--VVVVSSSPPPPN+BDDDDGGGJJJJ--+
C                   = 6   +-XV  US  RP  O+C  DF  GI  JL-+
C                   = 7   +-XV-+US--RP--O+C--DF--GI+-JL-+
C                   = 8   +-XVVVUSSSRPPPO+CDDDFGGGIJJJL-+
C            TICK MARKS   !    !    !    !    !    !    !
C         SCALE NUMBERS -15.0-10.0-5.0   0   5.0  10.0 15.0
C
C              LETTERS WHICH APPEAR IN COLUMNS 1, 5, 9  AND
C              13  WHEN  KNDBAR  IS LESS THAN OR EQUAL TO 5
C              ARE DIFFERENT THAN WHOSE WHICH  APPEAR  WHEN
C              KNDBAR  IS  GREATER  THAN  OR  EQUAL  TO  6.
C              CORRESPONDENCE  OF  LETTERS  TO  COLUMNS  IS
C              SHOWN IN CHART BELOW.
C
C                        COLUMNS                   COLUMNS
C           COLUMN 1    ! 2 - 4 !     COLUMN 5    ! 6 - 8 !
C                       !       !                 !       !
C       .3A .4B .2C .1D !  3.D  ! .4D .1E .3F .2G !  3.G  !
C
C                        COLUMNS
C           COLUMN 9    !10 - 12!     COLUMN 13
C                       !       !
C       .3G .2H .1I .4J !  3.J  ! .1J .3K .2L AND .4 SPACE
C
C
C     LSTLIN = -1, LOWER SCALE NUMBERS ARE TO BE GENERATED,
C              BUT   PANEL   OF   BAR  CHART  WILL  NOT  BE
C              GENERATED.
C            = 0, CURRENT PANEL FINISHES BAR CHART.   SCALE
C              NUMBERS  RANGING IN VALUE FROM THAT OF XLEFT
C              (IF LNGLFT IS  GREATER  THAN  ZERO)  THROUGH
C              THAT  OF  XRIGHT  (IF LNGRIT IS GREATER THAN
C              ZERO) ARE TO BE WRITTEN BELOW CURRENT  PANEL
C              OF BAR CHART.
C            = GREATER THAN ZERO, CURRENT  PANEL  DOES  NOT
C              FINISH  BAR  CHART.   SCALE  NUMBERS ARE NOT
C              GENERATED.
C
C     MARGIN = WIDTH, STATED AS NUMBER  OF  CHARACTERS,  IN
C              MARGIN  TO  BE  INCLUDED  TO LEFT OF CURRENT
C              PANEL OF BAR CHART.  WIDTH OF MARGIN MUST BE
C              SAME  FOR  ALL  PANELS  FORMING  BAR  CHART.
C              MARGIN MUST INCLUDE SUFFICIENT ROOM FOR LEFT
C              SCALE  NUMBER  OR  FOR LEFT ALPHAMERIC LABEL
C              REQUESTED BY NONZERO VALUE OF HUNDREDS DIGIT
C              OF  DECIMAL  INTEGER VALUE OF IGRID, AND FOR
C              EXTRA SPACE  OR  FOR  EXTRA  MINUS  SIGN  IF
C              HUNDREDS  DIGIT  OF IGRID IS GREATER THAN OR
C              EQUAL TO 3.  IF  SCALE  NUMBERS  ARE  TO  BE
C              WRITTEN  BELOW  BAR  CHART, AND IF LNGLFT IS
C              GREATER THAN ZERO, THEN MARGIN  SHOULD  HAVE
C              VALUE  OF AT LEAST 5 (OR OF AT LEAST HALF OF
C              MSHLFT IF MSHLFT IS LESS THAN 10)  TO  ALLOW
C              NUMBER  TO  BE  CENTERED  BELOW  LEFT BORDER
C              LINE.  IF LNGLFT IS NOT GREATER  THAN  ZERO,
C              THEN  ROOM  DOES  NOT  NEED TO BE ALLOWED IN
C              LEFT MARGIN FOR LOWER SCALE NUMBERS.
C
C     MSHLFT = WIDTH OF GRID DIVISIONS INDICATED EITHER  BY
C              EXCLAMATION  POINTS OR PLUS SIGNS IN PORTION
C              OF BAR CHART TO LEFT  OF  ZERO  COLUMN.   IF
C              MSHLFT  IS EQUAL TO ZERO, THEN GRID DIVISION
C              WIDTH OF 10 IS ASSUMED.  MSHLFT IS EQUAL  TO
C              ONE   MORE   THAN   NUMBER   OF  COLUMNS  OF
C              CHARACTERS  APPEARING  BETWEEN   EXCLAMATION
C              POINTS OR PLUS SIGNS.
C
C     MSHRIT = WIDTH OF GRID DIVISIONS INDICATED EITHER  BY
C              EXCLAMATION  POINTS OR PLUS SIGNS IN PORTION
C              OF BAR CHART TO RIGHT OF  ZERO  COLUMN.   IF
C              MSHRIT  IS EQUAL TO ZERO, THEN GRID DIVISION
C              WIDTH OF 10 IS ASSUMED.  MSHRIT IS EQUAL  TO
C              ONE   MORE   THAN   NUMBER   OF  COLUMNS  OF
C              CHARACTERS  APPEARING  BETWEEN   EXCLAMATION
C              POINTS OR PLUS SIGNS.
C
C     LNGLFT = 0, BAR CHART IS NOT TO INCLUDE  ANY  COLUMNS
C              TO  LEFT  OF  ZERO  COLUMN.   THIS  DOES NOT
C              CHANGE WIDTH OF  LEFT  MARGIN  SPECIFIED  BY
C              VALUE OF MARGIN.
C            = GREATER  THAN  ZERO,  LNGLFT  IS  NUMBER  OF
C              COLUMNS  OF CHARACTERS TO BE INCLUDED IN BAR
C              CHART TO LEFT OF ZERO COLUMN.
C
C     LNGRIT = 0, BAR CHART IS NOT TO INCLUDE  ANY  COLUMNS
C              TO RIGHT OF ZERO COLUMN.
C            = GREATER  THAN  ZERO,  LNGRIT  IS  NUMBER  OF
C              COLUMNS  OF CHARACTERS TO BE INCLUDED IN BAR
C              CHART TO RIGHT OF ZERO COLUMN.
C
C     XLEFT  = ACCUMULATED TOTAL OF  SEGMNT  VALUES  HAVING
C              SAME   SIGN   AS   XLEFT   WHICH  IS  TO  BE
C              REPRESENTED BY LEFT BORDER OF PORTION OF BAR
C              CHART  TO  LEFT  OF ZERO COLUMN IF LNGLFT IS
C              GREATER THAN ZERO.  IF  XLEFT  IS  NEGATIVE,
C              THEN ONLY NEGATIVE VALUES ARE REPRESENTED TO
C              LEFT OF ZERO COLUMN.  IF XLEFT IS  POSITIVE,
C              THEN ONLY POSITIVE VALUES ARE REPRESENTED TO
C              LEFT OF ZERO COLUMN.
C
C     XRIGHT = ACCUMULATED TOTAL OF  SEGMNT  VALUES  HAVING
C              SAME   SIGN   AS   XRIGHT  WHICH  IS  TO  BE
C              REPRESENTED BY RIGHT BORDER  OF  PORTION  OF
C              BAR  CHART TO RIGHT OF ZERO COLUMN IF LNGRIT
C              IS  GREATER  THAN  ZERO.    IF   XRIGHT   IS
C              NEGATIVE,  THEN  ONLY  NEGATIVE  VALUES  ARE
C              REPRESENTED TO RIGHT  OF  ZERO  COLUMN.   IF
C              XRIGHT   IS  POSITIVE,  THEN  ONLY  POSITIVE
C              VALUES ARE  REPRESENTED  TO  RIGHT  OF  ZERO
C              COLUMN.
C
C     SEGMNT = ARRAY   CONTAINING   IN   ARRAY    LOCATIONS
C              SEGMNT(MINSEG)    THROUGH    AND   INCLUDING
C              SEGMNT(MAXSEG)  LENGTHS  OF   BAR   SEGMENTS
C              SPECIFIED IN SAME COORDINATE SYSTEMS AS USED
C              FOR DEFINITIONS OF XLEFT AND  XRIGHT.   ZERO
C              VALUES IN SEGMNT ARRAY ARE IGNORED.
C
C     MINSEG = SUBSCRIPT OF FIRST LOCATION IN SEGMNT  ARRAY
C              WHICH CAN SPECIFY LENGTH OF BAR SEGMENT.  IF
C              MINSEG IS GREATER THAN MAXSEG, THEN  NO  BAR
C              SEGMENTS WILL BE REPRESENTED.
C
C     MAXSEG = SUBSCRIPT OF FINAL LOCATION IN SEGMNT  ARRAY
C              WHICH CAN SPECIFY LENGTH OF BAR SEGMENT.
C
C     LETTER = ARRAY   CONTAINING   IN   ARRAY    LOCATIONS
C              LETTER(MINLTR)    THROUGH    AND   INCLUDING
C              LETTER(MAXLTR)  CHARACTERS  BY   WHICH   BAR
C              SEGMENTS   ARE   TO   BE   REPRESENTED,  ONE
C              CHARACTER  PER  LETTER  ARRAY  LOCATION   AS
C              THOUGH  READ  BY  MULTIPLE  OF  A1 FORMAT OR
C              DEFINED  BY  SEVERAL  1H  FIELDS   IN   DATA
C              STATEMENT.    SEGMENT   HAVING   ITS  LENGTH
C              SPECIFIED   BY   SEGMNT(MINSEG)   WILL    BE
C              REPRESENTED    BY    CHARACTER    FOUND   IN
C              LETTER(MINLTR), THAT HAVING  ITS  LENGTH  IN
C              SEGMNT(MINSEG+1)     BY     CHARACTER     IN
C              LETTER(MINLTR+1),    AND    SO    ON.     IF
C              MAXLTR-MINLTR  IS  LESS  THAN MAXSEG-MINSEG,
C              THEN  ASSIGNMENT  OF   CHARACTERS   RECYCLES
C              THROUGH  LETTER  ARRAY  AS MANY TIMES AS ARE
C              NECESSARY TO REPRESENT ALL OF  BAR  SEGMENTS
C              SO  THAT SEGMENT HAVING ITS LENGTH SPECIFIED
C              BY     SEGMNT(MINSEG+MAXLTR-MINLTR+1)     IS
C              REPRESENTED  BY CHARACTER IN LETTER(MINLTR),
C              THAT     HAVING      ITS      LENGTH      IN
C              SEGMNT(MINSEG+MAXLTR-MINLTR+2)  BY CHARACTER
C              IN LETTER(MINLTR+1), AND SO ON.
C
C     MINLTR = SUBSCRIPT OF  LETTER  ARRAY  LOCATION  WHICH
C              SPECIFIES   CHARACTER   TO   BE   USED   FOR
C              REPRESENTATION OF  BAR  SEGMENT  HAVING  ITS
C              LENGTH IN SEGMNT(MINSEG).
C
C     MAXLTR = SUBSCRIPT OF  LETTER  ARRAY  LOCATION  WHICH
C              SPECIFIES   CHARACTER   TO   BE   USED   FOR
C              REPRESENTATION OF  BAR  SEGMENT  HAVING  ITS
C              LENGTH IN SEGMNT(MINSEG+MAXLTR-MINLTR).
C
C     YVALUE = NUMBER TO BE PLACED TO LEFT OF BAR CHART  IF
C              HUNDREDS  DIGIT  OF DECIMAL INTEGER VALUE OF
C              IGRID HAS VALUE 1, 3 OR 5.
C
C     LABEL  = ARRAY   CONTAINING   IN   ARRAY    LOCATIONS
C              LABEL(MINLBL)    THROUGH    AND    INCLUDING
C              LABEL(MAXLBL) CHARACTERS TO BE SHOWN TO LEFT
C              OF  BAR  CHART  IF HUNDREDS DIGIT OF DECIMAL
C              INTEGER VALUE OF IGRID HAS VALUE 2, 4 OR  6.
C              CHARACTERS  IN  LABEL  ARRAY  ARE STORED ONE
C              CHARACTER PER ARRAY LOCATION AS THOUGH  READ
C              BY  MULTIPLE  OF  A1  FORMAT  OR  DEFINED BY
C              SEVERAL 1H FIELDS IN DATA STATEMENT.
C
C     MINLBL = SUBSCRIPT OF LABEL ARRAY LOCATION CONTAINING
C              LEFTMOST CHARACTER.
C
C     MAXLBL = SUBSCRIPT OF LABEL ARRAY LOCATION CONTAINING
C              RIGHTMOST CHARACTER.
C
C     LINPRT = -1, THE PLOT IS NOT  TO INCLUDE ANY CARRIAGE
C              CONTROL CHARACTER AT LEFT END OF EACH LINE.
C            = 0, PLOT WILL BE VIEWED BY USER ON  TERMINAL,
C              EITHER TYPED DIRECTLY WITH IDISK BEING GIVEN
C              TERMINAL UNIT NUMBER, OR TYPED BY USER AFTER
C              THIS  ROUTINE  HAS WRITTEN PLOT INTO FILE ON
C              UNIT NUMBER OF WHICH IS CONTAINED IN  IDISK.
C              BLANK  OR  SPACE  WILL  BE  USED AS CARRIAGE
C              CONTROL CHARACTER TO GIVE SINGLE SPACING.
C            = 1, PLOT WILL BE PRINTED ON LINE  PRINTER  BY
C              USER  AFTER  PROGRAM  HAS  WRITTEN PLOT INTO
C              FILE.  ASTERISK WILL  BE  USED  AS  CARRIAGE
C              CONTROL  CHARACTER  TO  GIVE  SINGLE SPACING
C              WITH SUPPRESSION OF SKIPPING EXTRA LINES  AT
C              PAGE BOUNDARIES.
C
C     IDISK  = UNIT NUMBER OF DEVICE ONTO WHICH  PLOTS  ARE
C              TO BE WRITTEN.
C
      DIMENSION SEGMNT(MAXSEG),LETTER(MAXLTR),LABEL(MAXLBL)
      COMMON/FASPE/LTRBUF(146)
      DATA MAXBFR/146/
C
C     IHRZNT = CHARACTER FOR HORIZONTAL LINES
C     ISPACE = SPACE OF BLANK CHARACTER
C     ISTAR  = USED AS CHARIAGE CONTROL TO PREVENT EXTRA
C              LINES AT PAGE BOUNDARIES
C     IVRTCL = CHARACTER FOR VERTICAL LINES
C     IZERO  = ZERO USED UNDER CENTER LINE
C     KORNER = CHARACTER WHERE HORIZONTAL AND VERTICAL
C              LINES MEET
C
      DATA IHRZNT,IVRTCL,KORNER,ISTAR,IZERO,ISPACE/
     11H-,1H!,1H+,1H*,1H0,1H /
C
C     JGRID  = UNITS DIGIT
C     LGRID  = TENS DIGIT
C     NGRID  = HUNDREDS DIGIT
      LGRID=IGRID/10
      NGRID=IGRID/100
      JGRID=IGRID-(10*LGRID)
      LGRID=LGRID-(10*NGRID)
C
C     UNPACK INDIVIDUAL SWITCHES FROM UNITS DIGIT OF IGRID
C
C       KUNITS JUNITS IUNITS           KUNITS JUNITS IUNITS
C     0     -1      0      0         5      0      0      1
C     1     -1      0      1         6      1      1      0
C     2      0      1      0         7      1      1      1
C     3      0      1      1         8      1      0      0
C     4      0      0      0         9      1      0      1
C
C     KUNITS = -1, NEITHER RIGHT NOR INTERNAL GIRD LINES
C            = 0, RIGHT, BUT NOT INTERNAL, GRID LINES
C            = 1, BOTH RIGHT AND INTERNAL GRID LINES
C     JUNITS = 0, RULE GRID LINES WITH PLUS SIGNS
C            = 1, RULE GRID LINES WITH EXCLAMATION POINTS
C     IUNITS = 0, INSERT SPACES BETWEEN GRID LINES
C            = 1, INSERT MINUS SIGNS BETWEEN GRID LINES
C
      JUNITS=JGRID/2
      IUNITS=JGRID-(2*JUNITS)
      JUNITS=JUNITS-(2*(JUNITS/2))
C
C     ***************************************
C     *                                     *
C     *  CONSTRUCT CONTENTS OF LEFT MARGIN  *
C     *                                     *
C     ***************************************
C
C     INSERT LEFT GRID LINE AND/OR LEFT MINUS SIGN
      MAXPRT=0
      IMRGN=MARGIN
      IF(IMRGN.LT.0)IMRGN=0
      IF(IMRGN.GT.MAXBFR)IMRGN=MAXBFR
      IF(IMRGN.LE.0)GO TO 6
      JRIGHT=IMRGN
      IF(NGRID.LE.2)GO TO 1
      LTRBUF(IMRGN)=ISPACE
      JRIGHT=JRIGHT-1
      IF(NGRID.LE.4)GO TO 1
      LTRBUF(IMRGN)=IHRZNT
      MAXPRT=IMRGN
    1 IF(JRIGHT.LE.0)GO TO 6
      IF(NGRID.GT.0)GO TO 3
C
C     LINE NOT BEARING SCALE NUMBER
      DO 2 I=1,JRIGHT
    2 LTRBUF(I)=ISPACE
      GO TO 6
C
C     LINE BEARING SCALE NUMBER
    3 IF(NGRID.EQ.(2*(NGRID/2)))GO TO 4
      IF(MAXPRT.LT.JRIGHT)MAXPRT=JRIGHT
      MINSIG=JRIGHT-2
      IF(MINSIG.GT.5)MINSIG=5
      IF(MINSIG.LE.0)MINSIG=1
      CALL DARITE(YVALUE,1,0,0,1,
     1-3,0,JRIGHT,-2,7,MINSIG,5,
     20,0,4,0,0,-1,0,
     3MAXBFR,LTRBUF,I,KERR)
      GO TO 6
C
C     BAR WITH LETTERS TO ITS LEFT
    4 J=MAXLBL-JRIGHT
      IF(J.GE.MINLBL)J=MINLBL-1
      DO 5 I=1,JRIGHT
      J=J+1
      LTRBUF(I)=ISPACE
      IF(J.LT.MINLBL)GO TO 5
      IF(MAXPRT.LT.I)MAXPRT=I
      LTRBUF(I)=LABEL(J)
    5 CONTINUE
C
C     ************************************
C     *                                  *
C     *  REPRESENT DATA AS BAR SEGMENTS  *
C     *                                  *
C     ************************************
C
C     GET THE PLOT WIDTH AND MESH LINE WIDTH
    6 LSTSET=KNDBAR-(3*(KNDBAR/3))-1
      KNTLTR=IMRGN
      INCR=-1
      NWIDE=0
      IWIDE=MSHLFT
      IF(IWIDE.LE.0)IWIDE=10
      LWIDE=LNGLFT
      IF(LWIDE.LT.0)LWIDE=0
      IF(LWIDE.GT.(MAXBFR-KNTLTR))LWIDE=MAXBFR-KNTLTR
      JWIDE=IWIDE
      MWIDE=LWIDE
      IF(LWIDE.LE.0)GO TO 32
      ARIGHT=XLEFT
      KNTLTR=KNTLTR+LWIDE+1
      GO TO 8
    7 INCR=1
      IWIDE=MSHRIT
      IF(IWIDE.LE.0)IWIDE=10
      LWIDE=LNGRIT
      IF(LWIDE.LT.0)LWIDE=0
      IF(LWIDE.GT.(MAXBFR-KNTLTR))LWIDE=MAXBFR-KNTLTR
      IF(LWIDE.LE.0)GO TO 33
      ARIGHT=XRIGHT
C
C     INITIAL VALUES
    8 WIDE=LWIDE
      SCALE=WIDE/ARIGHT
      TOTAL=0.0
      COMPAR=0.0
      BIGEST=0.0
      KNTCLM=0
      IBEGIN=0
      NOWSEG=MINSEG
      IF(KNDBAR.LT.0)GO TO 9
      IF(LSTLIN.GE.0)GO TO 10
    9 NOWSEG=MAXSEG+1
   10 IF(JGRID.GT.5)GO TO 12
      IF(JGRID.GT.1)GO TO 11
      MRGLTR=LWIDE+1
      GO TO 13
   11 MRGLTR=IWIDE*(LWIDE/IWIDE)
      GO TO 13
   12 MRGLTR=0
C
C     LOOP THROUGH ALL SEGMENTS IN THE BAR
   13 NOWLTR=MINLTR
   14 LSTONE=1
      IF(NOWSEG.GT.MAXSEG)GO TO 24
      ADDING=SCALE*SEGMNT(NOWSEG)
      IF(ADDING.LE.0.0)GO TO 23
      FORMER=TOTAL
      TOTAL=TOTAL+ADDING
C
C     TEST IF PRESENT BAR IS DOMINANT AT ITS LEFT END
      FRACTN=TOTAL
      IF(FRACTN.GT.COMPAR)FRACTN=COMPAR
      FRACTN=FRACTN-FORMER
      IF(IBEGIN.EQ.0)GO TO 17
      IF(KNDBAR.LE.5)GO TO 15
      IF(TOTAL.GT.COMPAR)GO TO 18
      GO TO 16
   15 IF(FRACTN.LE.BIGEST)GO TO 17
   16 I=KNTLTR-INCR
      IF(IREPLC.NE.0)LTRBUF(I)=LETTER(JREPLC)
      IREPLC=0
      GO TO 20
C
C     INSERT LETTERS ALONG BAR
   17 IF(TOTAL.LE.COMPAR)GO TO 22
   18 FORMER=COMPAR
      COMPAR=COMPAR+1.0
      IF(IBEGIN.GE.LWIDE)GO TO 32
      IF(LSTONE.LE.0)GO TO 21
      IREPLC=0
   19 KNTLTR=KNTLTR+INCR
      IBEGIN=IBEGIN+1
      IF(MAXPRT.LT.KNTLTR)MAXPRT=KNTLTR
      IF(KNTCLM.LE.0)KNTCLM=IWIDE
      KNTCLM=KNTCLM-1
      BIGEST=0.0
   20 LTRBUF(KNTLTR)=LETTER(NOWLTR)
      LSTONE=LSTSET
      JREPLC=NOWLTR
      GO TO 17
   21 IREPLC=1
      IF(LSTONE.EQ.0)GO TO 27
      LTRBUF(KNTLTR)=ISPACE
      GO TO 19
C
C     ALL DONE WITH THIS SEGMENT OF THE BAR
   22 FRACTN=TOTAL-FORMER
      IF(BIGEST.LT.FRACTN)BIGEST=FRACTN
   23 NOWSEG=NOWSEG+1
      NOWLTR=NOWLTR+1
      IF(NOWLTR.LE.MAXLTR)GO TO 14
      GO TO 13
C
C     TEST IF FINAL CHARACTER IS TO BE ALLOWED
   24 IF(KNDBAR.LE.2)GO TO 26
      IF(KNDBAR.GT.5)GO TO 26
      IF(IBEGIN.EQ.0)GO TO 26
      IF(BIGEST.GE.(COMPAR-TOTAL))GO TO 26
      I=KNTLTR-INCR
      IF(IREPLC.NE.0)LTRBUF(I)=LETTER(JREPLC)
      GO TO 27
C
C     ******************************************
C     *                                        *
C     *  CONSTRUCT GRID LINES TO RIGHT OF BAR  *
C     *                                        *
C     ******************************************
C
   25 IF(LSTONE.EQ.0)GO TO 19
   26 IF(KNTCLM.LE.0)KNTCLM=IWIDE
      KNTCLM=KNTCLM-1
      IF(IBEGIN.GE.LWIDE)GO TO 32
      KNTLTR=KNTLTR+INCR
      IBEGIN=IBEGIN+1
   27 IF(KNTCLM.GT.0)GO TO 29
      IF(IBEGIN.LT.MRGLTR)GO TO 29
      IF(JUNITS.EQ.0)GO TO 28
      LTRBUF(KNTLTR)=IVRTCL
      GO TO 30
   28 LTRBUF(KNTLTR)=KORNER
      GO TO 30
   29 IF(IUNITS.EQ.0)GO TO 31
      LTRBUF(KNTLTR)=IHRZNT
   30 IF(MAXPRT.LT.KNTLTR)MAXPRT=KNTLTR
      GO TO 25
   31 LTRBUF(KNTLTR)=ISPACE
      GO TO 25
C
C     REVERSE DIRECTION FOR SECOND HALF
   32 IF(INCR.GT.0)GO TO 33
      KNTLTR=IMRGN+LWIDE
      IF(KNTLTR.GE.MAXBFR)GO TO 7
      IF(LGRID.LE.0)GO TO 7
      KNTLTR=KNTLTR+1
      NWIDE=1
      LTRBUF(KNTLTR)=ISPACE
      I=LGRID
      IF(I.GT.4)I=I-4
      IF(I.LE.1)GO TO 7
      MAXPRT=KNTLTR
      IF(I.EQ.2)LTRBUF(KNTLTR)=IHRZNT
      IF(I.EQ.3)LTRBUF(KNTLTR)=IVRTCL
      IF(I.GE.4)LTRBUF(KNTLTR)=KORNER
      GO TO 7
C
C     OUTPUT THE COMPLETED BAR
   33 KONTRL=ISPACE
      IF(LINPRT.GT.0)KONTRL=ISTAR
      IF(LSTLIN.LT.0)GO TO 37
      IF(LINPRT.GE.0)GO TO 34
      IF(MAXPRT.LE.0)WRITE(IDISK,35)ISPACE
      IF(MAXPRT.GT.0)WRITE(IDISK,35)(LTRBUF(I),I=1,MAXPRT)
      GO TO 36
   34 IF(MAXPRT.LE.0)WRITE(IDISK,35)KONTRL,ISPACE
      IF(MAXPRT.GT.0)WRITE(IDISK,35)KONTRL,
     1(LTRBUF(I),I=1,MAXPRT)
   35 FORMAT(147A1)
C
C     *****************************************************
C     *                                                   *
C     *  CONSTRUCT AND PRINT NUMBERS FORMING LOWER SCALE  *
C     *                                                   *
C     *****************************************************
C
C     CONSTRUCT LINE CONTAINING TICK MARKS
   36 IF(LSTLIN.GT.0)GO TO 57
   37 IFINAL=IMRGN+MWIDE+LWIDE+NWIDE
      IF(IFINAL.LE.IMRGN)GO TO 57
      DO 38 I=1,IFINAL
   38 LTRBUF(I)=ISPACE
      KNTLTR=IMRGN+MWIDE+1
      IF(NWIDE.EQ.0)GO TO 40
      IF(LGRID.LE.4)GO TO 40
   39 LTRBUF(KNTLTR)=IVRTCL
   40 KNTLTR=KNTLTR-JWIDE
      IF(KNTLTR.GT.IMRGN)GO TO 39
      KNTLTR=IMRGN+MWIDE+NWIDE
   41 KNTLTR=KNTLTR+IWIDE
      IF(KNTLTR.GT.IFINAL)GO TO 42
      LTRBUF(KNTLTR)=IVRTCL
      GO TO 41
   42 IF(LINPRT.LT.0)WRITE(IDISK,35)(LTRBUF(I),I=1,IFINAL)
      IF(LINPRT.GE.0)WRITE(IDISK,35)KONTRL,
     1(LTRBUF(I),I=1,IFINAL)
C
C     CONSTRUCT LINE CONTAINING LOWER SCALE NUMBERS
      LERR=-1
      MAXPRT=0
      IF(NWIDE.EQ.0)GO TO 43
      IF(LGRID.LE.4)GO TO 43
      MAXPRT=IMRGN+MWIDE+1
      LTRBUF(MAXPRT)=IZERO
   43 KIND=LERR
      INCR=-1
      IWIDTH=JWIDE
      KNTLTR=1
      WIDE=MWIDE
      GO TO 45
   44 INCR=1
      IWIDTH=IWIDE
      KNTLTR=NWIDE
      WIDE=LWIDE
   45 KNTLTR=KNTLTR+IWIDTH+IMRGN+MWIDE-1
      IF(IWIDTH.GT.10)IWIDTH=10
      JWIDTH=IWIDTH/2
      KNTLTR=KNTLTR-JWIDTH
      MINSIG=IWIDTH-2
      IF(MINSIG.GT.5)MINSIG=5
      IF(MINSIG.LE.0)MINSIG=1
      I=0
      NEED=KNTLTR
      GO TO 48
   46 IF(KNTLTR.LT.0)KNTLTR=0
      CALL DARITE(VALUE,0,0,KIND,1,
     1-3,0,IWIDTH,-2,-2,MINSIG,5,
     20,0,4,0,0,-1,KNTLTR,
     3MAXBFR,LTRBUF,KNTOUT,KERR)
      IF(KERR.GT.0)LERR=1
      KNTLTR=KNTOUT
      IF(KIND.LE.0)GO TO 47
      IF(KERR.EQ.0)GO TO 48
   47 IF(MAXPRT.LT.KNTLTR)MAXPRT=KNTLTR
   48 IF(INCR.GT.0)GO TO 51
      I=I+JWIDE
   49 IF(NEED.LE.KNTLTR)GO TO 50
      KNTLTR=KNTLTR+1
      LTRBUF(KNTLTR)=ISPACE
      GO TO 49
   50 IF(I.GT.MWIDE)GO TO 44
      VALUE=XLEFT*FLOAT(I)/WIDE
      KNTLTR=KNTLTR-JWIDE-JWIDE
      NEED=KNTLTR+JWIDE
      GO TO 46
   51 I=I+IWIDE
      IF(I.GT.LWIDE)GO TO 54
      VALUE=XRIGHT*(FLOAT(I)/WIDE)
   52 IF(NEED.LE.KNTLTR)GO TO 53
      KNTLTR=KNTLTR+1
      LTRBUF(KNTLTR)=ISPACE
      GO TO 52
   53 NEED=KNTLTR+IWIDE
      GO TO 46
   54 IF(MAXPRT.LE.0)GO TO 55
      IF(LINPRT.LT.0)WRITE(IDISK,35)(LTRBUF(I),I=1,MAXPRT)
      IF(LINPRT.GE.0)WRITE(IDISK,35)KONTRL,
     1(LTRBUF(I),I=1,MAXPRT)
      MAXPRT=0
   55 IF(NWIDE.EQ.0)GO TO 56
      I=IMRGN+MWIDE+1
      LTRBUF(I)=ISPACE
   56 IF(KIND.NE.LERR)GO TO 43
C
C     ALL DONE WITH THIS LINE OF THE PLOT
   57 RETURN
C922171101196!
      END
      SUBROUTINE DAHEST(KMDTYP,LSTTYP,NAMLOW,NAMMAX,MRKLOW,
     1    MRKMAX,NUMLOW,NUMMAX,INTRVL,LOWWRD,MAXWRD,IWORD ,
     2    LOWKNT,MAXKNT,KNTLTR,LEGAL ,MAXBFR,IBUFFR,LOWBFR,
     3    KIND  ,KOMAND,LCNWRD,LCNKNT,INIPRT,MIDPRT,LMTPRT,
     4    NAMKNT,NAMLFT,NAMRIT,MRKKNT,MRKLFT,MRKRIT,NUMKNT,
     5    NUMSIN,NUMVAL,VALNUM,IFLOAT)
C     RENBR(/PARSER OF SIMPLE COMMANDS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAHEST AND DAIHST INTERPRET SIMPLE COMMANDS TYPED  BY
C     THE USER AND READ INTO A BUFFER ARRAY WITH A MULTIPLE
C     OF AN A1 FORMAT.  THE COMMANDS CONSIST OF  A  COMMAND
C     WORD,  OR  UNIQUE ABREVIATION THEREOF, FOLLOWED BY AN
C     ARGUMENT LIST FORMED OF NUMBERS, ALPHABETIC WORDS AND
C     QUOTED   TEXT   STRINGS.   THE  LINE  OF  TEXT  BEING
C     EVALUATED CAN CONTAIN  SEVERAL  STATEMENTS  IF  THESE
C     STATEMENTS  ARE SEPARATED BY THE SEMICOLON CHARACTER.
C     THE BUFFER CAN ALSO CONTAIN A COMMENT INDICATED BY AN
C     EXCLAMATION POINT TO THE LEFT OF THE COMMENT.
C
C     DAHEST OR DAIHST IS  CALLED  ONCE  TO  EVALUATE  EACH
C     STATEMENT.   THE  CALLING  PROGRAM  INDICATES  TO THE
C     ROUTINE THE POSITION IN THE BUFFER  OF  THE  LEFTMOST
C     CHARACTER  WHICH  HAS  NOT  YET  BEEN EVALUATED.  THE
C     ROUTINE MOVES THIS POINTER  THROUGH  THE  BUFFER  AND
C     RETURNS  IT  TO  THE  CALLING  PROGRAM SPECIFYING THE
C     LEFTMOST CHARACTER TO BE EVALUATED BY THE  NEXT  CALL
C     TO  THE  ROUTINE.   AFTER  THIS  ROUTINE  HAS FINALLY
C     INDICATED THAT NOTHING MORE REMAINS TO  BE  PROCESSED
C     IN THE LINE OF TEXT CONTAINED IN THE BUFFER, THEN THE
C     CALLING PROGRAM MUST READ ANOTHER LINE WHICH IS TO BE
C     INTERPRETED,  AND  MUST RESET THE POINTER TO INDICATE
C     THE START OF THE BUFFER BEFORE THE NEXT CALL  TO  THE
C     ROUTINE.
C
C     DAHEST CAN EVALUATE BOTH REAL NUMBERS  AND  INTEGERS.
C     EITHER FORM CAN BE SPECIFIED IN FLOATING POINT FORMAT
C     WITH FOLLOWING E EXPONENT OR WITH FOLLOWING %, K OR M
C     TO  INDICATE  E-2,  E3  AND  E6 RESPECTIVELY.  IF THE
C     PROGRAM WHICH  CALLS  DAHEST  DOES  NOT  REQUIRE  THE
C     EVALUATION  OF  REAL  NUMBERS  AND DOES NOT OTHERWISE
C     CALL DAHEFT, AND IF THE SPECIFICATION OF INTEGERS  IN
C     EXPONENT  FORM  IS  NOT  NECESSARY,  THEN THE ROUTINE
C     DAIHST SHOULD BE CALLED INSTEAD OF DAHEST.   ALTHOUGH
C     THE  ROUTINES  ARE  OF APPROXIMATELY THE SAME LENGTH,
C     DAIHST DOES NOT CALL DAHEFT FOR  NUMERIC  EVALUATION.
C     NUMBERS  EVALUATED  BY  DAIHST  MUST  CONSIST ONLY OF
C     DIGITS FOLLOWING THE OPTIONAL SIGN.  NUMBERS  CAN  BE
C     SEPARATED   BY  SLASHES  (OR  BY  COLONS,  THESE  TWO
C     CHARACTERS  BEING  EQUIVALENT)  IF  THEY  ARE  TO  BE
C     ASSOCIATED IN SOME MANNER, SUCH AS SPECIFYING A RANGE
C     AND INCREMENT.  BOTH THE SIGN AND  THE  SIGNED  VALUE
C     ARE RETURNED TO THE CALLING PROGRAM.
C
C     TEXT  STRINGS  ARE  PRECEDED  AND  FOLLOWED  BY   THE
C     APOSTROPHE.  IF AN APOSTROPHE MUST APPEAR IN THE TEXT
C     STRING  ITSELF,  THEN  AN  EXTRA  APPEARANCE  OF  THE
C     APOSTROPHE  MUST  PRECEDE  THE  ONE  WHICH  IS  TO BE
C     TREATED MERELY AS TEXT.  THE LOCATIONS OF  THE  START
C     AND END OF THE TEXT INSIDE THE DELIMITING APOSTROPHES
C     ARE RETURNED TO THE CALLING PROGRAM,  AND  THE  EXTRA
C     APOSTROPHES  WITHIN THE TEXT STRING ARE EXPUNGED FROM
C     THE INPUT BUFFER.
C
C     TEXT STRINGS CAN ALSO BE  DELIMITED  BY  PARENTHESES.
C     IF  THE  TEXT  STRING  STARTS  WITH  A  LEADING  LEFT
C     PARENTHESIS, THEN IT WILL BE TERMINATED BY A MATCHING
C     TRAILING  RIGHT  PARENTHESIS.   IF  THE  TEXT  STRING
C     STARTS WITH A LEADING RIGHT PARENTHESIS, THEN IT WILL
C     BE   TERMINATED   BY   A   MATCHING   TRAILING   LEFT
C     PARENTHESIS.  WITHIN THE PARENTHESES,  AN  APOSTROPHE
C     CAN  APPEAR  IN  FRONT  OF ANY CHARACTER, INCLUDING A
C     PARENTHESIS OR ANOTHER APOSTROPHE, TO  INDICATE  THAT
C     THIS  FOLLOWING  CHARACTER  IS  TO  HAVE  NO  SPECIAL
C     MEANING.  IF FOUND, THE APOSTROPHE  IS  LEFT  IN  THE
C     TEXT  STRING.  IF THE TYPE OF TEXT STRING HAS MEANING
C     TO THE PROGRAM, THEN  THE  PROGRAM  SHOULD  TEST  THE
C     CHARACTER  WHICH  IS  IMMEDIATELY  TO THE LEFT OF THE
C     CONTENTS OF THE TEXT  STRING  TO  DETERIMINE  WHETHER
C     THIS   IS   AN  APOSTROPHE  OR  A  LEFT  OR  A  RIGHT
C     PARENTHESIS.
C
C     A WORD APPEARING AS AN ARGUMENT  OF  A  COMMAND  MUST
C     BEGIN  WITH  A  CHARACTER WHICH CANNOT START A NUMBER
C     AND WHICH IS NOT ONE OF THE DELIMITER CHARACTERS SUCH
C     AS   THE   SPACE,   TAB,   SLASH,  COLON,  SEMICOLON,
C     EXCLAMATION POINT, COMMA OR APOSTROPHE.   DIGITS  CAN
C     APPEAR ANYWHERE TO THE RIGHT OF THE LEADING CHARACTER
C     OF THE WORD,  BUT  THE  OTHER  PROHIBITED  CHARACTERS
C     WILL,   IF  ENCOUNTERED,  TERMINATE  THE  WORD.   THE
C     LOCATIONS OF THE  START  AND  END  OF  THE  WORD  ARE
C     RETURNED TO THE CALLING PROGRAM.
C
C     ONE, BUT ONLY ONE, OF THE THREE  TYPES  OF  ARGUMENTS
C     CAN  BE  USED  MORE THAN ONCE AS AN ARGUMENT.  IF THE
C     TYPE OF ARGUMENT WHICH CAN BE REPEATED  IS  SPECIFIED
C     BEFORE  THE FIRST ARGUMENT IS FOUND, EITHER BEING THE
C     SAME  FOR  ALL  COMMANDS,  OR  ELSE  BEING  SPECIFIED
C     SEPARATELY  IN  THE DICTIONARY FOR EACH COMMAND, THEN
C     ARGUMENTS OF THE OTHER TWO TYPES CAN APPEAR  AT  MOST
C     ONCE IN THE ARGUMENT LIST.  IF THE REPEATABLE TYPE IS
C     WORD OR TEXT STRING, THEN A SET OF NUMBERS INDICATING
C     A  RANGE  CAN  STILL  BE SUPPLIED.  IF THE REPEATABLE
C     TYPE IS NUMERIC, THEN MORE THAN ONE  SET  OF  NUMBERS
C     INDICATING  RANGES  WILL BE ACCEPTED.  ALTERNATIVELY,
C     THE TYPE OF ARGUMENT WHICH CAN BE REPEATED CAN BE THE
C     TYPE OF THE FIRST ARGUMENT ENCOUNTERED, IN WHICH CASE
C     ARGUMENTS OF THE OTHER TWO TYPES ARE NOT  ALLOWED  IN
C     THE ARGUMENT LIST.
C
C     ANY NUMBER OF SPACES AND/OR TAB CHARACTERS CAN APPEAR
C     BEFORE  THE COMMAND WORD AND BETWEEN THE COMMAND WORD
C     AND ITS FIRST ARGUMENT.  SUCCESSIVE ARGUMENTS CAN  BE
C     SEPARATED  BY  A SINGLE COMMA AND/OR BY ANY NUMBER OF
C     SPACES  AND/OR   TAB   CHARACTERS.    NO   SEPARATING
C     CHARACTERS  ARE NECESSARY IF THE LEADING CHARACTER OF
C     AN ARGUMENT INDICATES THAT  IT  CANNOT  CONTINUE  THE
C     PRECEDING  COMMAND  WORD  OR  PRECEDING  ARGUMENT.  A
C     SINGLE COMMA APPEARING BETWEEN 2 ARGUMENTS OF  EITHER
C     THE  SAME  OR OF DIFFERENT TYPES MERELY INDICATES THE
C     SEPARATION BETWEEN THE  ARGUMENTS,  AND  IS  ENTIRELY
C     EQUIVALENT   TO   ONE   OR  MORE  SPACES  AND/OR  TAB
C     CHARACTERS.  TWO COMMAS, POSSIBLY SEPARATED BY SPACES
C     AND/OR BY TAB CHARACTERS, INDICATE A MISSING ARGUMENT
C     OF THE REPEATABLE TYPE.  A COMMA BETWEEN THE  COMMAND
C     WORD AND THE FIRST ARGUMENT IS TAKEN TO INDICATE THAT
C     THE FIRST ARGUMENT OF THE REPEATABLE TYPE IS MISSING.
C     FOR EXAMPLE, IN THE STATEMENTS
C
C          OPAQUE'=',,'*';INVISIBLE,'$'
C
C     THE QUOTED TEXT CHARACTER * IS THE THIRD ARGUMENT  OF
C     THE  COMMAND  WORD  OPAQUE, THE SECOND ARGUMENT BEING
C     MISSING, AND THE  QUOTED  TEXT  CHARACTER  $  IS  THE
C     SECOND  ARGUMENT  OF  THE COMMAND WORD INVISIBLE, THE
C     FIRST ARGUMENT BEING MISSING.
C
C     THE ARGUMENTS OF THE REPEATABLE TYPE ARE RETURNED  TO
C     THE CALLING PROGRAM IN THE ORDER IN WHICH THEY APPEAR
C     IN THE STATEMENT, AND,  IN  PARTICULAR,  THE  CALLING
C     PROGRAM IS ABLE TO DETERMINE WHETHER ANY ARE MISSING.
C     NO INFORMATION REGARDING ORDERING  BETWEEN  ARGUMENTS
C     OF   DIFFERENT  TYPES  IS  RETURNED  TO  THE  CALLING
C     PROGRAM.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY, AND  ARE
C     RETURNED UNCHANGED.
C
C     KMDTYP = 0, STATEMENT MUST START WITH COMMAND WORD.
C            = 1, STATEMENT CAN START WITH COMMAND WORD  OR
C              INTEGER.   IF INTEGER IS FOUND, RETURN VALUE
C              AS NUMVAL AND LOCATIONS OF  LEFT  AND  RIGHT
C              ENDS OF FOLLOWING TEXT AS MIDPRT AND LMTPRT.
C            = 2, STATEMENT CAN START WITH COMMAND WORD  OR
C              REAL  NUMBER.   IF  REAL  NUMBER  IS  FOUND,
C              RETURN VALUE AS VALNUM AND LOCATIONS OF LEFT
C              AND  RIGHT  ENDS OF FOLLOWING TEXT AS MIDPRT
C              AND LMTPRT.
C            = -1, DO NOT LOOK FOR COMMAND WORD.   CONTENTS
C              OF  STATEMENT ARE EVALUATED AS ARGUMENT LIST
C              OF TYPE INDICATED BY LSTTYP.
C     LSTTYP = SPECIFIES TYPE OF ARGUMENT WHICH CAN  APPEAR
C              MORE THAN ONCE IN ARGUMENT LIST.
C            = -1, TYPE OF ARGUMENT LIST IS  SPECIFIED  FOR
C              EACH  COMMAND  BY LEGAL ARRAY VALUE PARALLEL
C              TO CHARACTER COUNT IN KNTLTR ARRAY.
C            = 0, NO ARGUMENTS ARE ALLOWED.
C            = 1, TYPE OF ARGUMENT WHICH CAN BE REPEATED IS
C              TYPE  OF FIRST ARGUMENT ENCOUNTERED, WHETHER
C              OR NOT THIS IS PRECEDED BY  COMMAS.   COMMAS
C              DO,  HOWEVER,  INDICATE MISSING ARGUMENTS OF
C              SAME  TYPE   AS   THAT   EVENTUALLY   FOUND.
C              ADDITIONAL  ARGUMENTS  OF  TYPES  OTHER THAN
C              THAT OF FIRST ARGUMENT ENCOUNTERED  ARE  NOT
C              ALLOWED.    IF  AN  ADDITIONAL  ARGUMENT  OF
C              ANOTHER TYPE IS FOUND,  THEN  EVALUATION  OF
C              ARGUMENT  LIST  WILL  BE  TERMINATED  EXCEPT
C              INSOFAR AS IS NECESSARY  TO  DETECT  END  OF
C              STATEMENT,   AND   KIND   WILL  BE  RETURNED
C              CONTAINING  ONE  OF  VALUES  8,  9   OR   10
C              INDICATING  TYPE  OF ILLEGAL ARGUMENT.  IF A
C              SET OF NUMBERS IS FOUND, IT IS EVALUATED  AS
C              A SET OF INTEGERS.
C            = 2, ALLOW SERIES OF WORDS.   TEXT  STRING  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 3, ALLOW SERIES OF SETS OF  INTEGERS.   TEXT
C              STRING OR WORD CAN APPEAR AT MOST ONCE.
C            = 4, ALLOW SERIES OF TEXT  STRINGS.   WORD  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 5, 6, 7 AND 8, SAME AS LSTTYP VALUES  OF  1,
C              2,  3  AND  4 RESPECTIVELY, EXCEPT THAT IF A
C              NUMBER IS FOUND, IT  IS  EVALUATED  AS  REAL
C              NUMBER  AND  ITS VALUE IS RETURNED IN VALNUM
C              ARRAY, RATHER THAN IN NUMVAL ARRAY.
C            = 9, ONLY TYPE OF ARGUMENT  ACCEPTED  WILL  BE
C              PARENTHETICAL TEXT STRINGS, NOT TEXT STRINGS
C              DELIMITED    BY    APOSTROPHES.     PRINTING
C              CHARACTERS    IMMEDIATELY    TO    LEFT   OF
C              PARENTHETICAL EXPRESSION WILL BE TAKEN TO BE
C              PART  OF  THAT  EXPRESSION,  AND MRKLFT WILL
C              POINT TO LEFTMOST  OF  THESE.   UNLIKE  TEXT
C              STRINGS   ALLOWED  BY  ANY  OTHER  VALUE  OF
C              LSTTYP, LEADING PARENTHESIS IS POINTED TO BY
C              MRKLFT  IF  NO PRINTING CHARACTERS APPEAR TO
C              ITS LEFT.  MRKRIT  WILL  STILL  BE  RETURNED
C              POINTING  TO  CHARACTER  TO LEFT OF TRAILING
C              PARENTHESIS.
C     NAMLOW = SUBSCRIPT  OF  NAMLFT   AND   NAMRIT   ARRAY
C              LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C              FIRST WORD IN ARGUMENT LIST.
C     NAMMAX = MAXIMUM  SUBSCRIPT  OF  NAMLFT  AND   NAMRIT
C              ARRAYS.
C     MRKLOW = SUBSCRIPT  OF  MRKLFT   AND   MRKRIT   ARRAY
C              LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C              FIRST TEXT STRING IN ARGUMENT LIST.
C     MRKMAX = MAXIMUM  SUBSCRIPT  OF  MRKLFT  AND   MRKRIT
C              ARRAYS.
C     NUMLOW = SUBSCRIPT OF NUMSIN, NUMVAL AND VALNUM ARRAY
C              LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C              FIRST NUMBER IN ARGUMENT LIST.
C     NUMMAX = MAXIMUM  SUBSCRIPT  OF  NUMSIN,  NUMVAL  AND
C              VALNUM ARRAYS.
C     INTRVL = MAXIMUM NUMBER OF NUMBERS IN SET OF  NUMBERS
C              SEPARATED   BY   SLASHES.    IF   2  NUMERIC
C              ARGUMENTS ARE SEPARATED BY  SOMETHING  OTHER
C              THAN SLASH, THEN THESE ARGUMENTS ARE PART OF
C              SERIES OF SETS OF NUMBERS,  AND  DESCRIPTION
C              OF  SECOND  NUMBER  IS  PLACED  INTO NUMSIN,
C              NUMVAL AND VALNUM ARRAYS AT LOCATION  HAVING
C              SUBSCRIPT  GREATER  BY  VALUE OF INTRVL THAN
C              SUBSCRIPT OF LOCATION INTO WHICH WAS  PLACED
C              DESCRIPTION OF FIRST NUMBER OF PREVIOUS SET.
C     LOWWRD = SUBSCRIPT OF LOCATION IN IWORD  ARRAY  WHICH
C              CONTAINS  1ST LETTER OF 1ST WORD.  NOTE THAT
C              IF KNTLTR(LOWKNT) IS NEGATIVE, THEN THE  1ST
C              LETTER  OF  1ST  WORD WILL BE FOUND IN ARRAY
C              LOCATION IWORD(LOWWRD-KNTLTR(LOWKNT)).
C     MAXWRD = DIMENSION OF IWORD ARRAY.
C     IWORD  = DICTIONARY ARRAY  CONTAINING  CHARACTERS  OF
C              COMMAND  WORDS WHICH ARE TO BE RECOGNIZED, 1
C              CHARACTER PER ARRAY LOCATION AS READ  BY  A1
C              FORMAT OR ELSE DEFINED BY 1H FIELD.  COMMAND
C              WORD IN INPUT  BUFFR  ARRAY  IBUFFR  CAN  BE
C              SPLIT  INTO  2 OR MORE PORTIONS SEPARATED BY
C              SPACES  AND/OR  TABS  AND  WILL  BE  MATCHED
C              WHETHER OR NOT SPACES OR TABS ARE PRESENT IF
C              WORD IN IWORD CONTAINS  A  SINGLE  SPACE  AT
C              LOCATION  AT  WHICH  SPLIT  IS  ALLOWED.  IN
C              ORDER TO OBTAIN A MATCH, CASES OF CHARACTERS
C              IN  DICTIONARY  AND  IN INPUT BUFFER MUST BE
C              IDENTICAL.  NOTE ALSO, THAT LETTERS E, M AND
C              K  USED WITHIN NUMBERS TO INDICATE EXPONENTS
C              MUST BE IN UPPER CASE  IN  INPUT  BUFFER  IN
C              ORDER TO BE RECOGNIZED.
C     LOWKNT = SUBSCRIPT OF KNTLTR ARRAY CONTAINING  LENGTH
C              OF  FIRST WORD WHICH CAN BE MATCHED IN IWORD
C              ARRAY.   THIS  FIRST  WORD  WILL  START   AT
C              IWORD(LOWWRD).
C     MAXKNT = SUBSCRIPT OF KNTLTR ARRAY CONTAINING  LENGTH
C              OF  FINAL WORD WHICH CAN BE MATCHED IN IWORD
C              ARRAY.
C     KNTLTR = ARRAY CONTAINING NUMBERS  OF  CHARACTERS  IN
C              WORDS  IN  IWORD  ARRAY.   ZERO  OR NEGATIVE
C              VALUE IN KNTLTR ARRAY OFFSETS NEXT  POSSIBLE
C              WORD  WHICH CAN BE MATCHED IN IWORD ARRAY BY
C              NUMBER OF LETTERS GIVEN BY ABSOLUTE VALUE OF
C              NEGATIVE  NUMBER IN KNTLTR ARRAY.  DIMENSION
C              OF KNTLTR MUST  BE  AT  LEAST  MAXKNT.   FOR
C              EXAMPLE TO RECOGNIZE WORDS
C
C                   YES, NO, MAYBE
C
C              CONTENTS OF IWORD ARRAY WOULD BE
C
C                   1HY,1HE,1HS,1HN,1HO,1HM,1HA,1HY,1HB,1HE
C
C              AND CONTENTS OF KNTLTR ARRAY WOULD BE
C
C                   3,2,5
C
C     LEGAL  = IF LSTTYP=-1, THEN LEGAL IS ARRAY SPECIFYING
C              FOR  EACH  POSSIBLE COMMAND WORD THE TYPE OF
C              NUMERIC ARGUMENTS, REAL OR INTEGER, WITH CAN
C              BE  EVALUATED, AND TYPE OF ARGUMENT, WORD OR
C              SET OF NUMBERS OR TEXT STRING, WHICH CAN  BE
C              PRESENT  MORE  THAN  ONCE  IN ARGUMENT LIST.
C              TYPE OF ARGUMENT LIST IS AT  SAME  SUBSCRIPT
C              IN  LEGAL ARRAY AS CHARACTER COUNT IN KNTLTR
C              ARRAY.  IF LSTTYP IS GREATER THAN  OR  EQUAL
C              TO  ZERO,  THEN  CONTENTS OF LEGAL ARRAY ARE
C              IGNORED.
C            = 0, NO ARGUMENTS ARE ALLOWED.
C            = 1, TYPE OF ARGUMENT WHICH CAN BE REPEATED IS
C              TYPE  OF FIRST ARGUMENT ENCOUNTERED, WHETHER
C              OR NOT THIS IS PRECEDED BY  COMMAS.   COMMAS
C              DO,  HOWEVER,  INDICATE MISSING ARGUMENTS OF
C              SAME  TYPE   AS   THAT   EVENTUALLY   FOUND.
C              ADDITIONAL  ARGUMENTS  OF  TYPES  OTHER THAN
C              THAT OF FIRST ARGUMENT ENCOUNTERED  ARE  NOT
C              ALLOWED.    IF  AN  ADDITIONAL  ARGUMENT  OF
C              ANOTHER TYPE IS FOUND,  THEN  EVALUATION  OF
C              ARGUMENT  LIST  WILL  BE  TERMINATED  EXCEPT
C              INSOFAR AS IS NECESSARY  TO  DETECT  END  OF
C              STATEMENT,   AND   KIND   WILL  BE  RETURNED
C              CONTAINING  ONE  OF  VALUES  8,  9   OR   10
C              INDICATING  TYPE  OF ILLEGAL ARGUMENT.  IF A
C              SET OF NUMBERS IS FOUND, IT IS EVALUATED  AS
C              A SET OF INTEGERS.
C            = 2, ALLOW SERIES OF WORDS.   TEXT  STRING  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 3, ALLOW SERIES OF SETS OF  INTEGERS.   TEXT
C              STRING OR WORD CAN APPEAR AT MOST ONCE.
C            = 4, ALLOW SERIES OF TEXT  STRINGS.   WORD  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 5, 6, 7 AND 8, SAME AS LEGAL ARRAY VALUES OF
C              1,  2,  3 AND 4 RESPECTIVELY, EXCEPT THAT IF
C              NUMBER IS FOUND, IT  IS  EVALUATED  AS  REAL
C              NUMBER  AND  ITS VALUE IS RETURNED IN VALNUM
C              ARRAY, RATHER THAN IN NUMVAL ARRAY.
C            = 9, ONLY TYPE OF ARGUMENT  ACCEPTED  WILL  BE
C              PARENTHETICAL TEXT STRINGS, NOT TEXT STRINGS
C              DELIMITED    BY    APOSTROPHES.     PRINTING
C              CHARACTERS    IMMEDIATELY    TO    LEFT   OF
C              PARENTHETICAL EXPRESSION WILL BE TAKEN TO BE
C              PART  OF  THAT  EXPRESSION,  AND MRKLFT WILL
C              POINT TO LEFTMOST  OF  THESE.   UNLIKE  TEXT
C              STRINGS   ALLOWED  BY  ANY  OTHER  VALUE  OF
C              LEGAL,  LEADING PARENTHESIS IS POINTED TO BY
C              MRKLFT  IF  NO PRINTING CHARACTERS APPEAR TO
C              ITS LEFT.  MRKRIT  WILL  STILL  BE  RETURNED
C              POINTING  TO  CHARACTER  TO LEFT OF TRAILING
C              PARENTHESIS.
C     MAXBFR = SUBSCRIPT   OF   IBUFFR    ARRAY    LOCATION
C              CONTAINING  RIGHTMOST  CHARACTER  IN CURRENT
C              LINE.
C
C     FOLLOWING ARGUMENTS  ARE  USED  FOR  BOTH  INPUT  AND
C     OUTPUT.
C
C     IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS  OF
C              LINE  BEING  INTERPRETED,  ONE CHARACTER PER
C              ARRAY LOCATION, AS READ BY  MULTIPLE  OF  A1
C              FORMAT.    IF   QUOTED  TEXT  STRING  ITSELF
C              CONTAINING APOSTROPHES IS  FOUND  IN  IBUFFR
C              ARRAY, THEN EXTRA APOSTROPHES NEEDED TO MARK
C              APOSTROPHES TO REMAIN IN TEXT ARE REMOVED BY
C              SHIFTING TO LEFT TEXT TO THEIR RIGHT.
C     LOWBFR = SUBSCRIPT IN IBUFFR ARRAY OF FIRST CHARACTER
C              TO   BE  INTERPRETED.   LOWBFR  IS  RETURNED
C              POINTING   TO   FIRST    CHARACTER    BEYOND
C              INTERPRETED STATEMENT.  IF SEMICOLON APPEARS
C              AT END OF STATEMENT, THEN LOWBFR IS RETURNED
C              POINTING  TO  SEMICOLON AND WILL BE ADVANCED
C              BEYOND SEMICOLON BY SUBSEQUENT CALL TO  THIS
C              ROUTINE.   IF  EXCLAMATION  POINT APPEARS AT
C              END OF STATEMENT, OR IF THERE  ARE  NO  MORE
C              PRINTING  CHARACTERS  TO RIGHT OF STATEMENT,
C              THEN LOWBFR IS RETURNED CONTAINING MAXBFR+1.
C     KIND   = MUST BE  SET  TO  ZERO  BY  CALLING  PROGRAM
C              BEFORE  THIS  ROUTINE  IS  FIRST  CALLED  TO
C              EVALUATE  LINE  OF  TEXT.   KIND   IS   THEN
C              RETURNED  DESCRIBING TYPE OF STATEMENT WHICH
C              WAS EVALUATED.  CALLING PROGRAM SHOULD RESET
C              KIND  TO  HAVE  VALUE  ZERO IF EVALUATION OF
C              CONTENTS OF LINE OF TEXT IS BEING  ABANDONED
C              BY  CALLING  PROGRAM BEFORE THIS ROUTINE HAS
C              INDICATED BY RETURNING KIND=1  THAT  IT  HAS
C              COMPLETED   EVALUATION   OF  LINE  OF  TEXT.
C              EXCEPT   FOR   THIS   INSTANCE   IN    WHICH
C              INTERPRETATION IS BEING ABANDONED BY CALLING
C              PROGRAM, VALUE OF KIND IS  OTHERWISE  PASSED
C              UNCHANGED   TO   SUBSEQUENT   CALL  TO  THIS
C              ROUTINE.
C            = 1,  (PROCESSING   COMPLETED)   RETURNED   IF
C              PREVIOUS   CALLS   TO   THIS   ROUTINE  HAVE
C              COMPLETED EVALUATION OF CONTENTS OF LINE  OF
C              TEXT.   CALLING PROGRAM SHOULD READ NEW LINE
C              OF TEXT AND RESET LOWBFR TO POINT  TO  FIRST
C              CHARACTER IN NEW TEXT.
C            = 2, (EMPTY STATEMENT)  RETURNED  IF  ORIGINAL
C              LINE   OF   TEXT   CONTAINED   NO   PRINTING
C              CHARACTERS OR CONTAINED LEADING  EXCLAMATION
C              POINT  INDICATING  THAT  CHARACTERS  TO  ITS
C              RIGHT FORMED COMMENT.  KIND IS ALSO RETURNED
C              SET   TO  2  IF  EXTRA  SEMICOLON  INDICATES
C              MISSING STATEMENT.
C            = 3, (CORRECT STATEMENT) RETURNED IF STATEMENT
C              WAS  NOT  EMPTY  AND  WAS  EVALUATED WITHOUT
C              ERRORS.  IF KMDTYP IS GREATER THAN OR  EQUAL
C              TO  ZERO,  THEN  KNOWN COMMAND WORD, OR ELSE
C              NONAMBIGUOUS ABBREVIATION THEREOF, WAS FOUND
C              AND  SEQUENCE  NUMBER  OF  THIS COMMAND WORD
C              WITHIN DICTIONARY IS RETURNED  AS  VALUE  OF
C              KOMAND.   IF  KMDTYP IS LESS THAN ZERO, THEN
C              KOMAND IS  RETURNED  WITH  VALUE  ZERO,  AND
C              STATEMENT  CONTAINED  AT LEAST COMMA, SLASH,
C              COLON OR ARGUMENT.
C            = 4, (INITIAL NUMBER) RETURNED  IF  KMDTYP  IS
C              GREATER  THAN  ZERO, AND IF NUMBER WAS FOUND
C              AT START OF STATEMENT.  MIDPRT  IS  RETURNED
C              CONTAINING  SUBSCRIPT WITHIN IBUFFR ARRAY OF
C              CHARACTER  TO  IMMEDIATE  RIGHT  OF  NUMBER.
C              LMTPRT   IS  RETURNED  CONTAINING  SUBSCRIPT
C              WITHIN IBUFFR ARRAY  OF  RIGHTMOST  PRINTING
C              CHARACTER WITHIN IBUFFR ARRAY.
C            = 5, (MISSING  COMMAND)  RETURNED  IF  COMMAND
C              WORD OR ELSE LEADING NUMBER WAS REQUIRED BUT
C              NOT FOUND, BUT STATEMENT IS NOT  EMPTY.   NO
C              ARGUMENT   DESCRIPTIONS   ARE   RETURNED  TO
C              CALLING PROGRAM.
C            = 6, (UNKNOWN  COMMAND)  RETURNED  IF  INITIAL
C              COMMAND  WORD  WAS  REQUIRED,  BUT STATEMENT
C              STARTS WITH SEQUENCE OF PRINTING  CHARACTERS
C              WHICH  COULD FORM COMMAND WORD, BUT WHICH DO
C              NOT MATCH WORD IN DICTIONARY, OR WHICH  FORM
C              AMBIGUOUS ABBREVIATION OF 2 OR MORE WORDS IN
C              DICTIONARY, OR WHICH DO MATCH SINGLE WORD IN
C              DICTIONARY  BUT  ARE FOLLOWED IMMEDIATELY BY
C              ADDITIONAL ALPHABETIC CHARACTERS OR  DIGITS.
C              INIPRT  AND  MIDPRT ARE RETURNED POINTING TO
C              LEFTMOST AND RIGHTMOST  CHARACTERS  IN  THIS
C              UNKNOWN    COMMAND    WORD.    NO   ARGUMENT
C              DESCRIPTIONS   ARE   RETURNED   TO   CALLING
C              PROGRAM.
C            = 7, 8, 9 OR 10 RETURNED IF MAXIMUM NUMBER  OF
C              ARGUMENTS  OF  SINGLE  TYPE  WAS EXCEEDED IN
C              ARGUMENT  LIST.   DESCRIPTION  OF   ARGUMENT
C              WHICH    EXCEEDED    LIMIT,   AS   WELL   AS
C              DESCRIPTIONS OF ANY ARGUMENTS TO ITS  RIGHT,
C              ARE   NOT   RETURNED   TO  CALLING  PROGRAM,
C              ALTHOUGH SCANNING OF STATEMENT CONTINUES  TO
C              DETERMINE ITS RIGHT END.
C            = 7, RETURNED IF TOO MANY  SLASHES  OR  COLONS
C              WERE ENCOUNTERED IN SET OF NUMBERS.
C            = 8, RETURNED IF TOO MANY WORDS WERE FOUND.
C            = 9, RETURNED IF TOO MANY SETS OF NUMBERS WERE
C              FOUND.
C            = 10, RETURNED IF TOO MANY TEXT  STRINGS  WERE
C              FOUND.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT.   THEIR
C     INPUT VALUES ARE IGNORED.
C
C     KOMAND = IF KIND IS RETURNED CONTAINING 3 OR RETURNED
C              CONTAINING  7  OR  GREATER,  THEN  KOMAND IS
C              SEQUENCE NUMBER OF COMMAND WORD  MATCHED  IN
C              IWORD  ARRAY.   IF  SECOND  COMMAND  WORD IS
C              MATCHED, THEN KOMAND IS RETURNED  CONTAINING
C              2.  SEQUENCE NUMBER DOES NOT INCLUDE LETTERS
C              SKIPPED OVER BY VALUE OF  LOWWRD,  AND  DOES
C              NOT INCLUDE LETTERS SKIPPED OVER BY NEGATIVE
C              VALUES IN KNTLTR ARRAY.  IF COMMAND WORD  IN
C              IWORD  ARRAY  IS  MATCHED,  THEN  KOMAND  IS
C              NUMBER OF VALUES IN KNTLTR ARRAY  WHICH  ARE
C              GREATER THAN ZERO STARTING AT KNTLTR(LOWKNT)
C              UP TO AND INCLUDING  KNTLTR  LOCATION  WHICH
C              CONTAINS  NUMBER  OF LETTERS IN COMMAND WORD
C              WHICH IS SUCCESSFULLY MATCHED.
C            = RETURNED CONTAINING ZERO IF A  COMMAND  WORD
C              WAS NOT MATCHED.
C     LCNWRD = IF KIND IS RETURNED CONTAINING EITHER 3 OR 7
C              OR GREATER AND KOMAND BEING RETURNED GREATER
C              THAN ZERO,  LCNWRD  IS  RETURNED  CONTAINING
C              SUBSCRIPT OF IWORD LOCATION CONTAINING FIRST
C              LETTER OF MATCHED WORD.  LCNWRD IS UNDEFINED
C              IF KOMAND IS RETURNED CONTAINING ZERO.
C     LCNKNT = IF KIND IS RETURNED CONTAINING EITHER 3 OR 7
C              OR GREATER AND KOMAND BEING RETURNED GREATER
C              THAN ZERO,  LNCKNT  IS  RETURNED  CONTAINING
C              SUBSCRIPT OF KNTLTR LOCATION CONTAINING WORD
C              LENGTH.  LCNKNT IS UNDEFINED  IF  KOMAND  IS
C              RETURNED CONTAINING ZERO.
C     INIPRT = RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY  LOCATION CONTAINING LEFTMOST PRINTING
C              CHARACTER IN STATEMENT IF KIND  IS  RETURNED
C              CONTAINING 3 OR GREATER.  INIPRT IS RETURNED
C              UNDEFINED IF KIND IS RETURNED SET TO  EITHER
C              1 OR 2.
C            = IF KIND IS RETURNED CONTAINING 6  INDICATING
C              THAT UNKNOWN COMMAND WORD WAS FOUND AT START
C              OF  STATEMENT,  THEN  INIPRT   IS   RETURNED
C              POINTING   TO   LEFT  CHARACTER  OF  UNKNOWN
C              COMMAND WORD.  MIDPRT WILL THEN BE  RETURNED
C              POINTING   TO  RIGHT  CHARACTER  OF  UNKNOWN
C              COMMAND WORD.
C     MIDPRT = RETURNED  UNDEFINED  IF  KIND  IS   RETURNED
C              CONTAINING ANY VALUE OTHER THAN 4 OR 6.
C            = IF  KMDTYP  WAS  INPUT  GREATER  THAN   ZERO
C              ALLOWING  INITIAL NUMBER IN PLACE OF INITIAL
C              COMMAND WORD, AND IF SUCH INITIAL NUMBER WAS
C              FOUND SO THAT KIND IS RETURNED CONTAINING 4,
C              THEN  MIDPRT   IS   RETURNED   POINTING   TO
C              CHARACTER  TO  IMMEDIATE  RIGHT  OF  NUMBER.
C              LMTPRT WILL THEN  BE  RETURNED  POINTING  TO
C              RIGHTMOST PRINTING CHARACTER ON LINE.
C            = IF KIND IS RETURNED CONTAINING 6  INDICATING
C              THAT UNKNOWN COMMAND WORD WAS FOUND AT START
C              OF  STATEMENT,  THEN  MIDPRT   IS   RETURNED
C              POINTING   TO  RIGHT  CHARACTER  OF  UNKNOWN
C              COMMAND WORD.
C     LMTPRT = RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY LOCATION CONTAINING RIGHTMOST PRINTING
C              CHARACTER IN STATEMENT IF KIND  IS  RETURNED
C              CONTAINING  3  OR  GREATER.  IF STATEMENT IS
C              FOLLOWED BY EITHER SEMICOLON OR  EXCLAMATION
C              POINT,  THEN  LMTPRT IS RETURNED POINTING TO
C              RIGHTMOST  PRINTING  CHARACTER  TO  LEFT  OF
C              SEMICOLON  OR  EXCLAMATION POINT.  LMTPRT IS
C              RETURNED UNDEFINED IF KIND IS  RETURNED  SET
C              TO EITHER 1 OR 2.
C            = IF  KMDTYP  WAS  INPUT  GREATER  THAN   ZERO
C              ALLOWING  INITIAL NUMBER IN PLACE OF INITIAL
C              COMMAND WORD, AND IF SUCH INITIAL NUMBER WAS
C              FOUND SO THAT KIND IS RETURNED CONTAINING 4,
C              THEN  LMTPRT   IS   RETURNED   POINTING   TO
C              RIGHTMOST PRINTING CHARACTER IN BUFFER.
C     NAMKNT = RETURNED CONTAINING HIGHEST  SUBSCRIPT  USED
C              IN   NAMLFT   AND  NAMRIT  ARRAYS  TO  STORE
C              LOCATIONS IN BUFFER  OF  ENDS  OF  WORDS  IN
C              ARGUMENT  LIST.   IF NO WORDS ARE FOUND THEN
C              NAMKNT IS RETURNED CONTAINING NAMLOW-1.
C     NAMLFT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF  LOCATIONS CONTAINING LEFT
C              CHARACTERS OF WORDS IN  ARGUMENT  LIST.   IF
C              SERIES  OF  WORDS  IS  ENABLED  BUT SOME ARE
C              INDICATED AS  MISSING  BY  EXTRA  COMMAS  IN
C              ARGUMENT  LIST, THEN FOR THESE MISSING WORDS
C              NAMRIT ARRAY WILL CONTAIN VALUES  LESS  THAN
C              THOSE IN NAMLFT ARRAY.
C     NAMRIT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF LOCATIONS CONTAINING RIGHT
C              CHARACTERS OF WORDS IN ARGUMENT LIST.
C     MRKKNT = RETURNED CONTAINING HIGHEST  SUBSCRIPT  USED
C              IN   MRKLFT   AND  MRKRIT  ARRAYS  TO  STORE
C              LOCATIONS IN BUFFER OF ENDS OF  QUOTED  TEXT
C              STRINGS IN ARGUMENT LIST.  IF NO QUOTED TEXT
C              STRINGS ARE FOUND THEN  MRKKNT  IS  RETURNED
C              CONTAINING MRKLOW-1.
C     MRKLFT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF  LOCATIONS CONTAINING LEFT
C              CHARACTERS   OF   QUOTED    TEXT    STRINGS.
C              CHARACTER  POINTED TO BY MRKLFT IS CHARACTER
C              TO IMMEDIATE RIGHT OF INITIAL APOSTROPHE  OR
C              OF  INITIAL PARENTHESIS.  IF LSTTYP=9, OR IF
C              LSTTYP=-1 AND LEGAL=9, THEN MRKLFT POINTS TO
C              LEFTMOST  PRINTING CHARACTER LEFT OF OPENING
C              PARENTHESIS OR TO OPENING PARENTHESIS ITSELF
C              IF   NOT  PRECEDED  BY  ANY  OTHER  PRINTING
C              CHARACTERS.  IF SERIES OF  TEXT  STRINGS  IS
C              ENABLED BUT SOME ARE INDICATED AS MISSING BY
C              EXTRA COMMAS  IN  ARGUMENT  LIST,  THEN  FOR
C              THESE MISSING TEXT STRINGS MRKRIT ARRAY WILL
C              CONTAIN VALUES 2 LESS THAN THOSE IN MRKLFT.
C     MRKRIT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF LOCATIONS CONTAINING RIGHT
C              CHARACTERS  OF  QUOTED   TEXT   STRINGS   IN
C              ARGUMENT  LIST.   CHARACTER  POINTED  TO  BY
C              MRKRIT ARRAY IS CHARACTER TO IMMEDIATE  LEFT
C              OF  FINAL APOSTROPHE OR OF FINAL PARENTHESIS
C              AT RIGHT END OF QUOTED TEXT  STRING,  OR  IS
C              RIGHTMOST  PRINTING  CHARACTER ON LINE IF NO
C              FINAL APOSTROPHE  OR  FINAL  PARENTHESIS  IS
C              FOUND.
C     NUMKNT = RETURNED CONTAINING HIGHEST  SUBSCRIPT  USED
C              IN NUMSIN, NUMVAL AND VALNUM ARRAYS TO STORE
C              DESCRIPTION OF NUMERIC  ARGUMENTS  FOUND  IN
C              ARGUMENT  LIST.  IF NO NUMERIC ARGUMENTS ARE
C              FOUND  IN  ARGUMENT  LIST,  THEN  NUMKNT  IS
C              RETURNED CONTAINING NUMLOW-1.
C     NUMSIN = ARRAY  RETURNED  INDICATING  SIGN,  IF  ANY,
C              WHICH PRECEDED EACH NUMERIC ARGUMENT.  VALUE
C              OF ARGUMENT IS RETURNED IN NUMVAL OR  VALNUM
C              ARRAY  LOCATION  HAVING  SAME  SUBSCRIPT  AS
C              NUMSIN ARRAY LOCATION DESCRIBING SIGN.
C            = -1,  CORRESPONDING  NUMERIC   ARGUMENT   WAS
C              INDICATED  AS  MISSING  EITHER BY ABSENCE OF
C              NUMBER BEFORE SLASH OR COLON, BY ABSENCE  OF
C              NUMBER  AFTER  SLASH OR COLON, OR BY ABSENCE
C              OF  NUMBER  BETWEEN   SLASHES   OR   COLONS.
C              CORRESPONDING  VALUE  IN  NUMVAL  OR  VALNUM
C              ARRAY IS RETURNED SET TO ZERO.
C            = 0,   RETURNED   IF   CORRESPONDING   NUMERIC
C              ARGUMENT  WAS  INDICATED  AS MISSING BY LESS
C              THAN INTRVL NUMBERS BEING INCLUDED IN SET OF
C              NUMBERS, OR BY 2 ADJACENT COMMAS IN ARGUMENT
C              LIST.
C            = 1, NUMERIC ARGUMENT WAS  EVALUATED,  BUT  NO
C              SIGN APPEARED TO ITS LEFT.
C            = 2, MINUS SIGN APPEARED TO  LEFT  OF  NUMERIC
C              ARGUMENT.
C            = 3, PLUS SIGN APPEARED  TO  LEFT  OF  NUMERIC
C              ARGUMENT.
C     NUMVAL = ARRAY RETURNED CONTAINING VALUES OF  NUMERIC
C              ARGUMENTS  EVALUATED  AS INTEGERS.  IF MINUS
C              SIGN PRECEDED NUMBER, THEN VALUE  IN  NUMVAL
C              IS NEGATIVE.
C     VALNUM = ARRAY RETURNED CONTAINING VALUES OF  NUMERIC
C              ARGUMENTS  EVALUATED  AS  REAL  NUMBERS.  IF
C              MINUS SIGN PRECEDED NUMBER,  THEN  VALUE  IN
C              VALNUM IS NEGATIVE.
C     IFLOAT = RETURNED    DESCRIBING    WHETHER    NUMERIC
C              ARGUMENTS WERE EVALUATED AS INTEGERS OR REAL
C              NUMBERS.
C            = 0,  RETURNED  IF  NUMERIC   ARGUMENTS   WERE
C              EVALUATED  AS  INTEGERS.   VALUES OF NUMERIC
C              ARGUMENTS ARE RETURNED IN NUMVAL ARRAY.
C            = 1,  RETURNED  IF  NUMERIC   ARGUMENTS   WERE
C              EVALUATED   AS   REAL  NUMBERS.   VALUES  OF
C              NUMERIC ARGUMENTS  ARE  RETURNED  IN  VALNUM
C              ARRAY.
C
      DIMENSION IDIGIT(10),ISEPAR(13),IBUFFR(MAXBFR),
     1IWORD(MAXWRD),KNTLTR(MAXKNT),LEGAL(MAXKNT),
     2NAMLFT(NAMMAX),NAMRIT(NAMMAX),MRKLFT(MRKMAX),
     3MRKRIT(MRKMAX),NUMSIN(NUMMAX),NUMVAL(NUMMAX),
     4VALNUM(NUMMAX)
C
      EQUIVALENCE(IBLANK,ISEPAR(1)),(ITAB,ISEPAR(2)),
     1           (IQUOTE,ISEPAR(6)),(ILEFT,ISEPAR(7)),
     2           (IRIGHT,ISEPAR(8)),(ISLASH,ISEPAR(9)),
     3           (ICOLON,ISEPAR(10)),(IPLUS,ISEPAR(11)),
     4           (IMINUS,ISEPAR(12)),(IDOT,ISEPAR(13))
C
C     FIRST  CHARACTER  IN ISEPAR  ARRAY IS SPACE.   SECOND
C     CHARACTER IS TAB CHARACTER.   IF TAB CHARACTER IS NOT
C     AVAILABLE, THEN SECOND CHARACTER SHOULD BE SPACE ALSO
      DATA ISEPAR/1H ,1H	,
     11H!,1H;,1H,,1H',1H(,1H),1H/,1H:,1H+,1H-,1H./
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     SET DEFAULT ARGUMENT COUNTS TO ZERO
      NUMKNT=NUMLOW-1
      MRKKNT=MRKLOW-1
      NAMKNT=NAMLOW-1
      INIKND=KIND
C
C     **********************
C     *                    *
C     *  SCAN FOR COMMAND  *
C     *                    *
C     **********************
C
C     LOOK FOR FIRST PRINTING CHARACTER
      GO TO 3
    1 INIKND=0
    2 LOWBFR=LOWBFR+1
    3 IF(LOWBFR.GT.MAXBFR)GO TO 90
      IF(IBUFFR(LOWBFR).EQ.IBLANK)GO TO 2
      IF(IBUFFR(LOWBFR).EQ.ITAB)GO TO 2
      INIPRT=LOWBFR
      MULTPL=LSTTYP
      IF(KMDTYP.LT.0)GO TO 6
C
C     TEST IF SEQUENCE OF PRINTING CHARACTERS IN DICTIONARY
      INILTR=LOWBFR
      CALL DAVERB(LOWWRD,MAXWRD,IWORD,LOWKNT,MAXKNT,
     1KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND,KOMAND,LCNWRD,
     2LCNKNT,LCNBFR)
      LMTPRT=LOWBFR-1
C
C     ENTIRE DICTIONARY HAS BEEN SEARCHED
      IF(KIND.GE.3)GO TO 4
C     NO COMMAND WORD, CHECK FOR LEADING NUMBER
      ISTATE=-1
      MULTPL=3
      IF(KMDTYP.GE.2)MULTPL=7
      GO TO 7
C     GET ARGUMENT LIST TYPE IF IN LEGAL ARRAY
    4 IF(LSTTYP.EQ.-1)MULTPL=LEGAL(LCNKNT)
      IF(KIND.LE.4)GO TO 5
C     AMBIGUOUS ABREVIATION, CHECK FOR REST OF WORD IF ANY
      KIND=-1
      GO TO 8
C     COMMAND FOUND BUT IS ERROR IF ADDITIONAL CHARACTERS
    5 ISTATE=0
      GO TO 7
C     NO COMMAND WAS TESTED FOR, SIMULATE LEADING SPACE
    6 ISTATE=1
      KOMAND=0
    7 KIND=0
C
C     MULTPL = -3, ALLOW NO ARGUMENTS
C            = -2, ALLOW MULTIPLE ARGUMENTS OF 1ST TYPE
C              FOUND
C            = -1, ALLOW MULTIPLE WORDS
C            = 0, ALLOW MULTIPLE NUMBERS
C            = 1, ALLOW MULTIPLE STRINGS
C
    8 JMLTPL=MULTPL-8
      LIMIT=13
      IF(JMLTPL.GT.0)LIMIT=8
      MULTPL=MULTPL-3
      IF(MULTPL.LE.1)GO TO 9
      MULTPL=MULTPL-4
      IFLOAT=1
      GO TO 10
    9 IFLOAT=0
   10 IF(MULTPL.GE.-1)GO TO 11
      IF(MULTPL.LE.-3)IFLOAT=1
      NUMBLK=0
      MRKNXT=MRKKNT
      NAMNXT=NAMKNT
      NUMNXT=NUMKNT
      NOTYET=0
      GO TO 12
   11 NUMBLK=1
      NUMNXT=NUMLOW
      MRKNXT=MRKLOW
      NAMNXT=NAMLOW
   12 NUMNOW=NUMNXT
      IF(KIND.LT.0)GO TO 71
      GO TO 16
C
C     ************************
C     *                      *
C     *  SCAN FOR ARGUMENTS  *
C     *                      *
C     ************************
C
C     ISTATE = -1, NOTHING OR SPACE FOUND.  WILL ACCEPT
C              ONLY A LEADING NUMBER.
C            = 0, COMMAND FOUND, BUT NOT YET ANYTHING,
C              EVEN SPACES, AFTER IT.
C            = 1, NO COMMAND WAS LOOKED FOR, ONLY SPACES
C              HAVE YET BEEN FOUND, NOTHING ELSE
C            = 2, COMMA FOUND ANYWHERE, OR ELSE COMMAND
C              FOUND FOLLOWED BY SPACE.  ANOTHER COMMA WILL
C              INDICATE A MISSING ARGUMENT.
C            = 3, TERMINATED SINGLE ITEM
C
C     SPACE OR TAB CHARACTER FOUND
   13 IF(ISTATE.NE.0)GO TO 15
   14 ISTATE=2
C
C     TEST IF NEXT CHARACTER BEGINS ARGUMENT OR PUNCTUATION
   15 LOWBFR=LOWBFR+1
   16 IF(LOWBFR.GT.MAXBFR)GO TO 89
      KOMPAR=IBUFFR(LOWBFR)
      DO 17 I=1,LIMIT
      IF(KOMPAR.NE.ISEPAR(I))GO TO 17
      GO TO(13,13,89,91,83,19,31,31,59,59,45,46,47),I
   17 CONTINUE
      IF(JMLTPL.GT.0)GO TO 70
      IF(ISTATE.EQ.0)GO TO 72
      DO 18 I=1,10
      IF(KOMPAR.EQ.IDIGIT(I))GO TO 47
   18 CONTINUE
      GO TO 70
C
C     ************************
C     *                      *
C     *  QUOTED TEXT STRING  *
C     *                      *
C     ************************
C
C     APOSTROPHE STARTS TEXT STRING
   19 IF(JMLTPL.GT.0)GO TO 26
      INILTR=LOWBFR+1
      I=LOWBFR
      LMTPRT=LOWBFR
   20 IF(I.GE.MAXBFR)GO TO 22
      I=I+1
      LOWBFR=LOWBFR+1
      IBUFFR(LOWBFR)=IBUFFR(I)
      IF(IBUFFR(I).EQ.IBLANK)GO TO 20
      IF(IBUFFR(I).EQ.ITAB)GO TO 20
      LMTPRT=LOWBFR
      IF(IBUFFR(I).NE.IQUOTE)GO TO 20
      IF(I.GE.MAXBFR)GO TO 21
      IF(IBUFFR(I+1).NE.IQUOTE)GO TO 21
      I=I+1
      GO TO 20
   21 NONSPC=LMTPRT-1
      GO TO 23
   22 NONSPC=LMTPRT
   23 IF(LOWBFR.EQ.I)GO TO 39
      KOPY=LOWBFR
   24 IF(KOPY.GE.MAXBFR)GO TO 39
      KOPY=KOPY+1
      IF(I.GE.MAXBFR)GO TO 25
      I=I+1
      IBUFFR(KOPY)=IBUFFR(I)
      GO TO 24
   25 IBUFFR(KOPY)=IBLANK
      GO TO 24
C
C     SECTION PRIOR TO PARENTHETICAL EXPRESSION
   26 INILTR=LOWBFR
   27 KOMPAR=IBUFFR(LOWBFR)
      DO 28 I=1,8
      IF(KOMPAR.NE.ISEPAR(I))GO TO 28
      IF(I.LT.6)GO TO 30
      IF(I.GT.6)GO TO 32
      IF(LOWBFR.LT.MAXBFR)LOWBFR=LOWBFR+1
      GO TO 29
   28 CONTINUE
   29 LMTPRT=LOWBFR
      NONSPC=LOWBFR
      IF(LOWBFR.GE.MAXBFR)GO TO 39
      LOWBFR=LOWBFR+1
      GO TO 27
   30 LOWBFR=LOWBFR-1
      GO TO 39
C
C     PARENTHESIS STARTS TEXT STRING
   31 INILTR=LOWBFR
      IF(JMLTPL.LE.0)INILTR=INILTR+1
   32 LEVEL=0
      GO TO 34
   33 IF(LOWBFR.GE.MAXBFR)GO TO 38
      LOWBFR=LOWBFR+1
   34 KOMPAR=IBUFFR(LOWBFR)
      IF(KOMPAR.EQ.IBLANK)GO TO 33
      IF(KOMPAR.EQ.ITAB)GO TO 33
      LMTPRT=LOWBFR
      IF(KOMPAR.EQ.ILEFT)GO TO 35
      IF(KOMPAR.EQ.IRIGHT)GO TO 36
      IF(KOMPAR.NE.IQUOTE)GO TO 33
      IF(LOWBFR.GE.MAXBFR)GO TO 38
      LOWBFR=LOWBFR+1
      LMTPRT=LOWBFR
      GO TO 33
   35 LEVEL=LEVEL+1
      GO TO 37
   36 LEVEL=LEVEL-1
   37 IF(LEVEL.NE.0)GO TO 33
      NONSPC=LMTPRT-1
      GO TO 39
   38 NONSPC=LMTPRT
C
C     STORE THE TEXT STRING
   39 IF(ISTATE.LT.0)KIND=5
      IF(KIND.NE.0)GO TO 44
      IF(MULTPL.NE.-2)GO TO 40
      MULTPL=1
      MRKNXT=MRKLOW+NOTYET
   40 IF(MRKKNT.GE.MRKNXT)GO TO 41
      IF(MRKNXT.LE.MRKMAX)GO TO 42
   41 KIND=10
      GO TO 44
   42 MRKKNT=MRKKNT+1
      IF(MRKKNT.GE.MRKNXT)GO TO 43
      MRKLFT(MRKKNT)=1
      MRKRIT(MRKKNT)=-1
      GO TO 42
   43 MRKLFT(MRKKNT)=INILTR
      MRKRIT(MRKKNT)=NONSPC
      IF(MULTPL.EQ.0)GO TO 44
      IF(NUMKNT.GE.NUMLOW)NUMBLK=0
   44 ISTATE=3
      IF(MULTPL.GT.0)GO TO 86
      GO TO 15
C
C     ****************************
C     *                          *
C     *  NUMBER OR NUMBER RANGE  *
C     *                          *
C     ****************************
C
C     PLUS SIGN STARTS NUMBER
   45 ISIGN=3
      GO TO 48
C
C     MINUS SIGN STARTS NUMBER
   46 ISIGN=2
      GO TO 48
C
C     DIGIT OR PERIOD STARTS NUMBER
   47 ISIGN=1
C
C     EVALUATE NUMBER
   48 CALL DAHEFT(IFLOAT,1,0,IBUFFR,MAXBFR,
     1LOWBFR,IDUMMY,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE)
C
C     STORE EVALUATED NUMBER
      IF(KIND.NE.0)GO TO 58
      IF(ISTATE.GE.0)GO TO 49
      IF(KMDTYP.LE.0)GO TO 52
   49 IF(MULTPL.NE.-2)GO TO 50
      NUMBLK=1
      MULTPL=0
      NUMNXT=NUMLOW+(NOTYET*INTRVL)
      NUMNOW=NUMNXT
   50 IF(NUMKNT.GE.NUMNOW)GO TO 51
      IF(NUMNOW.LE.NUMMAX)GO TO 53
   51 KIND=9
      GO TO 58
   52 KIND=5
      GO TO 58
   53 NUMKNT=NUMKNT+1
      IF(NUMKNT.GE.NUMNOW)GO TO 55
      NUMSIN(NUMKNT)=0
      IF(NUMKNT.GE.NUMNXT)NUMSIN(NUMKNT)=-1
      IF(IFLOAT.NE.0)GO TO 54
      NUMVAL(NUMKNT)=0
      GO TO 53
   54 VALNUM(NUMKNT)=0.0
      GO TO 53
   55 NUMSIN(NUMKNT)=ISIGN
      IF(IFLOAT.NE.0)GO TO 56
      NUMVAL(NUMKNT)=IVALUE
      GO TO 57
   56 VALNUM(NUMKNT)=VALUE
   57 IF(ISTATE.LT.0)GO TO 87
   58 IF(LOWBFR.GT.MAXBFR)GO TO 69
      KOMPAR=IBUFFR(LOWBFR)
      IF(KOMPAR.EQ.ISLASH)GO TO 59
      IF(KOMPAR.NE.ICOLON)GO TO 68
C
C     SLASH FOUND
   59 IF(KIND.NE.0)GO TO 62
      IF(ISTATE.GE.0)GO TO 60
      KIND=5
      GO TO 62
   60 IF(MULTPL.NE.-2)GO TO 61
      NUMBLK=1
      MULTPL=0
      NUMNXT=NUMLOW+(NOTYET*INTRVL)
      NUMNOW=NUMNXT
   61 NUMNOW=NUMNOW+NUMBLK
      IF(NUMNOW.GE.(NUMNXT+INTRVL))KIND=7
   62 LOWBFR=LOWBFR+1
      IF(LOWBFR.GT.MAXBFR)GO TO 69
      KOMPAR=IBUFFR(LOWBFR)
      IF(KOMPAR.EQ.IPLUS)GO TO 45
      IF(KOMPAR.EQ.IMINUS)GO TO 46
      IF(KOMPAR.EQ.IDOT)GO TO 47
      IF(KOMPAR.EQ.ISLASH)GO TO 59
      IF(KOMPAR.EQ.ICOLON)GO TO 59
      DO 63 I=1,10
      IF(KOMPAR.NE.IDIGIT(I))GO TO 63
      NUMBER=I-1
      GO TO 47
   63 CONTINUE
C
C     END OF RANGE SPECIFICATION
      IF(KIND.NE.0)GO TO 68
      IF(NUMKNT.GE.NUMNOW)GO TO 64
      IF(NUMNOW.LE.NUMMAX)GO TO 65
   64 KIND=9
      GO TO 68
   65 NUMKNT=NUMKNT+1
      IF(IFLOAT.NE.0)GO TO 66
      NUMVAL(NUMKNT)=0
      GO TO 67
   66 VALNUM(NUMKNT)=0.0
   67 NUMSIN(NUMKNT)=0
      IF(NUMKNT.GE.NUMNXT)NUMSIN(NUMKNT)=-1
      IF(NUMKNT.LT.NUMNOW)GO TO 65
   68 IF(MULTPL.NE.0)NUMBLK=0
   69 LOWBFR=LOWBFR-1
      LMTPRT=LOWBFR
      ISTATE=3
      IF(MULTPL.EQ.0)GO TO 85
      GO TO 15
C
C     **********
C     *        *
C     *  WORD  *
C     *        *
C     **********
C
C     SEARCH FOR END OF WORD
   70 IF(ISTATE.LE.0)GO TO 72
      IF(JMLTPL.GT.0)GO TO 26
      INILTR=LOWBFR
      GO TO 73
   71 LOWBFR=LOWBFR-1
   72 KIND=-1
   73 IF(LOWBFR.GE.MAXBFR)GO TO 76
      LOWBFR=LOWBFR+1
      KOMPAR=IBUFFR(LOWBFR)
      DO 74 I=1,13
      IF(KOMPAR.EQ.ISEPAR(I))GO TO 75
   74 CONTINUE
      GO TO 73
   75 LOWBFR=LOWBFR-1
C
C     STORE DESCRIPTION OF WORD
   76 LMTPRT=LOWBFR
      IF(KIND.EQ.0)GO TO 77
      IF(KIND.GT.0)GO TO 82
      KIND=6
      MIDPRT=LMTPRT
      GO TO 82
   77 IF(MULTPL.NE.-2)GO TO 78
      MULTPL=-1
      NAMNXT=NAMLOW+NOTYET
   78 IF(NAMKNT.GE.NAMNXT)GO TO 79
      IF(NAMNXT.LE.NAMMAX)GO TO 80
   79 KIND=8
      GO TO 82
   80 NAMKNT=NAMKNT+1
      IF(NAMKNT.GE.NAMNXT)GO TO 81
      NAMLFT(NAMKNT)=1
      NAMRIT(NAMKNT)=0
      GO TO 80
   81 NAMLFT(NAMKNT)=INILTR
      NAMRIT(NAMKNT)=LMTPRT
      IF(MULTPL.EQ.0)GO TO 82
      IF(NUMKNT.GE.NUMLOW)NUMBLK=0
   82 ISTATE=3
      IF(MULTPL.LT.0)GO TO 84
      GO TO 15
C
C     ***********************
C     *                     *
C     *  PUNCTUATION MARKS  *
C     *                     *
C     ***********************
C
C     COMMA FOUND
   83 LMTPRT=LOWBFR
      IF(ISTATE.LT.0)KIND=5
      IF(ISTATE.EQ.3)GO TO 14
      ISTATE=2
      IF(MULTPL.GT.0)GO TO 86
      IF(MULTPL.EQ.0)GO TO 85
      IF(MULTPL.EQ.-1)GO TO 84
      NOTYET=NOTYET+1
      GO TO 15
C
C     INCREMENT SEQUENCE NUMBER OF NEXT SERIES ITEM
   84 NAMNXT=NAMNXT+1
      GO TO 15
   85 NUMNXT=NUMNXT+INTRVL
      NUMNOW=NUMNXT
      GO TO 15
   86 MRKNXT=MRKNXT+1
      GO TO 15
C
C     INITIAL NUMBER FOUND
   87 KIND=4
      MIDPRT=LOWBFR
      LOWBFR=MAXBFR+1
      LMTPRT=LOWBFR
   88 LMTPRT=LMTPRT-1
      IF(LMTPRT.LT.MIDPRT)GO TO 95
      IF(IBUFFR(LMTPRT).EQ.IBLANK)GO TO 88
      IF(IBUFFR(LMTPRT).EQ.ITAB)GO TO 88
      GO TO 95
C
C     COMMENT
   89 LOWBFR=MAXBFR+1
      IF(ISTATE.EQ.-1)GO TO 90
      IF(ISTATE.NE.1)GO TO 94
   90 IF(INIKND.LE.1)GO TO 93
      KIND=1
      GO TO 95
C
C     SEMICOLON
   91 IF(ISTATE.EQ.-1)GO TO 92
      IF(ISTATE.NE.1)GO TO 94
   92 IF(INIKND.GT.1)GO TO 1
   93 KIND=2
      GO TO 95
C
C     RETURN TO CALLING PROGRAM
   94 IF(KIND.GE.7)GO TO 96
      IF(KIND.NE.0)GO TO 95
      KIND=3
      GO TO 96
   95 KOMAND=0
   96 RETURN
C395642931348!;':
      END
      SUBROUTINE DAIHST(KMDTYP,LSTTYP,NAMLOW,NAMMAX,MRKLOW,
     1    MRKMAX,NUMLOW,NUMMAX,INTRVL,LOWWRD,MAXWRD,IWORD ,
     2    LOWKNT,MAXKNT,KNTLTR,LEGAL ,MAXBFR,IBUFFR,LOWBFR,
     3    KIND  ,KOMAND,LCNWRD,LCNKNT,INIPRT,MIDPRT,LMTPRT,
     4    NAMKNT,NAMLFT,NAMRIT,MRKKNT,MRKLFT,MRKRIT,NUMKNT,
     5    NUMSIN,NUMVAL)
C     RENBR(/PARSER OF SIMPLE COMMANDS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAHEST AND DAIHST INTERPRET SIMPLE COMMANDS TYPED  BY
C     THE USER AND READ INTO A BUFFER ARRAY WITH A MULTIPLE
C     OF AN A1 FORMAT.  THE COMMANDS CONSIST OF  A  COMMAND
C     WORD,  OR  UNIQUE ABREVIATION THEREOF, FOLLOWED BY AN
C     ARGUMENT LIST FORMED OF NUMBERS, ALPHABETIC WORDS AND
C     QUOTED   TEXT   STRINGS.   THE  LINE  OF  TEXT  BEING
C     EVALUATED CAN CONTAIN  SEVERAL  STATEMENTS  IF  THESE
C     STATEMENTS  ARE SEPARATED BY THE SEMICOLON CHARACTER.
C     THE BUFFER CAN ALSO CONTAIN A COMMENT INDICATED BY AN
C     EXCLAMATION POINT TO THE LEFT OF THE COMMENT.
C
C     DAHEST OR DAIHST IS  CALLED  ONCE  TO  EVALUATE  EACH
C     STATEMENT.   THE  CALLING  PROGRAM  INDICATES  TO THE
C     ROUTINE THE POSITION IN THE BUFFER  OF  THE  LEFTMOST
C     CHARACTER  WHICH  HAS  NOT  YET  BEEN EVALUATED.  THE
C     ROUTINE MOVES THIS POINTER  THROUGH  THE  BUFFER  AND
C     RETURNS  IT  TO  THE  CALLING  PROGRAM SPECIFYING THE
C     LEFTMOST CHARACTER TO BE EVALUATED BY THE  NEXT  CALL
C     TO  THE  ROUTINE.   AFTER  THIS  ROUTINE  HAS FINALLY
C     INDICATED THAT NOTHING MORE REMAINS TO  BE  PROCESSED
C     IN THE LINE OF TEXT CONTAINED IN THE BUFFER, THEN THE
C     CALLING PROGRAM MUST READ ANOTHER LINE WHICH IS TO BE
C     INTERPRETED,  AND  MUST RESET THE POINTER TO INDICATE
C     THE START OF THE BUFFER BEFORE THE NEXT CALL  TO  THE
C     ROUTINE.
C
C     DAHEST CAN EVALUATE BOTH REAL NUMBERS  AND  INTEGERS.
C     EITHER FORM CAN BE SPECIFIED IN FLOATING POINT FORMAT
C     WITH FOLLOWING E EXPONENT OR WITH FOLLOWING %, K OR M
C     TO  INDICATE  E-2,  E3  AND  E6 RESPECTIVELY.  IF THE
C     PROGRAM WHICH  CALLS  DAHEST  DOES  NOT  REQUIRE  THE
C     EVALUATION  OF  REAL  NUMBERS  AND DOES NOT OTHERWISE
C     CALL DAHEFT, AND IF THE SPECIFICATION OF INTEGERS  IN
C     EXPONENT  FORM  IS  NOT  NECESSARY,  THEN THE ROUTINE
C     DAIHST SHOULD BE CALLED INSTEAD OF DAHEST.   ALTHOUGH
C     THE  ROUTINES  ARE  OF APPROXIMATELY THE SAME LENGTH,
C     DAIHST DOES NOT CALL DAHEFT FOR  NUMERIC  EVALUATION.
C     NUMBERS  EVALUATED  BY  DAIHST  MUST  CONSIST ONLY OF
C     DIGITS FOLLOWING THE OPTIONAL SIGN.  NUMBERS  CAN  BE
C     SEPARATED   BY  SLASHES  (OR  BY  COLONS,  THESE  TWO
C     CHARACTERS  BEING  EQUIVALENT)  IF  THEY  ARE  TO  BE
C     ASSOCIATED IN SOME MANNER, SUCH AS SPECIFYING A RANGE
C     AND INCREMENT.  BOTH THE SIGN AND  THE  SIGNED  VALUE
C     ARE RETURNED TO THE CALLING PROGRAM.
C
C     TEXT  STRINGS  ARE  PRECEDED  AND  FOLLOWED  BY   THE
C     APOSTROPHE.  IF AN APOSTROPHE MUST APPEAR IN THE TEXT
C     STRING  ITSELF,  THEN  AN  EXTRA  APPEARANCE  OF  THE
C     APOSTROPHE  MUST  PRECEDE  THE  ONE  WHICH  IS  TO BE
C     TREATED MERELY AS TEXT.  THE LOCATIONS OF  THE  START
C     AND END OF THE TEXT INSIDE THE DELIMITING APOSTROPHES
C     ARE RETURNED TO THE CALLING PROGRAM,  AND  THE  EXTRA
C     APOSTROPHES  WITHIN THE TEXT STRING ARE EXPUNGED FROM
C     THE INPUT BUFFER.
C
C     TEXT STRINGS CAN ALSO BE  DELIMITED  BY  PARENTHESES.
C     IF  THE  TEXT  STRING  STARTS  WITH  A  LEADING  LEFT
C     PARENTHESIS, THEN IT WILL BE TERMINATED BY A MATCHING
C     TRAILING  RIGHT  PARENTHESIS.   IF  THE  TEXT  STRING
C     STARTS WITH A LEADING RIGHT PARENTHESIS, THEN IT WILL
C     BE   TERMINATED   BY   A   MATCHING   TRAILING   LEFT
C     PARENTHESIS.  WITHIN THE PARENTHESES,  AN  APOSTROPHE
C     CAN  APPEAR  IN  FRONT  OF ANY CHARACTER, INCLUDING A
C     PARENTHESIS OR ANOTHER APOSTROPHE, TO  INDICATE  THAT
C     THIS  FOLLOWING  CHARACTER  IS  TO  HAVE  NO  SPECIAL
C     MEANING.  IF FOUND, THE APOSTROPHE  IS  LEFT  IN  THE
C     TEXT  STRING.  IF THE TYPE OF TEXT STRING HAS MEANING
C     TO THE PROGRAM, THEN  THE  PROGRAM  SHOULD  TEST  THE
C     CHARACTER  WHICH  IS  IMMEDIATELY  TO THE LEFT OF THE
C     CONTENTS OF THE TEXT  STRING  TO  DETERIMINE  WHETHER
C     THIS   IS   AN  APOSTROPHE  OR  A  LEFT  OR  A  RIGHT
C     PARENTHESIS.
C
C     A WORD APPEARING AS AN ARGUMENT  OF  A  COMMAND  MUST
C     BEGIN  WITH  A  CHARACTER WHICH CANNOT START A NUMBER
C     AND WHICH IS NOT ONE OF THE DELIMITER CHARACTERS SUCH
C     AS   THE   SPACE,   TAB,   SLASH,  COLON,  SEMICOLON,
C     EXCLAMATION POINT, COMMA OR APOSTROPHE.   DIGITS  CAN
C     APPEAR ANYWHERE TO THE RIGHT OF THE LEADING CHARACTER
C     OF THE WORD,  BUT  THE  OTHER  PROHIBITED  CHARACTERS
C     WILL,   IF  ENCOUNTERED,  TERMINATE  THE  WORD.   THE
C     LOCATIONS OF THE  START  AND  END  OF  THE  WORD  ARE
C     RETURNED TO THE CALLING PROGRAM.
C
C     ONE, BUT ONLY ONE, OF THE THREE  TYPES  OF  ARGUMENTS
C     CAN  BE  USED  MORE THAN ONCE AS AN ARGUMENT.  IF THE
C     TYPE OF ARGUMENT WHICH CAN BE REPEATED  IS  SPECIFIED
C     BEFORE  THE FIRST ARGUMENT IS FOUND, EITHER BEING THE
C     SAME  FOR  ALL  COMMANDS,  OR  ELSE  BEING  SPECIFIED
C     SEPARATELY  IN  THE DICTIONARY FOR EACH COMMAND, THEN
C     ARGUMENTS OF THE OTHER TWO TYPES CAN APPEAR  AT  MOST
C     ONCE IN THE ARGUMENT LIST.  IF THE REPEATABLE TYPE IS
C     WORD OR TEXT STRING, THEN A SET OF NUMBERS INDICATING
C     A  RANGE  CAN  STILL  BE SUPPLIED.  IF THE REPEATABLE
C     TYPE IS NUMERIC, THEN MORE THAN ONE  SET  OF  NUMBERS
C     INDICATING  RANGES  WILL BE ACCEPTED.  ALTERNATIVELY,
C     THE TYPE OF ARGUMENT WHICH CAN BE REPEATED CAN BE THE
C     TYPE OF THE FIRST ARGUMENT ENCOUNTERED, IN WHICH CASE
C     ARGUMENTS OF THE OTHER TWO TYPES ARE NOT  ALLOWED  IN
C     THE ARGUMENT LIST.
C
C     ANY NUMBER OF SPACES AND/OR TAB CHARACTERS CAN APPEAR
C     BEFORE  THE COMMAND WORD AND BETWEEN THE COMMAND WORD
C     AND ITS FIRST ARGUMENT.  SUCCESSIVE ARGUMENTS CAN  BE
C     SEPARATED  BY  A SINGLE COMMA AND/OR BY ANY NUMBER OF
C     SPACES  AND/OR   TAB   CHARACTERS.    NO   SEPARATING
C     CHARACTERS  ARE NECESSARY IF THE LEADING CHARACTER OF
C     AN ARGUMENT INDICATES THAT  IT  CANNOT  CONTINUE  THE
C     PRECEDING  COMMAND  WORD  OR  PRECEDING  ARGUMENT.  A
C     SINGLE COMMA APPEARING BETWEEN 2 ARGUMENTS OF  EITHER
C     THE  SAME  OR OF DIFFERENT TYPES MERELY INDICATES THE
C     SEPARATION BETWEEN THE  ARGUMENTS,  AND  IS  ENTIRELY
C     EQUIVALENT   TO   ONE   OR  MORE  SPACES  AND/OR  TAB
C     CHARACTERS.  TWO COMMAS, POSSIBLY SEPARATED BY SPACES
C     AND/OR BY TAB CHARACTERS, INDICATE A MISSING ARGUMENT
C     OF THE REPEATABLE TYPE.  A COMMA BETWEEN THE  COMMAND
C     WORD AND THE FIRST ARGUMENT IS TAKEN TO INDICATE THAT
C     THE FIRST ARGUMENT OF THE REPEATABLE TYPE IS MISSING.
C     FOR EXAMPLE, IN THE STATEMENTS
C
C          OPAQUE'=',,'*';INVISIBLE,'$'
C
C     THE QUOTED TEXT CHARACTER * IS THE THIRD ARGUMENT  OF
C     THE  COMMAND  WORD  OPAQUE, THE SECOND ARGUMENT BEING
C     MISSING, AND THE  QUOTED  TEXT  CHARACTER  $  IS  THE
C     SECOND  ARGUMENT  OF  THE COMMAND WORD INVISIBLE, THE
C     FIRST ARGUMENT BEING MISSING.
C
C     THE ARGUMENTS OF THE REPEATABLE TYPE ARE RETURNED  TO
C     THE CALLING PROGRAM IN THE ORDER IN WHICH THEY APPEAR
C     IN THE STATEMENT, AND,  IN  PARTICULAR,  THE  CALLING
C     PROGRAM IS ABLE TO DETERMINE WHETHER ANY ARE MISSING.
C     NO INFORMATION REGARDING ORDERING  BETWEEN  ARGUMENTS
C     OF   DIFFERENT  TYPES  IS  RETURNED  TO  THE  CALLING
C     PROGRAM.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY, AND  ARE
C     RETURNED UNCHANGED.
C
C     KMDTYP = 0, STATEMENT MUST START WITH COMMAND WORD.
C            = 1, STATEMENT CAN START WITH COMMAND WORD  OR
C              INTEGER.   IF INTEGER IS FOUND, RETURN VALUE
C              AS NUMVAL AND LOCATIONS OF  LEFT  AND  RIGHT
C              ENDS OF FOLLOWING TEXT AS MIDPRT AND LMTPRT.
C            = 2, SAME AS KMDTYP=1.
C            = -1, DO NOT LOOK FOR COMMAND WORD.   CONTENTS
C              OF  STATEMENT ARE EVALUATED AS ARGUMENT LIST
C              OF TYPE INDICATED BY LSTTYP.
C     LSTTYP = SPECIFIES TYPE OF ARGUMENT WHICH CAN  APPEAR
C              MORE THAN ONCE IN ARGUMENT LIST.
C            = -1, TYPE OF ARGUMENT LIST IS  SPECIFIED  FOR
C              EACH  COMMAND  BY LEGAL ARRAY VALUE PARALLEL
C              TO CHARACTER COUNT IN KNTLTR ARRAY.
C            = 0, NO ARGUMENTS ARE ALLOWED.
C            = 1, TYPE OF ARGUMENT WHICH CAN BE REPEATED IS
C              TYPE  OF FIRST ARGUMENT ENCOUNTERED, WHETHER
C              OR NOT THIS IS PRECEDED BY  COMMAS.   COMMAS
C              DO,  HOWEVER,  INDICATE MISSING ARGUMENTS OF
C              SAME  TYPE   AS   THAT   EVENTUALLY   FOUND.
C              ADDITIONAL  ARGUMENTS  OF  TYPES  OTHER THAN
C              THAT OF FIRST ARGUMENT ENCOUNTERED  ARE  NOT
C              ALLOWED.    IF  AN  ADDITIONAL  ARGUMENT  OF
C              ANOTHER TYPE IS FOUND,  THEN  EVALUATION  OF
C              ARGUMENT  LIST  WILL  BE  TERMINATED  EXCEPT
C              INSOFAR AS IS NECESSARY  TO  DETECT  END  OF
C              STATEMENT,   AND   KIND   WILL  BE  RETURNED
C              CONTAINING  ONE  OF  VALUES  8,  9   OR   10
C              INDICATING  TYPE  OF ILLEGAL ARGUMENT.  IF A
C              SET OF NUMBERS IS FOUND, IT IS EVALUATED  AS
C              A SET OF INTEGERS.
C            = 2, ALLOW SERIES OF WORDS.   TEXT  STRING  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 3, ALLOW SERIES OF SETS OF  INTEGERS.   TEXT
C              STRING OR WORD CAN APPEAR AT MOST ONCE.
C            = 4, ALLOW SERIES OF TEXT  STRINGS.   WORD  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 5, 6, 7 AND 8, SAME AS LSTTYP VALUES  OF  1,
C              2, 3 AND 4 RESPECTIVELY.
C            = 9, ONLY TYPE OF ARGUMENT  ACCEPTED  WILL  BE
C              PARENTHETICAL TEXT STRINGS, NOT TEXT STRINGS
C              DELIMITED    BY    APOSTROPHES.     PRINTING
C              CHARACTERS    IMMEDIATELY    TO    LEFT   OF
C              PARENTHETICAL EXPRESSION WILL BE TAKEN TO BE
C              PART  OF  THAT  EXPRESSION,  AND MRKLFT WILL
C              POINT TO LEFTMOST  OF  THESE.   UNLIKE  TEXT
C              STRINGS   ALLOWED  BY  ANY  OTHER  VALUE  OF
C              LSTTYP, LEADING PARENTHESIS IS POINTED TO BY
C              MRKLFT  IF  NO PRINTING CHARACTERS APPEAR TO
C              ITS LEFT.  MRKRIT  WILL  STILL  BE  RETURNED
C              POINTING  TO  CHARACTER  TO LEFT OF TRAILING
C              PARENTHESIS.
C     NAMLOW = SUBSCRIPT  OF  NAMLFT   AND   NAMRIT   ARRAY
C              LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C              FIRST WORD IN ARGUMENT LIST.
C     NAMMAX = MAXIMUM  SUBSCRIPT  OF  NAMLFT  AND   NAMRIT
C              ARRAYS.
C     MRKLOW = SUBSCRIPT  OF  MRKLFT   AND   MRKRIT   ARRAY
C              LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C              FIRST TEXT STRING IN ARGUMENT LIST.
C     MRKMAX = MAXIMUM  SUBSCRIPT  OF  MRKLFT  AND   MRKRIT
C              ARRAYS.
C     NUMLOW = SUBSCRIPT  OF  NUMSIN   AND   NUMVAL   ARRAY
C              LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C              FIRST NUMBER IN ARGUMENT LIST.
C     NUMMAX = MAXIMUM  SUBSCRIPT  OF  NUMSIN  AND   NUMVAL
C              ARRAYS.
C     INTRVL = MAXIMUM NUMBER OF NUMBERS IN SET OF  NUMBERS
C              SEPARATED   BY   SLASHES.    IF   2  NUMERIC
C              ARGUMENTS ARE SEPARATED BY  SOMETHING  OTHER
C              THAN SLASH, THEN THESE ARGUMENTS ARE PART OF
C              SERIES OF SETS OF NUMBERS,  AND  DESCRIPTION
C              OF  SECOND  NUMBER IS PLACED INTO NUMSIN AND
C              NUMVAL ARRAYS AT LOCATION  HAVING  SUBSCRIPT
C              GREATER BY VALUE OF INTRVL THAN SUBSCRIPT OF
C              LOCATION INTO WHICH WAS  PLACED  DESCRIPTION
C              OF FIRST NUMBER OF PREVIOUS SET.
C     LOWWRD = SUBSCRIPT OF LOCATION IN IWORD  ARRAY  WHICH
C              CONTAINS  1ST LETTER OF 1ST WORD.  NOTE THAT
C              IF KNTLTR(LOWKNT) IS NEGATIVE, THEN THE  1ST
C              LETTER  OF  1ST  WORD WILL BE FOUND IN ARRAY
C              LOCATION IWORD(LOWWRD-KNTLTR(LOWKNT)).
C     MAXWRD = DIMENSION OF IWORD ARRAY.
C     IWORD  = DICTIONARY ARRAY  CONTAINING  CHARACTERS  OF
C              COMMAND  WORDS WHICH ARE TO BE RECOGNIZED, 1
C              CHARACTER PER ARRAY LOCATION AS READ  BY  A1
C              FORMAT OR ELSE DEFINED BY 1H FIELD.  COMMAND
C              WORD IN INPUT  BUFFR  ARRAY  IBUFFR  CAN  BE
C              SPLIT  INTO  2 OR MORE PORTIONS SEPARATED BY
C              SPACES  AND/OR  TABS  AND  WILL  BE  MATCHED
C              WHETHER OR NOT SPACES OR TABS ARE PRESENT IF
C              WORD IN IWORD CONTAINS  A  SINGLE  SPACE  AT
C              LOCATION  AT  WHICH  SPLIT  IS  ALLOWED.  IN
C              ORDER TO OBTAIN A MATCH, CASES OF CHARACTERS
C              IN  DICTIONARY  AND  IN INPUT BUFFER MUST BE
C              IDENTICAL.  NOTE ALSO, THAT LETTERS E, M AND
C              K  USED WITHIN NUMBERS TO INDICATE EXPONENTS
C              MUST BE IN UPPER CASE  IN  INPUT  BUFFER  IN
C              ORDER TO BE RECOGNIZED.
C     LOWKNT = SUBSCRIPT OF KNTLTR ARRAY CONTAINING  LENGTH
C              OF  FIRST WORD WHICH CAN BE MATCHED IN IWORD
C              ARRAY.   THIS  FIRST  WORD  WILL  START   AT
C              IWORD(LOWWRD).
C     MAXKNT = SUBSCRIPT OF KNTLTR ARRAY CONTAINING  LENGTH
C              OF  FINAL WORD WHICH CAN BE MATCHED IN IWORD
C              ARRAY.
C     KNTLTR = ARRAY CONTAINING NUMBERS  OF  CHARACTERS  IN
C              WORDS  IN  IWORD  ARRAY.   ZERO  OR NEGATIVE
C              VALUE IN KNTLTR ARRAY OFFSETS NEXT  POSSIBLE
C              WORD  WHICH CAN BE MATCHED IN IWORD ARRAY BY
C              NUMBER OF LETTERS GIVEN BY ABSOLUTE VALUE OF
C              NEGATIVE  NUMBER IN KNTLTR ARRAY.  DIMENSION
C              OF KNTLTR MUST  BE  AT  LEAST  MAXKNT.   FOR
C              EXAMPLE TO RECOGNIZE WORDS
C
C                   YES, NO, MAYBE
C
C              CONTENTS OF IWORD ARRAY WOULD BE
C
C                   1HY,1HE,1HS,1HN,1HO,1HM,1HA,1HY,1HB,1HE
C
C              AND CONTENTS OF KNTLTR ARRAY WOULD BE
C
C                   3,2,5
C
C     LEGAL  = IF LSTTYP=-1, THEN LEGAL IS ARRAY SPECIFYING
C              FOR  EACH  POSSIBLE COMMAND WORD THE TYPE OF
C              ARGUMENT, WORD OR SET  OF  NUMBERS  OR  TEXT
C              STRING,  WHICH CAN BE PRESENT MORE THAN ONCE
C              IN ARGUMENT LIST.  TYPE OF ARGUMENT LIST  IS
C              AT   SAME   SUBSCRIPT   IN  LEGAL  ARRAY  AS
C              CHARACTER COUNT IN KNTLTR ARRAY.  IF  LSTTYP
C              IS  GREATER  THAN  OR  EQUAL  TO  ZERO, THEN
C              CONTENTS OF LEGAL ARRAY ARE IGNORED.
C            = 0, NO ARGUMENTS ARE ALLOWED.
C            = 1, TYPE OF ARGUMENT WHICH CAN BE REPEATED IS
C              TYPE  OF FIRST ARGUMENT ENCOUNTERED, WHETHER
C              OR NOT THIS IS PRECEDED BY  COMMAS.   COMMAS
C              DO,  HOWEVER,  INDICATE MISSING ARGUMENTS OF
C              SAME  TYPE   AS   THAT   EVENTUALLY   FOUND.
C              ADDITIONAL  ARGUMENTS  OF  TYPES  OTHER THAN
C              THAT OF FIRST ARGUMENT ENCOUNTERED  ARE  NOT
C              ALLOWED.    IF  AN  ADDITIONAL  ARGUMENT  OF
C              ANOTHER TYPE IS FOUND,  THEN  EVALUATION  OF
C              ARGUMENT  LIST  WILL  BE  TERMINATED  EXCEPT
C              INSOFAR AS IS NECESSARY  TO  DETECT  END  OF
C              STATEMENT,   AND   KIND   WILL  BE  RETURNED
C              CONTAINING  ONE  OF  VALUES  8,  9   OR   10
C              INDICATING  TYPE  OF ILLEGAL ARGUMENT.  IF A
C              SET OF NUMBERS IS FOUND, IT IS EVALUATED  AS
C              A SET OF INTEGERS.
C            = 2, ALLOW SERIES OF WORDS.   TEXT  STRING  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 3, ALLOW SERIES OF SETS OF  INTEGERS.   TEXT
C              STRING OR WORD CAN APPEAR AT MOST ONCE.
C            = 4, ALLOW SERIES OF TEXT  STRINGS.   WORD  OR
C              SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C            = 5, 6, 7 AND 8, SAME AS LEGAL ARRAY VALUES OF
C              1, 2, 3 AND 4 RESPECTIVELY.
C            = 9, ONLY TYPE OF ARGUMENT  ACCEPTED  WILL  BE
C              PARENTHETICAL TEXT STRINGS, NOT TEXT STRINGS
C              DELIMITED    BY    APOSTROPHES.     PRINTING
C              CHARACTERS    IMMEDIATELY    TO    LEFT   OF
C              PARENTHETICAL EXPRESSION WILL BE TAKEN TO BE
C              PART  OF  THAT  EXPRESSION,  AND MRKLFT WILL
C              POINT TO LEFTMOST  OF  THESE.   UNLIKE  TEXT
C              STRINGS   ALLOWED  BY  ANY  OTHER  VALUE  OF
C              LEGAL,  LEADING PARENTHESIS IS POINTED TO BY
C              MRKLFT  IF  NO PRINTING CHARACTERS APPEAR TO
C              ITS LEFT.  MRKRIT  WILL  STILL  BE  RETURNED
C              POINTING  TO  CHARACTER  TO LEFT OF TRAILING
C              PARENTHESIS.
C     MAXBFR = SUBSCRIPT   OF   IBUFFR    ARRAY    LOCATION
C              CONTAINING  RIGHTMOST  CHARACTER  IN CURRENT
C              LINE.
C
C     FOLLOWING ARGUMENTS  ARE  USED  FOR  BOTH  INPUT  AND
C     OUTPUT.
C
C     IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS  OF
C              LINE  BEING  INTERPRETED,  ONE CHARACTER PER
C              ARRAY LOCATION, AS READ BY  MULTIPLE  OF  A1
C              FORMAT.    IF   QUOTED  TEXT  STRING  ITSELF
C              CONTAINING APOSTROPHES IS  FOUND  IN  IBUFFR
C              ARRAY, THEN EXTRA APOSTROPHES NEEDED TO MARK
C              APOSTROPHES TO REMAIN IN TEXT ARE REMOVED BY
C              SHIFTING TO LEFT TEXT TO THEIR RIGHT.
C     LOWBFR = SUBSCRIPT IN IBUFFR ARRAY OF FIRST CHARACTER
C              TO   BE  INTERPRETED.   LOWBFR  IS  RETURNED
C              POINTING   TO   FIRST    CHARACTER    BEYOND
C              INTERPRETED STATEMENT.  IF SEMICOLON APPEARS
C              AT END OF STATEMENT, THEN LOWBFR IS RETURNED
C              POINTING  TO  SEMICOLON AND WILL BE ADVANCED
C              BEYOND SEMICOLON BY SUBSEQUENT CALL TO  THIS
C              ROUTINE.   IF  EXCLAMATION  POINT APPEARS AT
C              END OF STATEMENT, OR IF THERE  ARE  NO  MORE
C              PRINTING  CHARACTERS  TO RIGHT OF STATEMENT,
C              THEN LOWBFR IS RETURNED CONTAINING MAXBFR+1.
C     KIND   = MUST BE  SET  TO  ZERO  BY  CALLING  PROGRAM
C              BEFORE  THIS  ROUTINE  IS  FIRST  CALLED  TO
C              EVALUATE  LINE  OF  TEXT.   KIND   IS   THEN
C              RETURNED  DESCRIBING TYPE OF STATEMENT WHICH
C              WAS EVALUATED.  CALLING PROGRAM SHOULD RESET
C              KIND  TO  HAVE  VALUE  ZERO IF EVALUATION OF
C              CONTENTS OF LINE OF TEXT IS BEING  ABANDONED
C              BY  CALLING  PROGRAM BEFORE THIS ROUTINE HAS
C              INDICATED BY RETURNING KIND=1  THAT  IT  HAS
C              COMPLETED   EVALUATION   OF  LINE  OF  TEXT.
C              EXCEPT   FOR   THIS   INSTANCE   IN    WHICH
C              INTERPRETATION IS BEING ABANDONED BY CALLING
C              PROGRAM, VALUE OF KIND IS  OTHERWISE  PASSED
C              UNCHANGED   TO   SUBSEQUENT   CALL  TO  THIS
C              ROUTINE.
C            = 1,  (PROCESSING   COMPLETED)   RETURNED   IF
C              PREVIOUS   CALLS   TO   THIS   ROUTINE  HAVE
C              COMPLETED EVALUATION OF CONTENTS OF LINE  OF
C              TEXT.   CALLING PROGRAM SHOULD READ NEW LINE
C              OF TEXT AND RESET LOWBFR TO POINT  TO  FIRST
C              CHARACTER IN NEW TEXT.
C            = 2, (EMPTY STATEMENT)  RETURNED  IF  ORIGINAL
C              LINE   OF   TEXT   CONTAINED   NO   PRINTING
C              CHARACTERS OR CONTAINED LEADING  EXCLAMATION
C              POINT  INDICATING  THAT  CHARACTERS  TO  ITS
C              RIGHT FORMED COMMENT.  KIND IS ALSO RETURNED
C              SET   TO  2  IF  EXTRA  SEMICOLON  INDICATES
C              MISSING STATEMENT.
C            = 3, (CORRECT STATEMENT) RETURNED IF STATEMENT
C              WAS  NOT  EMPTY  AND  WAS  EVALUATED WITHOUT
C              ERRORS.  IF KMDTYP IS GREATER THAN OR  EQUAL
C              TO  ZERO,  THEN  KNOWN COMMAND WORD, OR ELSE
C              NONAMBIGUOUS ABBREVIATION THEREOF, WAS FOUND
C              AND  SEQUENCE  NUMBER  OF  THIS COMMAND WORD
C              WITHIN DICTIONARY IS RETURNED  AS  VALUE  OF
C              KOMAND.   IF  KMDTYP IS LESS THAN ZERO, THEN
C              KOMAND IS  RETURNED  WITH  VALUE  ZERO,  AND
C              STATEMENT  CONTAINED  AT LEAST COMMA, SLASH,
C              COLON OR ARGUMENT.
C            = 4, (INITIAL NUMBER) RETURNED  IF  KMDTYP  IS
C              GREATER  THAN  ZERO, AND IF NUMBER WAS FOUND
C              AT START OF STATEMENT.  MIDPRT  IS  RETURNED
C              CONTAINING  SUBSCRIPT WITHIN IBUFFR ARRAY OF
C              CHARACTER  TO  IMMEDIATE  RIGHT  OF  NUMBER.
C              LMTPRT   IS  RETURNED  CONTAINING  SUBSCRIPT
C              WITHIN IBUFFR ARRAY  OF  RIGHTMOST  PRINTING
C              CHARACTER WITHIN IBUFFR ARRAY.
C            = 5, (MISSING  COMMAND)  RETURNED  IF  COMMAND
C              WORD OR ELSE LEADING NUMBER WAS REQUIRED BUT
C              NOT FOUND, BUT STATEMENT IS NOT  EMPTY.   NO
C              ARGUMENT   DESCRIPTIONS   ARE   RETURNED  TO
C              CALLING PROGRAM.
C            = 6, (UNKNOWN  COMMAND)  RETURNED  IF  INITIAL
C              COMMAND  WORD  WAS  REQUIRED,  BUT STATEMENT
C              STARTS WITH SEQUENCE OF PRINTING  CHARACTERS
C              WHICH  COULD FORM COMMAND WORD, BUT WHICH DO
C              NOT MATCH WORD IN DICTIONARY, OR WHICH  FORM
C              AMBIGUOUS ABBREVIATION OF 2 OR MORE WORDS IN
C              DICTIONARY, OR WHICH DO MATCH SINGLE WORD IN
C              DICTIONARY  BUT  ARE FOLLOWED IMMEDIATELY BY
C              ADDITIONAL ALPHABETIC CHARACTERS OR  DIGITS.
C              INIPRT  AND  MIDPRT ARE RETURNED POINTING TO
C              LEFTMOST AND RIGHTMOST  CHARACTERS  IN  THIS
C              UNKNOWN    COMMAND    WORD.    NO   ARGUMENT
C              DESCRIPTIONS   ARE   RETURNED   TO   CALLING
C              PROGRAM.
C            = 7, 8, 9 OR 10 RETURNED IF MAXIMUM NUMBER  OF
C              ARGUMENTS  OF  SINGLE  TYPE  WAS EXCEEDED IN
C              ARGUMENT  LIST.   DESCRIPTION  OF   ARGUMENT
C              WHICH    EXCEEDED    LIMIT,   AS   WELL   AS
C              DESCRIPTIONS OF ANY ARGUMENTS TO ITS  RIGHT,
C              ARE   NOT   RETURNED   TO  CALLING  PROGRAM,
C              ALTHOUGH SCANNING OF STATEMENT CONTINUES  TO
C              DETERMINE ITS RIGHT END.
C            = 7, RETURNED IF TOO MANY  SLASHES  OR  COLONS
C              WERE ENCOUNTERED IN SET OF NUMBERS.
C            = 8, RETURNED IF TOO MANY WORDS WERE FOUND.
C            = 9, RETURNED IF TOO MANY SETS OF NUMBERS WERE
C              FOUND.
C            = 10, RETURNED IF TOO MANY TEXT  STRINGS  WERE
C              FOUND.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT.   THEIR
C     INPUT VALUES ARE IGNORED.
C
C     KOMAND = IF KIND IS RETURNED CONTAINING 3 OR RETURNED
C              CONTAINING  7  OR  GREATER,  THEN  KOMAND IS
C              SEQUENCE NUMBER OF COMMAND WORD  MATCHED  IN
C              IWORD  ARRAY.   IF  SECOND  COMMAND  WORD IS
C              MATCHED, THEN KOMAND IS RETURNED  CONTAINING
C              2.  SEQUENCE NUMBER DOES NOT INCLUDE LETTERS
C              SKIPPED OVER BY VALUE OF  LOWWRD,  AND  DOES
C              NOT INCLUDE LETTERS SKIPPED OVER BY NEGATIVE
C              VALUES IN KNTLTR ARRAY.  IF COMMAND WORD  IN
C              IWORD  ARRAY  IS  MATCHED,  THEN  KOMAND  IS
C              NUMBER OF VALUES IN KNTLTR ARRAY  WHICH  ARE
C              GREATER THAN ZERO STARTING AT KNTLTR(LOWKNT)
C              UP TO AND INCLUDING  KNTLTR  LOCATION  WHICH
C              CONTAINS  NUMBER  OF LETTERS IN COMMAND WORD
C              WHICH IS SUCCESSFULLY MATCHED.
C            = RETURNED CONTAINING ZERO IF A  COMMAND  WORD
C              WAS NOT MATCHED.
C     LCNWRD = IF KIND IS RETURNED CONTAINING EITHER 3 OR 7
C              OR GREATER AND KOMAND BEING RETURNED GREATER
C              THAN ZERO,  LCNWRD  IS  RETURNED  CONTAINING
C              SUBSCRIPT OF IWORD LOCATION CONTAINING FIRST
C              LETTER OF MATCHED WORD.  LCNWRD IS UNDEFINED
C              IF KOMAND IS RETURNED CONTAINING ZERO.
C     LCNKNT = IF KIND IS RETURNED CONTAINING EITHER 3 OR 7
C              OR GREATER AND KOMAND BEING RETURNED GREATER
C              THAN ZERO,  LNCKNT  IS  RETURNED  CONTAINING
C              SUBSCRIPT OF KNTLTR LOCATION CONTAINING WORD
C              LENGTH.  LCNKNT IS UNDEFINED  IF  KOMAND  IS
C              RETURNED CONTAINING ZERO.
C     INIPRT = RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY  LOCATION CONTAINING LEFTMOST PRINTING
C              CHARACTER IN STATEMENT IF KIND  IS  RETURNED
C              CONTAINING 3 OR GREATER.  INIPRT IS RETURNED
C              UNDEFINED IF KIND IS RETURNED SET TO  EITHER
C              1 OR 2.
C            = IF KIND IS RETURNED CONTAINING 6  INDICATING
C              THAT UNKNOWN COMMAND WORD WAS FOUND AT START
C              OF  STATEMENT,  THEN  INIPRT   IS   RETURNED
C              POINTING   TO   LEFT  CHARACTER  OF  UNKNOWN
C              COMMAND WORD.  MIDPRT WILL THEN BE  RETURNED
C              POINTING   TO  RIGHT  CHARACTER  OF  UNKNOWN
C              COMMAND WORD.
C     MIDPRT = RETURNED  UNDEFINED  IF  KIND  IS   RETURNED
C              CONTAINING ANY VALUE OTHER THAN 4 OR 6.
C            = IF  KMDTYP  WAS  INPUT  GREATER  THAN   ZERO
C              ALLOWING  INITIAL NUMBER IN PLACE OF INITIAL
C              COMMAND WORD, AND IF SUCH INITIAL NUMBER WAS
C              FOUND SO THAT KIND IS RETURNED CONTAINING 4,
C              THEN  MIDPRT   IS   RETURNED   POINTING   TO
C              CHARACTER  TO  IMMEDIATE  RIGHT  OF  NUMBER.
C              LMTPRT WILL THEN  BE  RETURNED  POINTING  TO
C              RIGHTMOST PRINTING CHARACTER ON LINE.
C            = IF KIND IS RETURNED CONTAINING 6  INDICATING
C              THAT UNKNOWN COMMAND WORD WAS FOUND AT START
C              OF  STATEMENT,  THEN  MIDPRT   IS   RETURNED
C              POINTING   TO  RIGHT  CHARACTER  OF  UNKNOWN
C              COMMAND WORD.
C     LMTPRT = RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY LOCATION CONTAINING RIGHTMOST PRINTING
C              CHARACTER IN STATEMENT IF KIND  IS  RETURNED
C              CONTAINING  3  OR  GREATER.  IF STATEMENT IS
C              FOLLOWED BY EITHER SEMICOLON OR  EXCLAMATION
C              POINT,  THEN  LMTPRT IS RETURNED POINTING TO
C              RIGHTMOST  PRINTING  CHARACTER  TO  LEFT  OF
C              SEMICOLON  OR  EXCLAMATION POINT.  LMTPRT IS
C              RETURNED UNDEFINED IF KIND IS  RETURNED  SET
C              TO EITHER 1 OR 2.
C            = IF  KMDTYP  WAS  INPUT  GREATER  THAN   ZERO
C              ALLOWING  INITIAL NUMBER IN PLACE OF INITIAL
C              COMMAND WORD, AND IF SUCH INITIAL NUMBER WAS
C              FOUND SO THAT KIND IS RETURNED CONTAINING 4,
C              THEN  LMTPRT   IS   RETURNED   POINTING   TO
C              RIGHTMOST PRINTING CHARACTER IN BUFFER.
C     NAMKNT = RETURNED CONTAINING HIGHEST  SUBSCRIPT  USED
C              IN   NAMLFT   AND  NAMRIT  ARRAYS  TO  STORE
C              LOCATIONS IN BUFFER  OF  ENDS  OF  WORDS  IN
C              ARGUMENT  LIST.   IF NO WORDS ARE FOUND THEN
C              NAMKNT IS RETURNED CONTAINING NAMLOW-1.
C     NAMLFT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF  LOCATIONS CONTAINING LEFT
C              CHARACTERS OF WORDS IN  ARGUMENT  LIST.   IF
C              SERIES  OF  WORDS  IS  ENABLED  BUT SOME ARE
C              INDICATED AS  MISSING  BY  EXTRA  COMMAS  IN
C              ARGUMENT  LIST, THEN FOR THESE MISSING WORDS
C              NAMRIT ARRAY WILL CONTAIN VALUES  LESS  THAN
C              THOSE IN NAMLFT ARRAY.
C     NAMRIT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF LOCATIONS CONTAINING RIGHT
C              CHARACTERS OF WORDS IN ARGUMENT LIST.
C     MRKKNT = RETURNED CONTAINING HIGHEST  SUBSCRIPT  USED
C              IN   MRKLFT   AND  MRKRIT  ARRAYS  TO  STORE
C              LOCATIONS IN BUFFER OF ENDS OF  QUOTED  TEXT
C              STRINGS IN ARGUMENT LIST.  IF NO QUOTED TEXT
C              STRINGS ARE FOUND THEN  MRKKNT  IS  RETURNED
C              CONTAINING MRKLOW-1.
C     MRKLFT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF  LOCATIONS CONTAINING LEFT
C              CHARACTERS   OF   QUOTED    TEXT    STRINGS.
C              CHARACTER  POINTED TO BY MRKLFT IS CHARACTER
C              TO IMMEDIATE RIGHT OF INITIAL APOSTROPHE  OR
C              OF  INITIAL PARENTHESIS.  IF LSTTYP=9, OR IF
C              LSTTYP=-1 AND LEGAL=9, THEN MRKLFT POINTS TO
C              LEFTMOST  PRINTING CHARACTER LEFT OF OPENING
C              PARENTHESIS OR TO OPENING PARENTHESIS ITSELF
C              IF   NOT  PRECEDED  BY  ANY  OTHER  PRINTING
C              CHARACTERS.  IF SERIES OF  TEXT  STRINGS  IS
C              ENABLED BUT SOME ARE INDICATED AS MISSING BY
C              EXTRA COMMAS  IN  ARGUMENT  LIST,  THEN  FOR
C              THESE MISSING TEXT STRINGS MRKRIT ARRAY WILL
C              CONTAIN VALUES 2 LESS THAN THOSE IN MRKLFT.
C     MRKRIT = ARRAY  RETURNED  CONTAINING  SUBSCRIPTS   IN
C              IBUFFR  ARRAY  OF LOCATIONS CONTAINING RIGHT
C              CHARACTERS  OF  QUOTED   TEXT   STRINGS   IN
C              ARGUMENT  LIST.   CHARACTER  POINTED  TO  BY
C              MRKRIT ARRAY IS CHARACTER TO IMMEDIATE  LEFT
C              OF  FINAL APOSTROPHE OR OF FINAL PARENTHESIS
C              AT RIGHT END OF QUOTED TEXT  STRING,  OR  IS
C              RIGHTMOST  PRINTING  CHARACTER ON LINE IF NO
C              FINAL APOSTROPHE  OR  FINAL  PARENTHESIS  IS
C              FOUND.
C     NUMKNT = RETURNED CONTAINING HIGHEST  SUBSCRIPT  USED
C              IN   NUMSIN   AND  NUMVAL  ARRAYS  TO  STORE
C              DESCRIPTION OF NUMERIC  ARGUMENTS  FOUND  IN
C              ARGUMENT  LIST.  IF NO NUMERIC ARGUMENTS ARE
C              FOUND  IN  ARGUMENT  LIST,  THEN  NUMKNT  IS
C              RETURNED CONTAINING NUMLOW-1.
C     NUMSIN = ARRAY  RETURNED  INDICATING  SIGN,  IF  ANY,
C              WHICH PRECEDED EACH NUMERIC ARGUMENT.  VALUE
C              OF ARGUMENT  IS  RETURNED  IN  NUMVAL  ARRAY
C              LOCATION  HAVING  SAME  SUBSCRIPT  AS NUMSIN
C              ARRAY LOCATION DESCRIBING SIGN.
C            = -1,  CORRESPONDING  NUMERIC   ARGUMENT   WAS
C              INDICATED  AS  MISSING  EITHER BY ABSENCE OF
C              NUMBER BEFORE SLASH OR COLON, BY ABSENCE  OF
C              NUMBER  AFTER  SLASH OR COLON, OR BY ABSENCE
C              OF  NUMBER  BETWEEN   SLASHES   OR   COLONS.
C              CORRESPONDING   VALUE  IN  NUMVAL  ARRAY  IS
C              RETURNED SET TO ZERO.
C            = 0,   RETURNED   IF   CORRESPONDING   NUMERIC
C              ARGUMENT  WAS  INDICATED  AS MISSING BY LESS
C              THAN INTRVL NUMBERS BEING INCLUDED IN SET OF
C              NUMBERS, OR BY 2 ADJACENT COMMAS IN ARGUMENT
C              LIST.
C            = 1, NUMERIC ARGUMENT WAS  EVALUATED,  BUT  NO
C              SIGN APPEARED TO ITS LEFT.
C            = 2, MINUS SIGN APPEARED TO  LEFT  OF  NUMERIC
C              ARGUMENT.
C            = 3, PLUS SIGN APPEARED  TO  LEFT  OF  NUMERIC
C              ARGUMENT.
C     NUMVAL = ARRAY RETURNED CONTAINING VALUES OF  NUMERIC
C              ARGUMENTS  EVALUATED  AS INTEGERS.  IF MINUS
C              SIGN PRECEDED NUMBER, THEN VALUE  IN  NUMVAL
C              IS NEGATIVE.
C
      DIMENSION IDIGIT(10),ISEPAR(12),IBUFFR(MAXBFR),
     1IWORD(MAXWRD),KNTLTR(MAXKNT),LEGAL(MAXKNT),
     2NAMLFT(NAMMAX),NAMRIT(NAMMAX),MRKLFT(MRKMAX),
     3MRKRIT(MRKMAX),NUMSIN(NUMMAX),NUMVAL(NUMMAX)
C
      EQUIVALENCE(IBLANK,ISEPAR(1)),(ITAB,ISEPAR(2)),
     1           (IQUOTE,ISEPAR(6)),(ILEFT,ISEPAR(7)),
     2           (IRIGHT,ISEPAR(8)),(ISLASH,ISEPAR(9)),
     3           (ICOLON,ISEPAR(10)),(IPLUS,ISEPAR(11)),
     4           (IMINUS,ISEPAR(12))
C
C     FIRST  CHARACTER  IN ISEPAR  ARRAY IS SPACE.   SECOND
C     CHARACTER IS TAB CHARACTER.   IF TAB CHARACTER IS NOT
C     AVAILABLE, THEN SECOND CHARACTER SHOULD BE SPACE ALSO
      DATA ISEPAR/1H ,1H	,
     11H!,1H;,1H,,1H',1H(,1H),1H/,1H:,1H+,1H-/
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     SET DEFAULT ARGUMENT COUNTS TO ZERO
      NUMKNT=NUMLOW-1
      MRKKNT=MRKLOW-1
      NAMKNT=NAMLOW-1
      INIKND=KIND
C
C     **********************
C     *                    *
C     *  SCAN FOR COMMAND  *
C     *                    *
C     **********************
C
C     LOOK FOR FIRST PRINTING CHARACTER
      GO TO 3
    1 INIKND=0
    2 LOWBFR=LOWBFR+1
    3 IF(LOWBFR.GT.MAXBFR)GO TO 86
      IF(IBUFFR(LOWBFR).EQ.IBLANK)GO TO 2
      IF(IBUFFR(LOWBFR).EQ.ITAB)GO TO 2
      INIPRT=LOWBFR
      MULTPL=LSTTYP
      IF(KMDTYP.LT.0)GO TO 6
C
C     TEST IF SEQUENCE OF PRINTING CHARACTERS IN DICTIONARY
      INILTR=LOWBFR
      CALL DAVERB(LOWWRD,MAXWRD,IWORD,LOWKNT,MAXKNT,
     1KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND,KOMAND,LCNWRD,
     2LCNKNT,LCNBFR)
      LMTPRT=LOWBFR-1
C
C     ENTIRE DICTIONARY HAS BEEN SEARCHED
      IF(KIND.GE.3)GO TO 4
C     NO COMMAND WORD, CHECK FOR LEADING NUMBER
      ISTATE=-1
      MULTPL=3
      GO TO 7
C     GET ARGUMENT LIST TYPE IF IN LEGAL ARRAY
    4 IF(LSTTYP.EQ.-1)MULTPL=LEGAL(LCNKNT)
      IF(KIND.LE.4)GO TO 5
C     AMBIGUOUS ABREVIATION, CHECK FOR REST OF WORD IF ANY
      KIND=-1
      GO TO 8
C     COMMAND FOUND BUT IS ERROR IF ADDITIONAL CHARACTERS
    5 ISTATE=0
      GO TO 7
C     NO COMMAND WAS TESTED FOR, SIMULATE LEADING SPACE
    6 ISTATE=1
      KOMAND=0
    7 KIND=0
C
C     MULTPL = -3, ALLOW NO ARGUMENTS
C            = -2, ALLOW MULTIPLE ARGUMENTS OF 1ST TYPE
C              FOUND
C            = -1, ALLOW MULTIPLE WORDS
C            = 0, ALLOW MULTIPLE NUMBERS
C            = 1, ALLOW MULTIPLE STRINGS
C
    8 JMLTPL=MULTPL-8
      LIMIT=12
      IF(JMLTPL.GT.0)LIMIT=8
      MULTPL=MULTPL-3
      IF(MULTPL.GT.1)MULTPL=MULTPL-4
      IF(MULTPL.GE.-1)GO TO 9
      NUMBLK=0
      MRKNXT=MRKKNT
      NAMNXT=NAMKNT
      NUMNXT=NUMKNT
      NOTYET=0
      GO TO 10
    9 NUMBLK=1
      NUMNXT=NUMLOW
      MRKNXT=MRKLOW
      NAMNXT=NAMLOW
   10 NUMNOW=NUMNXT
      IF(KIND.LT.0)GO TO 67
      GO TO 14
C
C     ************************
C     *                      *
C     *  SCAN FOR ARGUMENTS  *
C     *                      *
C     ************************
C
C     ISTATE = -1, NOTHING OR SPACE FOUND.  WILL ACCEPT
C              ONLY A LEADING NUMBER.
C            = 0, COMMAND FOUND, BUT NOT YET ANYTHING,
C              EVEN SPACES, AFTER IT.
C            = 1, NO COMMAND WAS LOOKED FOR, ONLY SPACES
C              HAVE YET BEEN FOUND, NOTHING ELSE
C            = 2, COMMA FOUND ANYWHERE, OR ELSE COMMAND
C              FOUND FOLLOWED BY SPACE.  ANOTHER COMMA WILL
C              INDICATE A MISSING ARGUMENT.
C            = 3, TERMINATED SINGLE ITEM
C
C     SPACE OR TAB CHARACTER FOUND
   11 IF(ISTATE.NE.0)GO TO 13
   12 ISTATE=2
C
C     TEST IF NEXT CHARACTER BEGINS ARGUMENT OR PUNCTUATION
   13 LOWBFR=LOWBFR+1
   14 IF(LOWBFR.GT.MAXBFR)GO TO 85
      KOMPAR=IBUFFR(LOWBFR)
      DO 15 I=1,LIMIT
      IF(KOMPAR.NE.ISEPAR(I))GO TO 15
      GO TO(11,11,85,87,79,17,29,29,57,57,43,44),I
   15 CONTINUE
      IF(JMLTPL.GT.0)GO TO 66
      IF(ISTATE.EQ.0)GO TO 68
      DO 16 I=1,10
      IF(KOMPAR.NE.IDIGIT(I))GO TO 16
      NUMBER=I-1
      GO TO 46
   16 CONTINUE
      GO TO 66
C
C     ************************
C     *                      *
C     *  QUOTED TEXT STRING  *
C     *                      *
C     ************************
C
C     APOSTROPHE STARTS TEXT STRING
   17 IF(JMLTPL.GT.0)GO TO 24
      INILTR=LOWBFR+1
      I=LOWBFR
      LMTPRT=LOWBFR
   18 IF(I.GE.MAXBFR)GO TO 20
      I=I+1
      LOWBFR=LOWBFR+1
      IBUFFR(LOWBFR)=IBUFFR(I)
      IF(IBUFFR(I).EQ.IBLANK)GO TO 18
      IF(IBUFFR(I).EQ.ITAB)GO TO 18
      LMTPRT=LOWBFR
      IF(IBUFFR(I).NE.IQUOTE)GO TO 18
      IF(I.GE.MAXBFR)GO TO 19
      IF(IBUFFR(I+1).NE.IQUOTE)GO TO 19
      I=I+1
      GO TO 18
   19 NONSPC=LMTPRT-1
      GO TO 21
   20 NONSPC=LMTPRT
   21 IF(LOWBFR.EQ.I)GO TO 37
      KOPY=LOWBFR
   22 IF(KOPY.GE.MAXBFR)GO TO 37
      KOPY=KOPY+1
      IF(I.GE.MAXBFR)GO TO 23
      I=I+1
      IBUFFR(KOPY)=IBUFFR(I)
      GO TO 22
   23 IBUFFR(KOPY)=IBLANK
      GO TO 22
C
C     SECTION PRIOR TO PARENTHETICAL EXPRESSION
   24 INILTR=LOWBFR
   25 KOMPAR=IBUFFR(LOWBFR)
      DO 26 I=1,8
      IF(KOMPAR.NE.ISEPAR(I))GO TO 26
      IF(I.LT.6)GO TO 28
      IF(I.GT.6)GO TO 30
      IF(LOWBFR.LT.MAXBFR)LOWBFR=LOWBFR+1
      GO TO 27
   26 CONTINUE
   27 LMTPRT=LOWBFR
      NONSPC=LOWBFR
      IF(LOWBFR.GE.MAXBFR)GO TO 37
      LOWBFR=LOWBFR+1
      GO TO 25
   28 LOWBFR=LOWBFR-1
      GO TO 37
C
C     PARENTHESIS STARTS TEXT STRING
   29 INILTR=LOWBFR
      IF(JMLTPL.LE.0)INILTR=INILTR+1
   30 LEVEL=0
      GO TO 32
   31 IF(LOWBFR.GE.MAXBFR)GO TO 36
      LOWBFR=LOWBFR+1
   32 KOMPAR=IBUFFR(LOWBFR)
      IF(KOMPAR.EQ.IBLANK)GO TO 31
      IF(KOMPAR.EQ.ITAB)GO TO 31
      LMTPRT=LOWBFR
      IF(KOMPAR.EQ.ILEFT)GO TO 33
      IF(KOMPAR.EQ.IRIGHT)GO TO 34
      IF(KOMPAR.NE.IQUOTE)GO TO 31
      IF(LOWBFR.GE.MAXBFR)GO TO 36
      LOWBFR=LOWBFR+1
      LMTPRT=LOWBFR
      GO TO 31
   33 LEVEL=LEVEL+1
      GO TO 35
   34 LEVEL=LEVEL-1
   35 IF(LEVEL.NE.0)GO TO 31
      NONSPC=LMTPRT-1
      GO TO 37
   36 NONSPC=LMTPRT
C
C     STORE THE TEXT STRING
   37 IF(ISTATE.LT.0)KIND=5
      IF(KIND.NE.0)GO TO 42
      IF(MULTPL.NE.-2)GO TO 38
      MULTPL=1
      MRKNXT=MRKLOW+NOTYET
   38 IF(MRKKNT.GE.MRKNXT)GO TO 39
      IF(MRKNXT.LE.MRKMAX)GO TO 40
   39 KIND=10
      GO TO 42
   40 MRKKNT=MRKKNT+1
      IF(MRKKNT.GE.MRKNXT)GO TO 41
      MRKLFT(MRKKNT)=1
      MRKRIT(MRKKNT)=-1
      GO TO 40
   41 MRKLFT(MRKKNT)=INILTR
      MRKRIT(MRKKNT)=NONSPC
      IF(MULTPL.EQ.0)GO TO 42
      IF(NUMKNT.GE.NUMLOW)NUMBLK=0
   42 ISTATE=3
      IF(MULTPL.GT.0)GO TO 82
      GO TO 13
C
C     ****************************
C     *                          *
C     *  NUMBER OR NUMBER RANGE  *
C     *                          *
C     ****************************
C
C     PLUS SIGN STARTS NUMBER
   43 ISIGN=3
      GO TO 45
C
C     MINUS SIGN STARTS NUMBER
   44 ISIGN=2
   45 NUMBER=0
      GO TO 47
C
C     DIGIT STARTS NUMBER
   46 ISIGN=1
C
C     EVALUATE NUMBER
   47 LOWBFR=LOWBFR+1
      IF(LOWBFR.GT.MAXBFR)GO TO 49
      KOMPAR=IBUFFR(LOWBFR)
      DO 48 I=1,10
      IF(KOMPAR.NE.IDIGIT(I))GO TO 48
      NUMBER=(10*NUMBER)+I-1
      GO TO 47
   48 CONTINUE
   49 IF(ISIGN.EQ.2)NUMBER=-NUMBER
C
C     STORE EVALUATED NUMBER
      IF(KIND.NE.0)GO TO 56
      IF(ISTATE.GE.0)GO TO 50
      IF(KMDTYP.LE.0)GO TO 53
   50 IF(MULTPL.NE.-2)GO TO 51
      NUMBLK=1
      MULTPL=0
      NUMNXT=NUMLOW+(NOTYET*INTRVL)
      NUMNOW=NUMNXT
   51 IF(NUMKNT.GE.NUMNOW)GO TO 52
      IF(NUMNOW.LE.NUMMAX)GO TO 54
   52 KIND=9
      GO TO 56
   53 KIND=5
      GO TO 56
   54 NUMKNT=NUMKNT+1
      IF(NUMKNT.GE.NUMNOW)GO TO 55
      NUMSIN(NUMKNT)=0
      IF(NUMKNT.GE.NUMNXT)NUMSIN(NUMKNT)=-1
      NUMVAL(NUMKNT)=0
      GO TO 54
   55 NUMSIN(NUMKNT)=ISIGN
      NUMVAL(NUMKNT)=NUMBER
      IF(ISTATE.LT.0)GO TO 83
   56 IF(LOWBFR.GT.MAXBFR)GO TO 65
      IF(KOMPAR.EQ.ISLASH)GO TO 57
      IF(KOMPAR.NE.ICOLON)GO TO 64
C
C     SLASH FOUND
   57 IF(KIND.NE.0)GO TO 60
      IF(ISTATE.GE.0)GO TO 58
      KIND=5
      GO TO 60
   58 IF(MULTPL.NE.-2)GO TO 59
      NUMBLK=1
      MULTPL=0
      NUMNXT=NUMLOW+(NOTYET*INTRVL)
      NUMNOW=NUMNXT
   59 NUMNOW=NUMNOW+NUMBLK
      IF(NUMNOW.GE.(NUMNXT+INTRVL))KIND=7
   60 LOWBFR=LOWBFR+1
      IF(LOWBFR.GT.MAXBFR)GO TO 65
      KOMPAR=IBUFFR(LOWBFR)
      IF(KOMPAR.EQ.IPLUS)GO TO 43
      IF(KOMPAR.EQ.IMINUS)GO TO 44
      IF(KOMPAR.EQ.ISLASH)GO TO 57
      IF(KOMPAR.EQ.ICOLON)GO TO 57
      DO 61 I=1,10
      IF(KOMPAR.NE.IDIGIT(I))GO TO 61
      NUMBER=I-1
      GO TO 46
   61 CONTINUE
C
C     END OF RANGE SPECIFICATION
      IF(KIND.NE.0)GO TO 64
      IF(NUMKNT.GE.NUMNOW)GO TO 62
      IF(NUMNOW.LE.NUMMAX)GO TO 63
   62 KIND=9
      GO TO 64
   63 NUMKNT=NUMKNT+1
      NUMVAL(NUMKNT)=0
      NUMSIN(NUMKNT)=0
      IF(NUMKNT.GE.NUMNXT)NUMSIN(NUMKNT)=-1
      IF(NUMKNT.LT.NUMNOW)GO TO 63
   64 IF(MULTPL.NE.0)NUMBLK=0
   65 LOWBFR=LOWBFR-1
      LMTPRT=LOWBFR
      ISTATE=3
      IF(MULTPL.EQ.0)GO TO 81
      GO TO 13
C
C     **********
C     *        *
C     *  WORD  *
C     *        *
C     **********
C
C     SEARCH FOR END OF WORD
   66 IF(ISTATE.LE.0)GO TO 68
      IF(JMLTPL.GT.0)GO TO 24
      INILTR=LOWBFR
      GO TO 69
   67 LOWBFR=LOWBFR-1
   68 KIND=-1
   69 IF(LOWBFR.GE.MAXBFR)GO TO 72
      LOWBFR=LOWBFR+1
      KOMPAR=IBUFFR(LOWBFR)
      DO 70 I=1,12
      IF(KOMPAR.EQ.ISEPAR(I))GO TO 71
   70 CONTINUE
      GO TO 69
   71 LOWBFR=LOWBFR-1
C
C     STORE DESCRIPTION OF WORD
   72 LMTPRT=LOWBFR
      IF(KIND.EQ.0)GO TO 73
      IF(KIND.GT.0)GO TO 78
      KIND=6
      MIDPRT=LMTPRT
      GO TO 78
   73 IF(MULTPL.NE.-2)GO TO 74
      MULTPL=-1
      NAMNXT=NAMLOW+NOTYET
   74 IF(NAMKNT.GE.NAMNXT)GO TO 75
      IF(NAMNXT.LE.NAMMAX)GO TO 76
   75 KIND=8
      GO TO 78
   76 NAMKNT=NAMKNT+1
      IF(NAMKNT.GE.NAMNXT)GO TO 77
      NAMLFT(NAMKNT)=1
      NAMRIT(NAMKNT)=0
      GO TO 76
   77 NAMLFT(NAMKNT)=INILTR
      NAMRIT(NAMKNT)=LMTPRT
      IF(MULTPL.EQ.0)GO TO 78
      IF(NUMKNT.GE.NUMLOW)NUMBLK=0
   78 ISTATE=3
      IF(MULTPL.LT.0)GO TO 80
      GO TO 13
C
C     ***********************
C     *                     *
C     *  PUNCTUATION MARKS  *
C     *                     *
C     ***********************
C
C     COMMA FOUND
   79 LMTPRT=LOWBFR
      IF(ISTATE.LT.0)KIND=5
      IF(ISTATE.EQ.3)GO TO 12
      ISTATE=2
      IF(MULTPL.GT.0)GO TO 82
      IF(MULTPL.EQ.0)GO TO 81
      IF(MULTPL.EQ.-1)GO TO 80
      NOTYET=NOTYET+1
      GO TO 13
C
C     INCREMENT SEQUENCE NUMBER OF NEXT SERIES ITEM
   80 NAMNXT=NAMNXT+1
      GO TO 13
   81 NUMNXT=NUMNXT+INTRVL
      NUMNOW=NUMNXT
      GO TO 13
   82 MRKNXT=MRKNXT+1
      GO TO 13
C
C     INITIAL NUMBER FOUND
   83 KIND=4
      MIDPRT=LOWBFR
      LOWBFR=MAXBFR+1
      LMTPRT=LOWBFR
   84 LMTPRT=LMTPRT-1
      IF(LMTPRT.LT.MIDPRT)GO TO 91
      IF(IBUFFR(LMTPRT).EQ.IBLANK)GO TO 84
      IF(IBUFFR(LMTPRT).EQ.ITAB)GO TO 84
      GO TO 91
C
C     COMMENT
   85 LOWBFR=MAXBFR+1
      IF(ISTATE.EQ.-1)GO TO 86
      IF(ISTATE.NE.1)GO TO 90
   86 IF(INIKND.LE.1)GO TO 89
      KIND=1
      GO TO 91
C
C     SEMICOLON
   87 IF(ISTATE.EQ.-1)GO TO 88
      IF(ISTATE.NE.1)GO TO 90
   88 IF(INIKND.GT.1)GO TO 1
   89 KIND=2
      GO TO 91
C
C     RETURN TO CALLING PROGRAM
   90 IF(KIND.GE.7)GO TO 92
      IF(KIND.NE.0)GO TO 91
      KIND=3
      GO TO 92
   91 KOMAND=0
   92 RETURN
C282231723876!;':
      END
      SUBROUTINE DAIRNK(INCRES,IFTEST,MINMUM,MAXMUM,MINSTR,
     1    MAXSTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MAXUSD,ISTORE)
C     RENBR(/RETURNS SORTED INTEGERS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAIRNK RETURNS A GROUP OF INTEGERS SORTED INTO EITHER
C     INCREASING  OR  DECREASING ORDER.  DUPLICATES ARE NOT
C     RETURNED.
C
C     INCRES = 1,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              DECREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              SMALLER VALUES ARE DISCARDED.
C            = 2,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              DECREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              LARGER VALUES ARE DISCARDED.
C            = 3,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              INCREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              SMALLER VALUES ARE DISCARDED.
C            = 4,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              INCREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              LARGER VALUES ARE DISCARDED.
C     IFTEST = -2 OR 2, THERE ARE NO  MINIMUM  AND  MAXIMUM
C              LIMITS TO RANGE OF LEGAL VALUES.
C            = -1, REJECT VALUES LESS THAN MINMUM.
C            = 0, REJECT VALUES LESS THAN MINMUM OR GREATER
C              THAN MAXMUM.
C            = 1, REJECT VALUES GREATER THAN MAXMUM.
C     MINMUM = LOWER LIMIT OF ALLOWED VALUES IF  IFTEST  IS
C              -1  OR  0.   VALUES LESS THAN MINMUM ARE NOT
C              RETURNED IN ISTORE IF IFTEST IS -1 OR 0.
C     MAXMUM = UPPER LIMIT OF ALLOWED VALUES IF IFTEST IS 0
C              OR  1.   VALUES  GREATER THAN MAXMUM ARE NOT
C              RETURNED IN ISTORE IF IFTEST IS 0 OR 1.
C     MINSTR = SUBSCRIPT OF LOWEST LOCATION IN ISTORE ARRAY
C              INTO WHICH VALUE CAN BE PLACED.
C     MAXSTR = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  ISTORE
C              ARRAY INTO WHICH VALUE CAN BE PLACED.
C     IBUFFR = INPUT TEXT BUFFER CONTAINING 1 CHARACTER PER
C              ARRAY  LOCATION  AS  READ  BY MULTIPLE OF A1
C              FORMAT.
C     MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR  ARRAY  LOCATION
C              TO BE SEARCHED FOR CHARACTERS.
C     LOWBFR = INPUT CONTAINING SUBSCRIPT OF  IBUFFR  ARRAY
C              LOCATION  CONTAINING  FIRST  CHARACTER TO BE
C              TESTED.   LOWBFR  IS   RETURNED   CONTAINING
C              SUBSCRIPT    OF    IBUFFR   ARRAY   LOCATION
C              CONTAINING NEXT CHARACTER NOT YET EVALUATED.
C     KIND   = SHOULD BE INPUT  CONTAINING  ZERO  (OR  ONE)
C              WHENEVER  THIS ROUTINE IS CALLED TO GENERATE
C              NEW  GROUP  OF  SORTED  NUMBERS.   KIND   IS
C              RETURNED  DESCRIBING  REASON  FOR  RETURN TO
C              CALLING  PROGRAM.   IF  KIND   IS   RETURNED
C              CONTAINING  VALUE  OF  3  OR GREATER, AND IS
C              SENT  TO  SUBSEQUENT  CALL  UNCHANGED,  THEN
C              MAXUSD  IS  NOT  RESET  TO MINSTR-1, AND NEW
C              VALUES ARE APPENDED TO OLD CONTENTS, IF ANY,
C              OF ISTORE.
C            = 1, RETURNED EITHER IF NO PRINTING CHARACTERS
C              ARE  FOUND BEYOND NUMBERS, OR IF EXCLAMATION
C              POINT  IS  NEXT  CHARACTER  BEYOND  NUMBERS.
C              LOWBFR  IS  RETURNED  POINTING BEYOND END OF
C              BUFFER.
C            = 2, RETURNED IF SEMICOLON WAS FOUND  AS  NEXT
C              PRINTING  CHARACTER  BEYOND NUMBERS.  LOWBFR
C              IS  RETURNED  POINTING  TO  NEXT   CHARACTER
C              BEYOND SEMICOLON.
C            = 3, RETURNED IF AMPERSAND WAS FOUND  AS  NEXT
C              PRINTING  CHARACTER  BEYOND NUMBERS.  LOWBFR
C              IS RETURNED POINTING BEYOND END OF BUFFER.
C            = 4, RETURNED IF UNKNOWN CHARACTER  WAS  FOUND
C              AS  NEXT  PRINTING CHARACTER BEYOND NUMBERS.
C              LOWBFR IS RETURNED  POINTING TO THIS UNKNOWN
C              CHARACTER.   LOWBFR  MUST BE  INCREMENTED BY
C              CALLING PROGRAM BEFORE  THIS ROUTINE IS NEXT
C              CALLED.
C     MAXUSD = RETURNED  CONTAINING  SUBSCRIPT  OF  HIGHEST
C              LOCATION  IN  ISTORE  USED  TO RETURN SORTED
C              VALUES.
C     ISTORE = ARRAY  USED  TO  RETURN  SORTED  VALUES   IN
C              ISTORE(MINSTR)    THROUGH    AND   INCLUDING
C              ISTORE(MAXUSD).
C
      DIMENSION IBUFFR(MAXBFR),ISTORE(MAXSTR)
      JNCRES=INCRES-2
      MANY=0
      MINTST=IFTEST
      IF(MINTST.LT.-1)MINTST=1
      MAXTST=IFTEST
      IF(MAXTST.GT.1)MAXTST=-1
      IF(KIND.LT.3)MAXUSD=MINSTR-1
    1 CALL DAMISS(0,1,0,IBUFFR,MAXBFR,
     1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,NEWVAL,
     2VALUE,MANY,LCNBFR,LCNERR)
      GO TO(23,22,2,2,20,21,1),KIND
C
C     TEST IF NEW VALUE IS IN REGION BEING DISCARDED
    2 IF(MINTST.GT.0)GO TO 3
      IF(NEWVAL.LT.MINMUM)GO TO 1
    3 IF(MAXTST.LT.0)GO TO 4
      IF(NEWVAL.GT.MAXMUM)GO TO 1
C
C     TEST IF NEW VALUE IS ALREADY KNOWN
    4 MIDDLE=MINSTR-1
      IF(MAXUSD.LT.MINSTR)GO TO 11
      IUPPER=MAXUSD
    5 ILOWER=MIDDLE+1
      GO TO 7
    6 IUPPER=MIDDLE-1
    7 IHALF=(IUPPER-ILOWER)/2
      MIDDLE=IUPPER-IHALF
      IF(NEWVAL.EQ.ISTORE(MIDDLE))GO TO 1
      IF(JNCRES.GT.0)GO TO 8
      IF(NEWVAL.LT.ISTORE(MIDDLE))GO TO 10
      GO TO 9
    8 IF(NEWVAL.GT.ISTORE(MIDDLE))GO TO 10
    9 IF(IHALF.GT.0)GO TO 6
      IF(IUPPER.LE.ILOWER)GO TO 12
      IUPPER=ILOWER
      GO TO 7
   10 IF(IHALF.GT.0)GO TO 5
C
C     SHIFT REST OF ARRAY AND INSERT NEW VALUE
   11 MIDDLE=MIDDLE+1
   12 IF(MAXUSD.LT.MAXSTR)GO TO 14
      GO TO(13,17,17,13),INCRES
   13 IF(MIDDLE.GT.MAXSTR)GO TO 1
      GO TO 15
   14 MAXUSD=MAXUSD+1
   15 I=MAXUSD
   16 IF(I.LE.MIDDLE)GO TO 19
      ISTORE(I)=ISTORE(I-1)
      I=I-1
      GO TO 16
   17 IF(MIDDLE.LE.MINSTR)GO TO 1
      MIDDLE=MIDDLE-1
      I=MINSTR
   18 IF(I.GE.MIDDLE)GO TO 19
      ISTORE(I)=ISTORE(I+1)
      I=I+1
      GO TO 18
   19 ISTORE(MIDDLE)=NEWVAL
      GO TO 1
   20 KIND=2
      GO TO 23
   21 KIND=3
      GO TO 23
   22 KIND=4
   23 RETURN
C445263597068
      END
      SUBROUTINE DAINXT              (IBUFFR,MAXBFR,LOWBFR,
     1    MANY  ,KIND  ,NEWVAL,INCVAL,LMTVAL)
C     RENBR(/RETURNS NEXT NUMBER IN SERIES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DANEXT RETURNS TO THE CALLING PROGRAM THE NEXT NUMBER
C     REPRESENTED BY THE CHARACTERS IN AN INPUT BUFFER READ
C     BY THE CALLING PROGRAM  WITH  A  MULTIPLE  OF  AN  A1
C     FORMAT.   IF A SERIES SPECIFICATION IS ENCOUNTERED IN
C     THE INPUT BUFFER, THEN THE INDIVIDUAL NUMBERS OF  THE
C     SERIES  ARE  RETURNED  BY  THE CALLS TO THIS ROUTINE.
C     WHEN ALL OF THE NUMBERS FORMING THE SERIES HAVE  BEEN
C     RETURNED,  THEN  THE  SUBSEQUENT  NUMBER OR SERIES OF
C     NUMBERS SPECIFIED BY THE CONTENTS OF THE  BUFFER  ARE
C     EVALUATED.
C
C     A SERIES EVALUATED BY THIS ROUTINE CAN BE WRITTEN  AS
C     A LOWER BOUND, INCREMENT AND UPPER BOUND SEPARATED BY
C     SLASHES.  IF THE INCREMENT IS TO  BE  ONE,  THEN  THE
C     LOWER  AND  UPPER  BOUNDS NEED BE SEPARATED ONLY BY A
C     SINGLE SLASH.  IF EITHER  BOUND  IS  MISSING,  IT  IS
C     ASSUMED  TO  BE  ZERO.   THE LOWER BOUND IS THE FIRST
C     NUMBER OF THE SERIES REPORTED TO THE CALLING PROGRAM.
C     THE  SERIES  CAN  THEN  EITHER  INCREASE  OR DECREASE
C     DEPENDING UPON WHETHER THE UPPER BOUND IS LESS  THAN,
C     EQUAL  TO, OR GREATER THAN THE LOWER BOUND.  THE SIGN
C     OF THE INCREMENT IS CHANGED IF IT DOES NOT CONFORM TO
C     THE RELATIVE VALUES OF THE BOUNDS.
C
C     IF THE SERIES IS TO CONSIST OF SEVERAL REPETITIONS OF
C     THE SAME VALUE, THEN THE SERIES IS INSTEAD WRITTEN AS
C     THE NUMBER OF TIMES THE VALUE IS TO BE USED  FOLLOWED
C     IMMEDIATELY BY AN ASTERISK AND THE VALUE ITSELF.  THE
C     VALUE TO BE REPEATED IS ASSUMED TO BE NULL IF  IT  IS
C     MISSING.
C
C     TWO VERSIONS OF THE ROUTINE ARE SUPPLIED.  DANEXT CAN
C     EVALUATE  REAL  NUMBERS AS WELL AS INTEGERS INCLUDING
C     E, K AND M NOTATIONS FOR SPECIFYING EITHER OF  THESE.
C     IF  THE  CALLING PROGRAM DOES NOT OTHERWISE REFERENCE
C     THE  FREE  FORMAT  INPUT  ROUTINE  DAREAD,   IF   THE
C     EVALUATION  OF  REAL  NUMBERS  IS  NOT NEEDED, AND IF
C     INTEGERS CAN BE SPECIFIED WITHOUT RESORTING TO THE E,
C     K  AND M NOTATIONS, THEN THE ROUTINE DAINXT SHOULD BE
C     USED INSTEAD OF DANEXT.  NUMBERS EVALUATED BY  DAINXT
C     MUST  CONSIST  ONLY  OF DIGITS FOLLOWING THE OPTIONAL
C     SIGN.  DAINXT TREATS THE CHARACTERS ., %, K AND M THE
C     SAME AS ANY OTHER DELIMITER CHARACTER.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY AND ARE
C     RETURNED UNCHANGED.
C
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT,  WHICH IS TO BE SEARCHED  FOR SERIES
C              SPECIFICATIONS.   IBUFFR THEN  CONTAINS  ONE
C              CHARACTER PER COMPUTER STORAGE LOCATION.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C
C     FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C     LOWBFR = INPUT CONTAINING THE  SUBSCRIPT  WITHIN  THE
C              IBUFFR   ARRAY   OF   THE  FIRST  (LEFTMOST)
C              CHARACTER WHICH CAN BE SCANNED FOR A  SERIES
C              SPECIFICATION.  LOWBFR IS RETURNED UNCHANGED
C              IF  THIS  CALL  TO   THIS   ROUTINE   MERELY
C              GENERATES  THE NEXT MEMBER OF A SERIES BEGUN
C              BY  A  PREVIOUS  CALL.   IF  A  NEW   SERIES
C              SPECIFICATION  IS  EVALUATED BY THIS CALL TO
C              THIS ROUTINE, THEN LOWBFR WILL  BE  RETURNED
C              POINTING  TO  THE  NEXT CHARACTER BEYOND THE
C              SERIES SPECIFICATION.  IF  A  SECOND  NUMBER
C              IMMEDIATELY   FOLLOWS   A  FIRST  WITHOUT  A
C              SEPARATING SLASH OR  ASTERISK,  THEN  LOWBFR
C              WILL  BE  RETURNED  POINTING  TO  THE  FIRST
C              CHARACTER OF THE SECOND NUMBER.  IF EITHER A
C              SPACE  OR  A  TAB CHARACTER FOLLOWS A SERIES
C              SPECIFICATION, THEN LOWBFR WILL BE  RETURNED
C              POINTING  TO THE SPACE OR TAB CHARACTER.  IF
C              THERE IS NOTHING AT OR TO RIGHT  OF  LOWBFR,
C              THEN   LOWBFR   WILL  BE  LEFT  POINTING  AT
C              MAXBFR+1   AND   KIND   WILL   BE   RETURNED
C              CONTAINING ONE.  LOWBFR AND MANY MUST BE SET
C              BY THE CALLING PROGRAM  BEFORE  ANYTHING  IS
C              PROCESSED  IN  THE  CURRENT  CONTENTS OF THE
C              IBUFFR  ARRAY,  BUT  THEN  SHOULD   NOT   BE
C              MODIFIED  BY  THE  CALLING PROGRAM UNTIL THE
C              ENTIRE CONTENTS OF THE IBUFFR ARRAY HAS BEEN
C              PROCESSED.
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF A NEW LOGICAL SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE  WHEN BEGINNING PROCESSING OF A LINE
C              OF TEXT NOT TIED TO THE PREVIOUS LINE BY  AN
C              AMPERSAND  AT  THE END OF THE PREVIOUS LINE,
C              OR WHEN PROCESSING THE TEXT TO THE RIGHT  OF
C              A  SEMICOLON.   MANY IS RETURNED SET TO ZERO
C              WHENEVER AN  END OF LINE  (KIND=1)  IS FOUND
C              WHICH IS NOT  TIED TO THE  FOLLOWING LINE BY
C              AN AMPERSAND,  AND  WHENEVER  A SEMICOLON IS
C              FOUND (KIND=2). MANY IS RETURNED INCREMENTED
C              BY 1 EACH TIME A NEW SPECIFICATION OF EITHER
C              A  SINGLE  NUMBER  OR  OF A SERIES IS FOUND,
C              EACH TIME AN ERRONEOUS SERIES  SPECIFICATION
C              IS  FOUND,  OR  EACH TIME AN INDICATION OF A
C              MISSING SERIES SPECIFICATION IS FOUND.  MANY
C              IS  RETURNED  UNCHANGED IF THIS CALL TO THIS
C              ROUTINE MERELY GENERATES THE NEXT MEMBER  OF
C              A SERIES ALREADY BEGUN BY A PREVIOUS CALL TO
C              THIS ROUTINE.  KIND IS  RETURNED  CONTAINING
C              THE  VALUE 3 AND MANY IS RETURNED CONTAINING
C              THE NEGATIVE OF THE NUMBER OF ITEMS FOUND IF
C              THE  NEXT  PRINTING  CHARACTER  FOLLOWING  A
C              COMMA IS AN AMPERSAND.  MANY SHOULD  NOT  BE
C              CHANGED   BY   THE  CALLING  PROGRAM  IF  AN
C              AMPERSAND (KIND BEING RETURNED=3)  IS  FOUND
C              INDICATING  THAT THE SUBSEQUENT CALL TO THIS
C              ROUTINE IS TO PROCESS TEXT WHICH  IS  TO  BE
C              TREATED  AS  THOUGH  IT APPEARED IN PLACE OF
C              THE AMPERSAND  AND  THE  CHARACTERS  TO  ITS
C              RIGHT.   THE EFFECT IS NOT QUITE THE SAME AS
C              IF THE USER HAD TYPED ALL OF THE TEXT  ON  A
C              SINGLE    LINE   SINCE   A   SINGLE   SERIES
C              SPECIFICATION CANNOT  BE  SPLIT  ACROSS  THE
C              LINE BOUNDARY.
C
C              IF MANY IS INPUT CONTAINING  ZERO,  THEN  AN
C              INITIAL  COMMA  IN  THE INPUT TEXT BUFFER IS
C              TAKEN TO INDICATE AN INITIAL  MISSING  ITEM,
C              AND  MANY IS THEN RETURNED CONTAINING 1.  IF
C              MANY IS INPUT GREATER  THAN  ZERO,  THEN  AN
C              INITIAL  COMMA  IS  IGNORED IF FOLLOWED BY A
C              SERIES  SPECIFICATION.   IF  MANY  IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C              A  SEMICOLON,  OR  BY  AN  EXCLAMATION POINT
C              INDICATES A MISSING ITEM.  IF MANY IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY  AN  AMPERSAND  WILL  CAUSE  THE
C              REMAINING  CHARACTERS  IN  THE  BUFFER TO BE
C              IGNORED,   AND   MANY   WILL   BE   RETURNED
C              CONTAINING  THE NEGATIVE OF ITS INPUT VALUE.
C              IF  MANY  IS  INPUT  NEGATIVE,  THEN  IT  IS
C              ASSUMED  THAT  THE  CONTENTS  OF THE CURRENT
C              BUFFER  CONTINUE  A  PREVIOUS   LINE   WHICH
C              TERMINATED  WITH  A  COMMA  FOLLOWED  BY  AN
C              AMPERSAND, AND MANY IS RETURNED GREATER THAN
C              ZERO.
C     KIND   = SHOULD BE  INPUT  CONTAINING  ZERO THE FIRST
C              TIME THIS  ROUTINE IS CALLED,  OR TO ABANDON
C              GENERATATION  OF VALUES WITHIN  A PARTICULAR
C              SERIES.   KIND  IS  RETURNED  DESCRIBING THE
C              KIND OF ITEM LOCATED IN THE IBUFFR ARRAY.
C            = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C              BY A LEADING EXCLAMATION POINT, WAS FOUND AT
C              OR TO RIGHT OF LOWBFR.   THE CALLING PROGRAM
C              SHOULD READ A NEW LINE INTO IBUFFR.  MANY IS
C              RETURNED SET TO ZERO.
C            = 2,  A  SEMICOLON  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.  LOWBFR IS RETURNED POINTING TO  THE
C              NEXT  CHARACTER  BEYOND  THE LOCATION OF THE
C              SEMICOLON.   IT  IS  ASSUMED   THE   CALLING
C              PROGRAM  WILL  TREAT  THE  APPEARANCE OF THE
C              SEMICOLON AS MARKING THE END OF A STATEMENT.
C              MANY IS RETURNED SET TO ZERO.
C            = 3, AN  AMPERSAND  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.   THE  TEXT  TO  THE  RIGHT  OF  THE
C              AMPERSAND IS TAKEN AS A COMMENT SO LOWBFR IS
C              RETURNED POINTING BEYOND THE  RIGHT  END  OF
C              THE  BUFFER.  IT IS ASSUMED THAT THE CALLING
C              PROGRAM WILL READ IN THE CONTENTS OF  A  NEW
C              BUFFER,  THEN  AGAIN  REQUEST  A  NEW SERIES
C              EVALUATION FROM THIS ROUTINE.   THE VALUE OF
C              MANY MUST NOT BE CHANGED BY  CALLING PROGRAM
C              PRIOR TO THIS FOLLOWING CALL.  THE EFFECT IS
C              NOT  QUITE THE SAME AS IF THE USER HAD TYPED
C              ALL OF THE TEXT ON A  SINGLE  LINE  SINCE  A
C              SERIES  SPECIFICATION CANNOT BE SPLIT ACROSS
C              A LINE BOUNDARY.
C            = 4, A NUMBER OR SERIES SPECIFICATION WAS  NOT
C              FOUND,  BUT  A COMMA  WAS  FOUND  INDICATING
C              A MISSING  SERIES  SPECIFICATION.  NEWVAL IS
C              SET TO ZERO  SO  KIND=4  CAN  BE  CONSIDERED
C              EQUIVALENT TO KIND=5  IF SUCH IS APPROPRIATE
C              TO THE APPLICATION FOR WHICH THIS ROUTINE IS
C              BEING USED.
C            = 5, THE NEXT NUMBER SPECIFIED BY THE CONTENTS
C              OF THE INPUT BUFFER IS BEING RETURNED AS THE
C              VALUE OF NEWVAL.
C            = 6,  A  SERIES  WAS   SPECIFIED  IN  ASTERISK
C              NOTATION, BUT NO NUMBER APPEARED TO RIGHT OF
C              ASTERISK.   NEWVAL IS  RETURNED SET TO ZERO.
C              NOTE THAT  IF A NUMBER DOES  NOT PRECEDE THE
C              ASTERISK,  THEN  KIND IS  RETURNED  WITH THE
C              VALUE 7 WHETHER OR  NOT A NUMBER FOLLOWS THE
C              ASTERISK.
C            = 7,  A  SERIES  WAS  SPECIFIED  IN   ASTERISK
C              NOTATION, BUT NO NUMBER APPEARED TO THE LEFT
C              OF THE ASTERISK OR THE NUMBER TO LEFT OF THE
C              ASTERISK WAS  LESS THAN 1.   A NUMBER MAY OR
C              MAY NOT HAVE APPEARED TO RIGHT OF ASTERISK.
C            = 8, A SERIES SPECIFICATION  WAS  FOUND  WHICH
C              CONTAINED   TOO   MANY   NUMBERS,  TOO  MANY
C              ASTERISKS OR TOO  MANY  SLASHES.
C            = 9, FIRST PRINTING CHARACTER IN OR  TO  RIGHT
C              OF  LOWBFR  WAS  NOT A CHARACTER WHICH COULD
C              APPEAR IN A NUMBER OR NUMBER RANGE, AND  WAS
C              NOT A COMMA, SEMICOLON OR EXCLAMATION POINT.
C              LOWBFR  IS  RETURNED  POINTING  TO  THE NEXT
C              CHARACTER BEYOND THIS CHARACTER.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT
C
C     NEWVAL = RETURNED  CONTAINING  NEXT NUMBER  SPECIFIED
C              BY INPUT BUFFER.
C
C     INCVAL AND LMTVAL MUST  BE PRESERVED FROM ONE CALL TO
C     NEXT BUT NOT USED BY CALLING PROGRAM
C
      DIMENSION IBUFFR(MAXBFR)
C
      IF(KIND.EQ.6)GO TO 2
      IF(KIND.NE.5)GO TO 3
      IF(INCVAL.EQ.0)GO TO 2
C
C     GET NEXT NUMBER EXPRESSED IN SLASH NOTATION
      NEWVAL=NEWVAL+INCVAL
      IF(INCVAL.GT.0)GO TO 1
      IF(NEWVAL.GE.LMTVAL)GO TO 11
      GO TO 3
    1 IF(NEWVAL.LE.LMTVAL)GO TO 11
      GO TO 3
C
C     GET NEXT NUMBER EXPRESSED IN ASTERISK NOTATION
    2 LMTVAL=LMTVAL-1
      IF(LMTVAL.GT.0)GO TO 11
C
C     GET NEW RANGE SPECIFICATION
    3 CALL DAISPN(-1,IBUFFR,MAXBFR,LOWBFR,
     1MANY,KIND,INIGOT,INCGOT,LMTGOT,NEWVAL,INCVAL,
     2LMTVAL)
      GO TO(5,5,5,5,6,6,7,10,4,4),KIND
C
C     INCORRECT SPECIFICATION
    4 KIND=KIND-1
C
C     SINGLE NUMBER WITHOUT SLASH OR ASTERISK
    5 NEWVAL=0
    6 INCVAL=0
      LMTVAL=0
      GO TO 11
C
C     SERIES CONTAINING SLASH
    7 KIND=5
      IF(INIGOT.LE.0)NEWVAL=0
      IF(INCGOT.LE.0)INCVAL=1
      IF(INCVAL.EQ.0)INCVAL=1
      IF(LMTGOT.LE.0)LMTVAL=0
      IF(NEWVAL.GT.LMTVAL)GO TO 8
      IF(INCVAL.GT.0)GO TO 11
      GO TO 9
    8 IF(INCVAL.LT.0)GO TO 11
    9 INCVAL=-INCVAL
      GO TO 11
C
C     SERIES CONTAINING ASTERISK
   10 KIND=5
      IF(LMTGOT.LE.0)KIND=6
      IF(INIGOT.LE.0)NEWVAL=0
      IF(NEWVAL.LE.0)KIND=7
      IF(LMTGOT.LE.0)LMTVAL=0
      INCVAL=NEWVAL
      NEWVAL=LMTVAL
      LMTVAL=INCVAL
      INCVAL=0
C
C     RETURN TO CALLING PROGRAM
   11 RETURN
C287488307054
      END
      SUBROUTINE DAISPN       (KONECT,IBUFFR,MAXBFR,LOWBFR,
     1    MANY  ,KIND  ,INIGOT,INCGOT,LMTGOT,INIVAL,INCVAL,
     2    LMTVAL)
C     RENBR(/INTERPRETS FREE FORMAT RANGE SPECIFICATIONS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DASPAN EVALUATES RANGE SPECIFICATIONS  TYPED  BY  THE
C     USER  AND READ BY THE CALLING PROGRAM WITH A MULTIPLE
C     OF AN  A1  FORMAT.   SUCH  RANGE  SPECIFICATIONS  CAN
C     CONSIST OF A SINGLE NUMBER, OR OF 2 NUMBERS SEPARATED
C     BY AN ASTERISK, OR OF EITHER 2 OR 3 NUMBERS SEPARATED
C     BY SLASHES OR BY COLONS WHICH ARE TAKEN AS EQUIVALENT
C     TO SLASHES.    THE  ASTERISK  NOTATION  IS  MEANT  TO
C     INDICATE THAT THE VALUE TO THE RIGHT OF THE  ASTERISK
C     IS  TO  BE  REPEATED THE NUMBER OF TIMES INDICATED BY
C     THE NUMBER TO THE  LEFT  OF  THE  ASTERISK.   NUMBERS
C     SPECIFIED IN THE SLASH NOTATION CAN BE INTERPRETED AS
C     THE LOWER AND UPPER BOUNDS OF A RANGE  IF  2  NUMBERS
C     ARE  PRESENT,  OR  AS THE LOWER BOUND, THE INCREMENT,
C     AND THE UPPER BOUND, IF 3 NUMBERS ARE INCLUDED.
C
C     DASPAN REPORTS TO THE  CALLING  PROGRAM  WHETHER  THE
C     NUMBERS  ARE  PRESENT IN THE SERIES SPECIFICATION, AS
C     WELL  AS  THE  VALUES  OF  THOSE  NUMBERS  WHICH  ARE
C     PRESENT.   THE  CALLING  PROGRAM  WILL HAVE TO ASSIGN
C     DEFAULT VALUES FOR ANY  NUMBERS  WHICH  ARE  MISSING.
C     THE  RANGE  SPECIFICATION  /2/10  INDICATES  THAT THE
C     RANGE IS TO EXTEND FROM THE DEFAULT LOWER BOUND  WITH
C     AN  INCRMENT  OF  2  THROUGH  THE  UPPER BOUND OF 10.
C     EITHER RANGE SPECIFICATION 1/10 OR 1//10 IS TAKEN  TO
C     MEAN  THAT  THE  RANGE IS TO EXTEND FROM 1 THROUGH 10
C     WITH THE DEFAULT INCREMENT.  IF THE  NUMBERS  SPECIFY
C     THE VALUES OF A SUBSCRIPT OF AN ARRAY, THEN A MISSING
C     LOWER BOUND MIGHT  BE  TAKEN  TO  INDICATE  THAT  THE
C     SUBSCRIPT BEING VARIED STARTS AT ITS MINIMUM POSSIBLE
C     VALUE (USUALLY 1), WHILE A MISSING UPPER BOUND  MIGHT
C     INDICATE  THAT  THE  SUBSCRIPT IS TO TERMINATE AT ITS
C     MAXIMUM POSSIBLE VALUE.
C
C     TWO VERSIONS OF THE ROUTINE ARE SUPPLIED.  DASPAN CAN
C     EVALUATE  REAL  NUMBERS AS WELL AS INTEGERS INCLUDING
C     E, K AND M NOTATIONS FOR SPECIFYING EITHER OF  THESE.
C     IF  THE  CALLING PROGRAM DOES NOT OTHERWISE REFERENCE
C     THE  FREE  FORMAT  INPUT  ROUTINE  DAREAD,   IF   THE
C     EVALUATION  OF  REAL  NUMBERS  IS  NOT NEEDED, AND IF
C     INTEGERS CAN BE SPECIFIED WITHOUT RESORTING TO THE E,
C     K  AND M NOTATIONS, THEN THE ROUTINE DAISPN SHOULD BE
C     USED INSTEAD OF DASPAN.  NUMBERS EVALUATED BY  DAISPN
C     MUST  CONSIST  ONLY  OF DIGITS FOLLOWING THE OPTIONAL
C     SIGN.  DAISPN TREATS THE CHARACTERS ., %, K AND M THE
C     SAME AS ANY OTHER DELIMITER CHARACTER.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY AND ARE
C     RETURNED UNCHANGED.
C
C     KONECT = -1, ONCE A SLASH, AN ASTERISK OR A NUMBER IS
C              FOUND   IN  THE  IBUFFR  ARRAY,  THE  SERIES
C              SPECIFICATION WILL EXTEND TO THE NEXT  SPACE
C              OR  TAB CHARACTER, OR TO ANY CHARACTER OTHER
C              THAN A SLASH OR AN ASTERISK WHICH IMMEDITELY
C              FOLLOWS    A    NUMBER    IN    THE   SERIES
C              SPECIFICATION.  IF KONECT=-1,  THEN THE TEXT
C                   1/2+3/4 5/6+7/+8
C              WOULD CONTAIN THE RANGE SPECIFICATIONS 1  TO
C              2, 3 TO 4, 5 TO 6, AND 7 TO 8.
C            = 0, SPACES CAN APPEAR  BETWEEN THE NUMBERS OF
C              A SERIES IN ADDITION TO SLASHES OR ASTERISK.
C              THE SLASHES  OR THE  ASTERISK ARE,  HOWEVER,
C              REQUIRED.
C            = 1, SPACES AND/OR TAB  CHARACTERS CAN  APPEAR
C              BETWEEN  THE NUMBERS OF A SERIES IN ADDITION
C              TO OR IN PLACE OF SLASHES OR ASTERISKS.   IF
C              KONECT=1, THEN THE TEXT
C                   1 2 3,4/5 6,7 8/9,10 / 11 12
C              IS EXACTLY EQUIVALENT, EXCEPT FOR THE  VALUE
C              OF  KIND  RETURNED  FOR THE FIRST SERIES, TO
C              THE TEXT
C                   1/2/3,4/5/6,7/8/9,10/11/12
C              THE FIRST  SERIES  (1  2  3)  IN  THE  FIRST
C              EXAMPLE  WOULD  RETURN  KIND=6  INDICATING A
C              SERIES IN  WHICH  NEITHER  A  SLASH  NOR  AN
C              ASTERISK  APPEARED,  WHILE THE CORRESPONDING
C              SERIES SPECIFICATION IN THE  SECOND  EXAMPLE
C              WOULD RETURN KIND=7 INDICATING THAT AT LEAST
C              1  SLASH  WAS  ENCOUNTERED  IN  THE   SERIES
C              SPECIFICATION.
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT,  WHICH IS TO BE SEARCHED  FOR SERIES
C              SPECIFICATIONS.   IBUFFR THEN  CONTAINS  ONE
C              CHARACTER PER COMPUTER STORAGE LOCATION.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C
C     FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C     LOWBFR = INPUT CONTAINING THE  SUBSCRIPT  WITHIN  THE
C              IBUFFR   ARRAY   OF   THE  FIRST  (LEFTMOST)
C              CHARACTER WHICH CAN BE SCANNED FOR A  SERIES
C              SPECIFICATION.    LOWBFR  WILL  BE  RETURNED
C              POINTING TO THE NEXT  CHARACTER  BEYOND  THE
C              SERIES  SPECIFICATION.   IF  KONECT IS .LE.0
C              FORCING A SERIES  SPECIFICATION  TO  CONTAIN
C              EITHER  A  SLASH  OR AN ASTERISK BETWEEN THE
C              NUMBERS OF A SERIES, AND IF A SECOND  NUMBER
C              IMMEDIATELY   FOLLOWS   A  FIRST  WITHOUT  A
C              SEPARATING SLASH OR  ASTERISK,  THEN  LOWBFR
C              WILL  BE  RETURNED  POINTING  TO  THE  FIRST
C              CHARACTER OF THE SECOND NUMBER.   IF  KONECT
C              IS  -1  AND IF  EITHER  A  SPACE  OR  A  TAB
C              CHARACTER FOLLOWS  A  SERIES  SPECIFICATION,
C              THEN LOWBFR WILL BE RETURNED POINTING TO THE
C              SPACE OR TAB CHARACTER.  IF KONECT IS .GE.0,
C              ALLOWING SPACES AND TAB CHARACTERS TO APPEAR
C              WITHIN A SERIES SPECIFICATION,  THEN  LOWBFR
C              WILL  BE  RETURNED  POINTING  TO  THE  FIRST
C              CHARACTER TO THE RIGHT  OF  THE  SERIES  AND
C              WHICH IS NOT ITSELF A SPACE, A TAB CHRACTER,
C              A SLASH OR  AN  ASTERISK  AND  WHICH  CANNOT
C              APPEAR WITHIN A NUMBER.  IF THERE IS NOTHING
C              AT OR TO RIGHT OF LOWBFR, THEN  LOWBFR  WILL
C              BE  LEFT  POINTING AT MAXBFR+1 AND KIND WILL
C              BE RETURNED CONTAINING ONE.  LOWBFR AND MANY
C              MUST  BE  SET  BY THE CALLING PROGRAM BEFORE
C              ANYTHING  IS  PROCESSED   IN   THE   CURRENT
C              CONTENTS  OF  THE  IBUFFR  ARRAY,  BUT  THEN
C              SHOULD  NOT  BE  MODIFIED  BY  THE   CALLING
C              PROGRAM  UNTIL  THE  ENTIRE  CONTENTS OF THE
C              IBUFFR ARRAY HAS BEEN PROCESSED.
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF A NEW LOGICAL SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE  WHEN BEGINNING PROCESSING OF A LINE
C              OF TEXT NOT TIED TO THE PREVIOUS LINE BY  AN
C              AMPERSAND  AT  THE END OF THE PREVIOUS LINE,
C              OR WHEN PROCESSING THE TEXT TO THE RIGHT  OF
C              A  SEMICOLON.   MANY IS RETURNED SET TO ZERO
C              WHENEVER AN  END OF LINE  (KIND=1)  IS FOUND
C              WHICH IS NOT  TIED TO THE  FOLLOWING LINE BY
C              AN AMPERSAND,  AND  WHENEVER  A SEMICOLON IS
C              FOUND (KIND=2). MANY IS RETURNED INCREMENTED
C              BY 1 EACH TIME A  DESCRIPTION  OF  A  SERIES
C              SPECIFICATION  IS  RETURNED BY THIS ROUTINE,
C              EACH TIME AN ERRONEOUS SERIES  SPECIFICATION
C              IS  FOUND,  OR  EACH TIME AN INDICATION OF A
C              MISSING SERIES SPECIFICATION IS FOUND.  KIND
C              IS  RETURNED CONTAINING THE VALUE 3 AND MANY
C              IS RETURNED CONTAINING THE NEGATIVE  OF  THE
C              NUMBER  OF  ITEMS FOUND IF THE NEXT PRINTING
C              CHARACTER FOLLOWING A COMMA IS AN AMPERSAND.
C              MANY  SHOULD  NOT  BE CHANGED BY THE CALLING
C              PROGRAM  IF   AN   AMPERSAND   (KIND   BEING
C              RETURNED=3)  IS  FOUND  INDICATING  THAT THE
C              SUBSEQUENT  CALL  TO  THIS  ROUTINE  IS   TO
C              PROCESS  TEXT  WHICH  IS  TO  BE  TREATED AS
C              THOUGH IT APPEARED IN PLACE OF THE AMPERSAND
C              AND THE CHARACTERS TO ITS RIGHT.  THE EFFECT
C              IS NOT QUITE THE SAME AS  IF  THE  USER  HAD
C              TYPED ALL OF THE TEXT ON A SINGLE LINE SINCE
C              A  SINGLE  SERIES  SPECIFICATION  CANNOT  BE
C              SPLIT ACROSS THE LINE BOUNDARY.
C
C              IF MANY IS INPUT CONTAINING  ZERO,  THEN  AN
C              INITIAL  COMMA  IN  THE INPUT TEXT BUFFER IS
C              TAKEN TO INDICATE AN INITIAL  MISSING  ITEM,
C              AND  MANY IS THEN RETURNED CONTAINING 1.  IF
C              MANY IS INPUT GREATER  THAN  ZERO,  THEN  AN
C              INITIAL  COMMA  IS  IGNORED IF FOLLOWED BY A
C              SERIES  SPECIFICATION.   IF  MANY  IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C              A  SEMICOLON,  OR  BY  AN  EXCLAMATION POINT
C              INDICATES A MISSING ITEM.  IF MANY IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY  AN  AMPERSAND  WILL  CAUSE  THE
C              REMAINING  CHARACTERS  IN  THE  BUFFER TO BE
C              IGNORED,   AND   MANY   WILL   BE   RETURNED
C              CONTAINING  THE NEGATIVE OF ITS INPUT VALUE.
C              IF  MANY  IS  INPUT  NEGATIVE,  THEN  IT  IS
C              ASSUMED  THAT  THE  CONTENTS  OF THE CURRENT
C              BUFFER  CONTINUE  A  PREVIOUS   LINE   WHICH
C              TERMINATED  WITH  A  COMMA  FOLLOWED  BY  AN
C              AMPERSAND, AND MANY IS RETURNED GREATER THAN
C              ZERO.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT
C
C     KIND   = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C              IN THE IBUFFR ARRAY.
C            = 1, EITHER NO PRINTING  CHARACTERS OR ELSE AN
C              EXCLAMATION  POINT  AS  THE  FIRST  PRINTING
C              CHARACTER (MARKING THE REST OF THE LINE AS A
C              COMMENT)  WAS FOUND  AT OR TO THE  RIGHT  OF
C              LOWBFR.   THE  CALLING PROGRAM SHOULD READ A
C              NEW LINE INTO IBUFFR.   MANY, INIGOT, INCGOT
C              AND LMTGOT ARE ALL RETURNED WITH VALUE ZERO.
C            = 2,  A  SEMICOLON  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.  LOWBFR IS RETURNED POINTING TO  THE
C              NEXT  CHARACTER  BEYOND  THE LOCATION OF THE
C              SEMICOLON.   IT  IS  ASSUMED   THE   CALLING
C              PROGRAM  WILL  TREAT  THE  APPEARANCE OF THE
C              SEMICOLON AS MARKING THE END OF A STATEMENT.
C              MANY IS RETURNED WITH THE VALUE ZERO.
C            = 3, AN  AMPERSAND  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.   THE  TEXT  TO  THE  RIGHT  OF  THE
C              AMPERSAND IS TAKEN AS A COMMENT SO LOWBFR IS
C              RETURNED POINTING BEYOND THE  RIGHT  END  OF
C              THE  BUFFER.  IT IS ASSUMED THAT THE CALLING
C              PROGRAM WILL READ IN THE CONTENTS OF  A  NEW
C              BUFFER,  THEN  AGAIN  REQUEST  A  NEW SERIES
C              EVALUATION FROM THIS ROUTINE.   THE VALUE OF
C              MANY MUST NOT BE CHANGED BY  CALLING PROGRAM
C              PRIOR TO THIS FOLLOWING CALL.  THE EFFECT IS
C              NOT  QUITE THE SAME AS IF THE USER HAD TYPED
C              ALL OF THE TEXT ON A  SINGLE  LINE  SINCE  A
C              SERIES  SPECIFICATION CANNOT BE SPLIT ACROSS
C              A LINE BOUNDARY.
C            = 4, A NUMBER OR SERIES SPECIFICATION WAS  NOT
C              FOUND BUT INITIAL COMMA WAS FOUND INDICATING
C              A  MISSING  SERIES  SPECIFICATION.   INIGOT,
C              INCGOT AND LMTGOT ARE EACH RETURNED WITH THE
C              VALUE  ZERO  SO  KIND=4  CAN  BE  CONSIDERED
C              EQUIVALENT  TO KIND=5 IF SUCH IS APPROPRIATE
C              TO THE APPLICATION FOR WHICH THIS ROUTINE IS
C              BEING USED.
C            = 5, A SINGLE NUMBER WITH NEITHER A SLASH  NOR
C              AN  ASTERISK  WAS FOUND IN THE INPUT BUFFER.
C              BOTH  INIGOT   AND   LMTGOT   ARE   RETURNED
C              CONTAINING 1, AND THE VALUE OF THE NUMBER IS
C              RETURNED IN BOTH INIVAL AND LMTVAL.   INCGOT
C              IS RETURNED CONTAINING ZERO.
C            = 6, EITHER 2 OR 3  NUMBERS  WERE  FOUND,  BUT
C              WITHOUT  SLASHES OR ASTERISKS.  THE VALUE OF
C              THE  LEFT  NUMBER  IS  RETURNED  IN  INIVAL,
C              OF THE RIGHT  IN LMTVAL,  AND OF THE MIDDLE,
C              IF PRESENT,  IN INCVAL.   INIGOT  AND LMTGOT
C              ARE  EACH  RETURNED CONTAINING 1.  INCGOT IS
C              RETURNED CONTAINING 1 ONLY IF 3 NUMBERS WERE
C              FOUND.   KONECT  WOULD HAVE TO BE INPUT AS 1
C              FOR KIND TO BE RETURNED AS 6.
C            = 7, A SERIES SPECIFICATION CONTAINING ONE  OR
C              MORE SLASHES WAS FOUND.  THE LOCATION OF THE
C              SLASH OR SLASHES RELATIVE TO THE NUMBERS, IF
C              ANY,   IN   THE   SERIES   SPECIFICATION  IS
C              INDICATED BY THE RETURNED VALUES OF  INIGOT,
C              INCGOT AND LMTGOT.
C            = 8,  A  SERIES  SPECIFICATION  CONTAINING   A
C              SINGLE   ASTERISK   WAS  FOUND.   INCGOT  IS
C              RETURNED CONTAINING ZERO.  THE  LOCATION  OF
C              THE  ASTERISK  RELATIVE  TO  THE NUMBERS, IF
C              ANY,  IN   THE   SERIES   SPECIFICATION   IS
C              INDICATED  BY  THE RETURNED VALUES OF INIGOT
C              AND LMTGOT.
C            = 9, A SERIES SPECIFICATION  WAS  FOUND  WHICH
C              INCLUDED  TOO MANY NUMBERS, TOO MANY SLASHES
C              OR TOO MANY ASTERISKS.  INIGOT,  INCGOT  AND
C              LMTGOT ARE EACH RETURNED CONTAINING ZERO.
C            = 10, FIRST PRINTING CHARACTER IN OR TO  RIGHT
C              OF  LOWBFR  WAS  NOT A CHARACTER WHICH COULD
C              APPEAR IN A NUMBER OR NUMBER RANGE, AND  WAS
C              NOT A COMMA, SEMICOLON OR EXCLAMATION POINT.
C              LOWBFR  IS  RETURNED  POINTING  TO  THE NEXT
C              CHARACTER BEYOND THIS CHARACTER.
C     INIGOT = 0, RETURNED IF THE CONTENTS OF THE BUFFER DO
C              NOT  SPECIFY THE START OF THE RANGE.  INIVAL
C              IS RETURNED UNDEFINED, BUT PROBABLY CHANGED.
C            = 1, RETURNED IF THE CONTENTS  OF  THE  BUFFER
C              SPECIFY  THE  START OF THE RANGE.  INIVAL IS
C              RETURNED CONTAINING THIS STARTING NUMBER.
C     INCGOT = 0, RETURNED IF THE CONTENTS OF THE BUFFER DO
C              NOT   SPECIFY  AN  INCREMENT  BY  WHICH  THE
C              STARTING VALUE IS  TO  BE  VARIED  UNTIL  IT
C              REACHES   THE  ENDING   VALUE.    INCVAL  IS
C              RETURNED UNDEFINED, BUT PROBABLY CHANGED.
C            = 1, RETURNED IF THE CONTENTS  OF  THE  BUFFER
C              SPECIFY  AN  INCREMENT BY WHICH THE STARTING
C              VALUE IS TO BE VARIED UNTIL IT  REACHES  THE
C              ENDING VALUE.  INCVAL IS RETURNED CONTAINING
C              THIS INCREMENT.
C     LMTGOT = 0, RETURNED IF THE CONTENTS OF THE BUFFER DO
C              NOT  SPECIFY  A NUMBER AT WHICH THE RANGE IS
C              TO END.   LMTVAL IS RETURNED UNDEFINED,  BUT
C              PROBABLY CHANGED.
C            = 1, RETURNED IF THE CONTENTS  OF  THE  BUFFER
C              SPECIFY  A  NUMBER  AT WHICH THE RANGE IS TO
C              END.   LMTVAL IS  RETURNED  CONTAINING  THIS
C              ENDING VALUE.
C     INIVAL = RETURNED CONTAINING THE START OF  THE  RANGE
C              IF  THIS  IS  SPECIFIED (INIGOT RETURNED=1).
C     INCVAL = RETURNED CONTAINING THE INCREMENT IF THIS IS
C              SPECIFIED (INCGOT RETURNED=1).
C     LMTVAL = RETURNED CONTAINING THE END OF THE RANGE  IF
C              THIS IS SPECIFIED (LMTGOT RETURNED=1).
C
C     EVALUATION  OF  RANGE  SPECIFICATIONS          LMTVAL
C     SHOWN  BELOW WOULD  PRODUCE  ARGUMENT        INCVAL !
C     VALUES TO THEIR RIGHT.  "U" INDICATES      INIVAL ! !
C     THAT THE ARGUMENT IS UNDEFINED.        LMTGOT   ! ! !
C                                          INCGOT !   ! ! !
C                                        INIGOT ! !   ! ! !
C     EMPTY  OR  /      OR  //     OR  *      0 0 0   U U U
C     ///    OR  5///9  OR  5 2 2 9           0 0 0   U U U
C     /9     OR  //9    OR  *9                0 0 1   U U 9
C     /2/                                     0 1 0   U 2 U
C     /2/9   OR  /2 9                         0 1 1   U 2 9
C     5/     OR  5//    OR  5*                1 0 0   5 U U
C     5                                       1 0 1   5 U 5
C     5/9    OR  5//9   OR  5 9    OR  5*9    1 0 1   5 U 9
C     5/2/   OR  5 2/                         1 1 0   5 2 U
C     5/2/9  OR  5 2/9  OR  5/2 9  OR  5 2 9  1 1 1   5 2 9
C
      DIMENSION IBUFFR(MAXBFR),IDIGIT(10)
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA ISLASH,ICOLON,ISTAR,KOMENT,IEND,IAND,KOMMA,
     1IPLUS,IMINUS,ISPACE,ITAB/
     21H/,1H:,1H*,1H!,1H;,1H&,1H,,1H+,1H-,1H ,1H	/
      ISTATE=0
      KOUNT=0
      INIGOT=1
      KNTSEP=0
      LMTGOT=1
      KIND=1
      ITEST=2
      INCVAL=0
      LMTVAL=0
      IF(MANY.GE.0)GO TO 2
      KIND=4
      MANY=-MANY
      GO TO 2
C
C     TEST IF NEXT CHARACTER CAN BE IN SERIES SPECIFICATION
    1 LOWBFR=LOWBFR+1
    2 IF(LOWBFR.GT.MAXBFR)GO TO 23
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.ISPACE)GO TO 10
      IF(LETTER.EQ.ITAB)GO TO 10
      IF(LETTER.EQ.ISLASH)GO TO 8
      IF(LETTER.EQ.ICOLON)GO TO 8
      IF(LETTER.EQ.ISTAR)GO TO 7
      IF(LETTER.EQ.KOMENT)GO TO 21
      IF(LETTER.EQ.IEND)GO TO 11
      IF(LETTER.EQ.KOMMA)GO TO 6
      IF(LETTER.EQ.IAND)GO TO 12
      IF(KONECT.GT.0)GO TO 3
      IF(ISTATE.GT.0)GO TO 23
    3 IF(LETTER.EQ.IMINUS)GO TO 14
      IF(LETTER.EQ.IPLUS)GO TO 15
      DO 4 I=1,10
      IF(LETTER.NE.IDIGIT(I))GO TO 4
      IVALUE=I-1
      ISIGN=0
      GO TO 17
    4 CONTINUE
      IF(KIND.EQ.4)GO TO 5
      IF(KIND.NE.1)GO TO 23
    5 LOWBFR=LOWBFR+1
      KIND=10
      GO TO 23
C
C     TEST IF DELIMITER CHARACTER CAN PRECEDE A SERIES
    6 IF(KIND.NE.1)GO TO 23
      KIND=4
      IF(MANY.EQ.0)GO TO 24
      GO TO 1
C
C     ASTERISK FOUND
    7 IF(KIND.EQ.7)ITEST=0
      IF(ITEST.GT.0)ITEST=1
      KIND=8
      GO TO 9
C
C     SLASH FOUND
    8 IF(KIND.EQ.8)ITEST=0
      KIND=7
    9 IF(KOUNT.EQ.0)INIGOT=0
      LMTGOT=0
      KNTSEP=KNTSEP+1
      ISTATE=-1
      GO TO 1
C
C     SPACE FOUND
   10 IF(ISTATE.EQ.0)GO TO 1
      IF(KONECT.GE.0)GO TO 1
      GO TO 23
C
C     SEMICOLON FOUND
   11 IF(KIND.NE.1)GO TO 23
      LOWBFR=LOWBFR+1
      KIND=2
      GO TO 23
C
C     AMPERSAND FOUND
   12 IF(KIND.EQ.1)GO TO 13
      IF(KIND.NE.4)GO TO 23
      MANY=-MANY
   13 KIND=3
      GO TO 22
C
C     MINUS SIGN FOUND
   14 ISIGN=-1
      GO TO 16
C
C     PLUS SIGN FOUND
   15 ISIGN=1
   16 IVALUE=0
C
C     EVALUATE NUMBER AND PLACE INTO PUSH-DOWN STACK
   17 IF(KIND.LE.5)KIND=KOUNT+5
      KOUNT=KOUNT+1
      IF(ISTATE.LT.0)KNTSEP=KNTSEP-1
      ISTATE=1
      LMTGOT=1
      INIVAL=INCVAL
      INCVAL=LMTVAL
   18 LOWBFR=LOWBFR+1
      IF(LOWBFR.GT.MAXBFR)GO TO 20
      LETTER=IBUFFR(LOWBFR)
      DO 19 I=1,10
      IF(LETTER.NE.IDIGIT(I))GO TO 19
      IVALUE=(10*IVALUE)+I-1
      GO TO 18
   19 CONTINUE
   20 IF(ISIGN.LT.0)IVALUE=-IVALUE
      LMTVAL=IVALUE
      GO TO 2
C
C     TEST IF TOO MANY ITEMS WERE FOUND IN SPECIFICATION
   21 IF(KIND.NE.1)GO TO 23
   22 LOWBFR=MAXBFR+1
   23 IF((KOUNT+KNTSEP-INIGOT).LE.ITEST)GO TO 24
      KIND=9
      GO TO 25
C
C     CONVERT PUSH-DOWN STACK INTO RANGE DESCRIPTION
   24 IF(KOUNT.GE.3)GO TO 29
      IF(KOUNT.EQ.2)GO TO 26
      IF(KOUNT.EQ.1)GO TO 27
   25 INIGOT=0
      LMTGOT=0
      GO TO 31
   26 IF(INIGOT.EQ.0)GO TO 29
      INIVAL=INCVAL
      GO TO 28
   27 IF(INIGOT.NE.0)GO TO 30
   28 IF(LMTGOT.NE.0)GO TO 31
      INCVAL=LMTVAL
   29 INCGOT=1
      GO TO 32
   30 INIVAL=LMTVAL
   31 INCGOT=0
C
C     EVERYTHING IS IN ITS PLACE, RETURN TO CALLING ROUTINE
   32 IF(KIND.GT.3)MANY=MANY+1
      IF(KIND.LT.3)MANY=0
   33 RETURN
C
C     KNTSEP = NUMBER OF SLASHES AND ASTERISKS NOT FOLLOWED
C              BY A NUMBER.
C     ISTATE = 1, WITHIN NUMBER
C            = 0, SPACE
C            = -1, SLASH FOUND
C     ITEST  = MAXIMUM NUMBER OF SLASHES OR ASTERISKS
C              ALLOWED IN A SINGLE SERIES SPECIFICATION.
C     JSIGN  = -1, MINUS SIGN AT START OF NUMBER
C            = 0, NO SIGN AT START OF NUMBER
C            = 1, PLUS SIGN AT START OF NUMBER
C     KOUNT  = NUMBER OF NUMBERS ALREADY FOUND
C
C713940183127:!;&
      END
      SUBROUTINE DALOAD(IDSK  ,LTRMAX,NUMMAX,MAXBFR,LTRUSD,
     1NUMUSD,LTRSTR,NUMSTR,IBUFFR,IFULL )
C     RENBR(/CONSTRUCT DESCRIPTION OF FORTRAN ARRAYS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
      DIMENSION LTRSTR(LTRMAX),NUMSTR(NUMMAX),
     1IBUFFR(MAXBFR),IDIGIT(10),LETTER(26),ITYPE(26),
     2IWORD(42),KNTLTR(8)
      DATA KNTLTR/5,7,4,6,9,8,3,0/
      DATA IWORD/
     11HO,1HC,1HT,1HA,1HL,
     21HI,1HN,1HT,1HE,1HG,1HE,1HR,
     31HR,1HE,1HA,1HL,
     41HC,1HO,1HM,1HM,1HO,1HN,
     51HD,1HI,1HM,1HE,1HN,1HS,1HI,1HO,1HN,
     61HI,1HM,1HP,1HL,1HI,1HC,1HI,1HT,
     71HE,1HN,1HD/
      DATA IDIGIT/
     11H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA LETTER/
     11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     31HU,1HV,1HW,1HX,1HY,1HZ/
      DATA ICOMNT,ILEFT,IRIGHT,IPLUS,IMINUS,ICOMMA,ISLASH,
     1ICOLON,IBLANK,ITAB/
     21HC,1H(,1H),1H+,1H-,1H,,1H/,1H:,1H ,1H	/
C
C     DEFINE DEFAULT TYPES BASED ON LEADING LETTERS OF NAME
      DO 1 I=1,26
      ITYPE(I)=1
    1 CONTINUE
      DO 2 I=9,14
      ITYPE(I)=0
    2 CONTINUE
C
C     CLEAR OTHER INTERNAL STORAGE
      JSLASH=-1
      KOUNT=0
      IWHERE=0
    3 KONTNU=0
C
C     READ IN NEXT LINE
    4 READ(IDSK,5,END=15)IBUFFR
    5 FORMAT(100A1)
      IF(IBUFFR(1).EQ.ICOMNT)GO TO 4
C
C     FIND RIGHT END OF TEXT
      IEND=MAXBFR
      GO TO 7
    6 IEND=IEND-1
      IF(IEND.LE.0)GO TO 4
    7 IF(IBUFFR(IEND).EQ.IBLANK)GO TO 6
      IF(IBUFFR(IEND).EQ.ITAB)GO TO 6
C
C     TEST IF THE LINE IS A CONTINUATION
      IF(IBUFFR(1).EQ.IBLANK)GO TO 10
      IF(IBUFFR(1).NE.ITAB)GO TO 10
      IBGN=1
    8 IBGN=IBGN+1
      IF(IBUFFR(IBGN).EQ.IBLANK)GO TO 8
      IF(IBUFFR(IBGN).EQ.ITAB)GO TO 8
      DO 9 I=2,10
      IF(IBUFFR(IBGN).EQ.IDIGIT(I))GO TO 16
    9 CONTINUE
      IF(IBUFFR(IBGN).NE.IDIGIT(1))IBGN=IBGN-1
      GO TO 11
   10 IF(IEND.LT.6)GO TO 4
      IBGN=6
      IF(IBUFFR(6).EQ.IBLANK)GO TO 11
      IF(IBUFFR(6).EQ.IDIGIT(1))GO TO 11
      GO TO 16
C
C     START OF NEW STATEMENT, LOOK FOR KNOWN LEADING WORDS
   11 IF(KOUNT.NE.0)GO TO 36
   12 KONTNU=0
      KOUNT=0
      IWHERE=0
      LAST=0
      IF(JSLASH.GT.0)JSLASH=JSLASH-2
   13 KONTNU=KONTNU+1
      IF(KNTLTR(KONTNU).LE.0)GO TO 3
      INIT=LAST+1
      LAST=LAST+KNTLTR(KONTNU)
      JBGN=IBGN
   14 JBGN=JBGN+1
      IF(JBGN.GT.IEND)GO TO 13
      IF(IBUFFR(JBGN).EQ.IBLANK)GO TO 14
      IF(IBUFFR(JBGN).EQ.ITAB)GO TO 14
      IF(IBUFFR(JBGN).NE.IWORD(INIT))GO TO 13
      INIT=INIT+1
      IF(INIT.LE.LAST)GO TO 14
      IBGN=JBGN
      IF(KONTNU.LT.6)GO TO 17
      IF(KONTNU.EQ.6)GO TO 48
      IF(JBGN.NE.IEND)GO TO 3
      IFULL=1
      GO TO 67
C
C     END-OF-FILE READ
   15 IFULL=2
      IF(KONTNU.LE.0)GO TO 67
      IF(KOUNT.EQ.0)GO TO 67
      IWHERE=-1
      GO TO 36
C
C     FIND THE NAME IF ANY
   16 IF(KONTNU.EQ.0)GO TO 4
      I=IWHERE
      IWHERE=0
      IF(I.EQ.1)GO TO 18
      IF(I.EQ.2)GO TO 28
      IF(I.EQ.3)GO TO 51
   17 KOUNT=0
      NUMBGN=NUMUSD
      LTRBGN=LTRUSD
      INIGOT=0
      LMTGOT=0
      KBREAK=1
   18 IBGN=IBGN+1
      IF(IBGN.GT.IEND)GO TO 61
      IF(IBUFFR(IBGN).EQ.ISLASH)GO TO 22
      IF(IBUFFR(IBGN).EQ.ILEFT)GO TO 25
      IF(JSLASH.EQ.2)GO TO 18
      IF(IBUFFR(IBGN).EQ.IBLANK)GO TO 18
      IF(IBUFFR(IBGN).EQ.ITAB)GO TO 18
      DO 19 I=1,26
      IF(IBUFFR(IBGN).NE.LETTER(I))GO TO 19
      IF(KOUNT.NE.0)GO TO 21
      NUMUSD=NUMUSD+3
      IF(NUMUSD.GT.NUMMAX)GO TO 64
      J=KONTNU-2
      IF(J.GT.1)J=ITYPE(I)
      NUMSTR(NUMUSD-1)=J
      GO TO 21
   19 CONTINUE
      IF(KOUNT.EQ.0)GO TO 18
      DO 20 I=1,10
      IF(IBUFFR(IBGN).EQ.IDIGIT(I))GO TO 21
   20 CONTINUE
      GO TO 36
   21 LTRUSD=LTRUSD+1
      IF(LTRUSD.GT.LTRMAX)GO TO 65
      LTRSTR(LTRUSD)=IBUFFR(IBGN)
      KOUNT=KOUNT+1
      GO TO 18
C
C     SLASH FOUND
   22 IF(KOUNT.EQ.0)GO TO 23
      IBGN=IBGN-1
      GO TO 42
   23 IF(JSLASH.LE.0)GO TO 24
      JSLASH=JSLASH-2
      GO TO 18
   24 JSLASH=1
      GO TO 18
C
C     LEFT PARENTHESIS FOUND
   25 IF(KOUNT.NE.0)GO TO 26
      IF(JSLASH.EQ.2)GO TO 26
      IF(JSLASH.EQ.0)GO TO 26
      KOUNT=-1
      NUMUSD=NUMUSD+3
      IF(NUMUSD.GT.NUMMAX)GO TO 64
C
C     EVALUATE SUBSCRIPT RANGES
   26 IDONE=0
      INIVAL=0
      INIGOT=0
      LMTGOT=0
   27 ISIGN=1
   28 IBGN=IBGN+1
      IF(IBGN.GT.IEND)GO TO 62
      IF(IBUFFR(IBGN).EQ.IBLANK)GO TO 28
      IF(IBUFFR(IBGN).EQ.ITAB)GO TO 28
      IF(IBUFFR(IBGN).EQ.IRIGHT)GO TO 37
      IF(KOUNT.EQ.0)GO TO 28
      IF(IBUFFR(IBGN).EQ.ISLASH)GO TO 35
      IF(IBUFFR(IBGN).EQ.ICOLON)GO TO 35
      IF(IBUFFR(IBGN).EQ.IPLUS)GO TO 32
      IF(IBUFFR(IBGN).EQ.IMINUS)GO TO 31
      IF(IBUFFR(IBGN).EQ.ICOMMA)GO TO 38
      DO 30 I=1,10
      IF(IBUFFR(IBGN).NE.IDIGIT(I))GO TO 30
      IF(LMTGOT.NE.0)GO TO 29
      INIVAL=(10*INIVAL)+I-1
      INIGOT=ISIGN
      GO TO 28
   29 LMTVAL=(10*LMTVAL)+I-1
      LMTGOT=ISIGN
      GO TO 28
   30 CONTINUE
      GO TO 28
   31 ISIGN=-1
      GO TO 33
   32 ISIGN=1
   33 IF(LMTGOT.NE.0)GO TO 34
      IF(INIGOT.NE.0)GO TO 34
      INIGOT=ISIGN
      GO TO 28
   34 LMTGOT=ISIGN
      LMTVAL=0
      GO TO 28
   35 LMTGOT=2
      LMTVAL=0
      GO TO 27
   36 IF(INIGOT.EQ.0)GO TO 42
   37 IDONE=1
C
C     STORE THE EVALUATED SUBSCRIPT RANGE
   38 IF(KOUNT.EQ.0)GO TO 41
      IF(INIGOT.EQ.0)INIVAL=1
      IF(INIGOT.LT.0)INIVAL=-INIVAL
      IF(LMTGOT.NE.0)GO TO 39
      LMTVAL=INIVAL
      INIVAL=1
      GO TO 40
   39 IF(LMTGOT.GT.1)LMTVAL=1
      IF(LMTGOT.LT.0)LMTVAL=-LMTVAL
   40 NUMUSD=NUMUSD+2
      IF(NUMUSD.GT.NUMMAX)GO TO 64
      NUMSTR(NUMUSD-1)=INIVAL
      NUMSTR(NUMUSD)=LMTVAL
      LMTVAL=LMTVAL-INIVAL
      IF(LMTVAL.LT.0)LMTVAL=-LMTVAL
      KBREAK=KBREAK*(LMTVAL+1)
   41 IF(IDONE.EQ.0)GO TO 26
C
C     DONE WITH THIS SPECIFICATION
   42 IF(KOUNT.EQ.0)GO TO 18
      J=KOUNT
      IF(KOUNT.LT.0)J=0
      IF(JSLASH.NE.0)J=-J
      NUMSTR(NUMBGN+1)=J
      NUMSTR(NUMBGN+3)=(NUMUSD-NUMBGN-3)/2
      IF(JSLASH.EQ.0)GO TO 46
      IBREAK=NUMBGN+2
      IF(JSLASH.GT.0)GO TO 44
      JSLASH=0
      IF(KOUNT.LT.0)GO TO 45
      I=NUMUSD
      NUMUSD=NUMUSD+3
      IF(NUMUSD.GT.NUMMAX)GO TO 64
   43 NUMSTR(I+3)=NUMSTR(I)
      I=I-1
      IF(I.GT.NUMBGN)GO TO 43
      NUMSTR(NUMBGN+1)=0
      NUMSTR(NUMBGN+3)=0
      NUMSTR(NUMBGN+4)=KOUNT
      NUMSTR(IBREAK)=KBREAK
      GO TO 47
   44 JSLASH=2
   45 NUMSTR(IBREAK)=0
      GO TO 47
   46 NUMSTR(IBREAK)=NUMSTR(IBREAK)+KBREAK
   47 IF(IWHERE.EQ.0)GO TO 17
      IF(IWHERE.GT.0)GO TO 12
      GO TO 67
C
C     CHECK FOR LETTERS IN PARENTHESES AFTER IMPLICT
C     INIGOT = -3, NEITHER PARENTHESIS NOR TYPE NAME FOUND
C            = -2, TYPE NAME BUT NOT PARENTHESIS FOUND
C            = -1, PARENTHESIS BUT NOT TYPE NAME FOUND
C            = 0, BOTH PARENTHESIS AND TYPE NAME FOUND
C            = .GT.0, LOCATION IN ALPHABET OF LETTER IN
C              PARENTHESIS AFTER TYPE NAME
   48 INIGOT=-3
      GO TO 51
   49 INIGOT=-2
      GO TO 51
   50 INIGOT=0
   51 IBGN=IBGN+1
      IF(IBGN.GT.IEND)GO TO 63
      IF(IBUFFR(IBGN).EQ.IBLANK)GO TO 51
      IF(IBUFFR(IBGN).EQ.ITAB)GO TO 51
      IF(INIGOT.GE.-1)GO TO 52
      IF(IBUFFR(IBGN).EQ.ICOMMA)GO TO 51
      IF(IBUFFR(IBGN).NE.ILEFT)GO TO 57
      INIGOT=INIGOT+2
      GO TO 51
   52 IF(INIGOT.GE.0)GO TO 53
      IF(IBUFFR(IBGN).EQ.IRIGHT)GO TO 48
      GO TO 51
   53 IF(IBUFFR(IBGN).EQ.IRIGHT)GO TO 49
      IF(IBUFFR(IBGN).EQ.ICOMMA)GO TO 50
      DO 56 I=1,26
      IF(IBUFFR(IBGN).NE.LETTER(I))GO TO 56
      IF(INIGOT.NE.0)GO TO 55
      INIGOT=I
   54 ITYPE(INIGOT)=JTYPE-2
   55 IF(INIGOT.GE.I)GO TO 51
      INIGOT=INIGOT+1
      GO TO 54
   56 CONTINUE
      GO TO 51
C
C     CHECK FOR TYPE NAMES IN IMPLICIT STATEMENT
   57 LAST=0
      JTYPE=0
   58 JTYPE=JTYPE+1
      IF(JTYPE.GT.3)GO TO 48
      INIT=LAST+1
      LAST=LAST+KNTLTR(JTYPE)
      JBGN=IBGN
      GO TO 60
   59 JBGN=JBGN+1
   60 IF(JBGN.GT.IEND)GO TO 58
      IF(IBUFFR(JBGN).EQ.IBLANK)GO TO 59
      IF(IBUFFR(JBGN).EQ.ITAB)GO TO 59
      IF(IBUFFR(JBGN).NE.IWORD(INIT))GO TO 58
      INIT=INIT+1
      IF(INIT.LE.LAST)GO TO 59
      IBGN=JBGN
      GO TO 49
C
C     END OF LINE FOUND WHILE PROCESSING
   61 IWHERE=1
      GO TO 4
   62 IWHERE=2
      GO TO 4
   63 IWHERE=3
C     TYPE 999,LETTER,ITYPE
C 999 FORMAT(2X,26A2/1X,26I2/)
      GO TO 4
C
C     NUMBER OR CHARACTER STORAGE OVERFLOW
   64 IFULL=3
      GO TO 66
   65 IFULL=4
   66 NUMUSD=NUMBGN
      LTRUSD=LTRBGN
C
C     RETURN TO CALLING PROGRAM
   67 RETURN
C     JSLASH = -1, PLACE NULL HEADER BEFORE NEXT ITEM
C            = 0, BEYOND SLASH PAIR CONTAINING SOMETHING
C            = 1, WITHIN A SLASH PAIR BUT NOTHING FOUND
C            = 2, WITHIN SLASH PAIR AND SOMTHING FOUND
C     IWHERE = 0, END OF LINE AT NONCRITICAL POINT
C            = 1, END OF LINE IN FINDING ARRAY NAME
C            = 2, END OF LINE IN FINDING SUBSCRIPTS
C            = 3, END OF LINE IN IMPLICIT STATEMENT
C903487431491:
      END
      SUBROUTINE DAPICK(MAXBFR,IBUFFR,LTRLOW,LTRUSD,LTRSTR,
     1    NUMLOW,NUMUSD,NUMSTR,MAXSUB,LOWBFR,KIND  ,LRGLTR,
     2    LRGNUM,LRGKNT,INITAL,KOUNT ,LTRINI,NUMINI,KNTSUB,
     3    INISUB,LMTSUB)
C     RENBR(/IDENTIFY ARRAY NAME AND SUBSCRIPT RANGE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
      DIMENSION IBUFFR(MAXBFR),LTRSTR(LTRUSD),
     1NUMSTR(NUMUSD),INISUB(MAXSUB),LMTSUB(MAXSUB),
     2IDIGIT(10)
      DATA IEQUAL,ILEFT,IRIGHT,IPLUS,IMINUS,ICOMMA,ISLASH,
     1ICOLON,KOMENT,IAND,IEND,IBLANK,ITAB/1H=,1H(,1H),1H+,
     21H-,1H,,1H/,1H:,1H!,1H&,1H;,1H ,1H	/
      DATA IDIGIT/
     11H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     FIND FIRST AND FINAL NON-BLANK CHARACTERS READ
      KNTSUB=0
      LTREND=LOWBFR
      NEEDED=KIND
      KONTNU=KIND
      GO TO 2
    1 LTREND=LTREND+1
    2 IF(LTREND.GT.MAXBFR)GO TO 5
      IF(IBUFFR(LTREND).EQ.KOMENT)GO TO 5
      IF(IBUFFR(LTREND).NE.IAND)GO TO 1
      KONTNU=0
      GO TO 5
    3 NEEDED=0
    4 LOWBFR=LOWBFR+1
    5 IF(LOWBFR.GE.LTREND)GO TO 47
      IF(IBUFFR(LOWBFR).EQ.IBLANK)GO TO 4
      IF(IBUFFR(LOWBFR).EQ.ITAB)GO TO 4
      IF(IBUFFR(LOWBFR).EQ.IEND)GO TO 3
      IF(NEEDED.GT.0)GO TO 52
    6 LTREND=LTREND-1
      IF(LTREND.LE.LOWBFR)GO TO 7
      IF(IBUFFR(LTREND).EQ.IBLANK)GO TO 6
      IF(IBUFFR(LTREND).EQ.ITAB)GO TO 6
C
C     TEST IF ARRAY NAME APPEARS IN DICTIONARY
    7 NUMNXT=NUMLOW
      LTRNXT=LTRLOW
      LRGKNT=0
    8 NUMINI=NUMNXT
      LTRINI=LTRNXT
      IF(NUMINI.GT.NUMUSD)GO TO 51
      LTRKNT=NUMSTR(NUMINI)
      NEEDED=NUMSTR(NUMINI+2)
      NUMNXT=NUMNXT+3+NEEDED+NEEDED
      IF(LTRKNT.GT.0)GO TO 9
      LTRNXT=LTRNXT-LTRKNT
      INITAL=1
      KOUNT=0
      LRGKNT=LRGKNT+1
      LRGNUM=NUMINI
      LRGLTR=LTRINI
      GO TO 8
    9 LTRNXT=LTRNXT+LTRKNT
      IF(LRGKNT.LE.0)GO TO 8
      NXTBFR=LOWBFR
      LTRLOC=LTRINI
      KOUNT=KOUNT+1
   10 IF(LTRSTR(LTRLOC).NE.IBUFFR(NXTBFR))GO TO 13
      LTRLOC=LTRLOC+1
   11 NXTBFR=NXTBFR+1
      IF(NXTBFR.GT.LTREND)GO TO 12
      IF(IBUFFR(NXTBFR).EQ.IBLANK)GO TO 11
      IF(IBUFFR(NXTBFR).EQ.ITAB)GO TO 11
      IF(LTRLOC.LT.LTRNXT)GO TO 10
      IF(IBUFFR(NXTBFR).EQ.IEND)GO TO 43
      IF(IBUFFR(NXTBFR).EQ.IEQUAL)GO TO 44
      IF(IBUFFR(NXTBFR).EQ.ILEFT)GO TO 16
      GO TO 13
   12 IF(LTRLOC.GE.LTRNXT)GO TO 43
C
C     COMPUTE ARRAY SIZE AND ADD TO OFFSET IF NOMATCH
   13 ISIZE=1
      NUMINI=NUMINI+1
   14 IF(NEEDED.LE.0)GO TO 15
      NUMINI=NUMINI+2
      I=NUMSTR(NUMINI+1)-NUMSTR(NUMINI)
      IF(I.LT.0)I=-I
      ISIZE=ISIZE*(I+1)
      NEEDED=NEEDED-1
      GO TO 14
   15 INITAL=INITAL+ISIZE
      GO TO 8
C
C     FIND USER INDICATED SUBSCRIPTS
   16 KIND=1
      LOWBFR=NXTBFR
      IDONE=0
      INDEX=NUMINI+1
   17 INIVAL=0
      INIGOT=0
      LMTGOT=0
   18 ISIGN=1
   19 IF(LOWBFR.GE.LTREND)GO TO 28
      LOWBFR=LOWBFR+1
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 19
      IF(LETTER.EQ.ITAB)GO TO 19
      IF(LETTER.EQ.IRIGHT)GO TO 28
      IF(LETTER.EQ.ISLASH)GO TO 26
      IF(LETTER.EQ.ICOLON)GO TO 26
      IF(LETTER.EQ.IPLUS)GO TO 23
      IF(LETTER.EQ.IMINUS)GO TO 22
      IF(LETTER.EQ.ICOMMA)GO TO 29
      IF(LETTER.EQ.IEQUAL)GO TO 27
      IF(LETTER.EQ.IEND)GO TO 27
      DO 21 I=1,10
      IF(LETTER.NE.IDIGIT(I))GO TO 21
      IF(LMTGOT.NE.0)GO TO 20
      INIVAL=(10*INIVAL)+I-1
      INIGOT=ISIGN
      GO TO 19
   20 LMTVAL=(10*LMTVAL)+I-1
      LMTGOT=ISIGN
      GO TO 19
   21 CONTINUE
      GO TO 19
   22 ISIGN=-1
      GO TO 24
   23 ISIGN=1
   24 IF(LMTGOT.NE.0)GO TO 25
      IF(INIGOT.NE.0)GO TO 25
      INIGOT=ISIGN
      GO TO 19
   25 LMTGOT=ISIGN
      LMTVAL=0
      GO TO 19
   26 LMTGOT=2
      LMTVAL=0
      GO TO 18
   27 LOWBFR=LOWBFR-1
   28 IDONE=1
C
C     STORE THE EVALUATED SUBSCRIPT RANGE
   29 IF(KNTSUB.GE.MAXSUB)GO TO 37
      INDEX=INDEX+2
      IF(INIGOT.NE.0)GO TO 32
      IF(INDEX.GE.NUMNXT)GO TO 30
      INIVAL=NUMSTR(INDEX)
      GO TO 31
   30 INIVAL=1
   31 IF(LMTGOT.NE.0)GO TO 33
      GO TO 34
   32 IF(INIGOT.LT.0)INIVAL=-INIVAL
      IF(LMTGOT.NE.0)GO TO 33
      LMTVAL=INIVAL
      GO TO 36
   33 IF(LMTGOT.GT.1)GO TO 34
      IF(LMTGOT.LT.0)LMTVAL=-LMTVAL
      GO TO 36
   34 IF(INDEX.GE.NUMNXT)GO TO 35
      LMTVAL=NUMSTR(INDEX+1)
      GO TO 36
   35 LMTVAL=1
   36 KNTSUB=KNTSUB+1
      INISUB(KNTSUB)=INIVAL
      LMTSUB(KNTSUB)=LMTVAL
   37 IF(IDONE.EQ.0)GO TO 17
C
C     CHECK FOR EQUALS SIGN RIGHT OF SUBSCRIPTS
   38 LOWBFR=LOWBFR+1
      IF(LOWBFR.GT.LTREND)GO TO 39
      IF(IBUFFR(LOWBFR).EQ.IBLANK)GO TO 38
      IF(IBUFFR(LOWBFR).EQ.ITAB)GO TO 38
      IF(IBUFFR(LOWBFR).NE.IEQUAL)GO TO 39
      KIND=2
      LOWBFR=LOWBFR+1
C
C     CHECK SUBSCRIPT RANGES
   39 IF(NEEDED.NE.KNTSUB)GO TO 42
      IF(NEEDED.EQ.0)GO TO 53
      INDEX=NUMINI+1
      DO 41 I=1,NEEDED
      INDEX=INDEX+2
      IF(NUMSTR(INDEX).GT.NUMSTR(INDEX+1))GO TO 40
      IF(INISUB(I).LT.NUMSTR(INDEX))GO TO 50
      IF(INISUB(I).GT.NUMSTR(INDEX+1))GO TO 50
      IF(LMTSUB(I).LT.NUMSTR(INDEX))GO TO 50
      IF(LMTSUB(I).GT.NUMSTR(INDEX+1))GO TO 50
      GO TO 41
   40 IF(INISUB(I).GT.NUMSTR(INDEX))GO TO 50
      IF(INISUB(I).LT.NUMSTR(INDEX+1))GO TO 50
      IF(LMTSUB(I).GT.NUMSTR(INDEX))GO TO 50
      IF(LMTSUB(I).LT.NUMSTR(INDEX+1))GO TO 50
   41 CONTINUE
      GO TO 53
C
C     UNEQUAL NUMBER OF SUBSCRIPTS
   42 IF(NEEDED.NE.0)GO TO 49
      IF(KNTSUB.NE.1)GO TO 49
      IF(INISUB(1).NE.1)GO TO 49
      IF(LMTSUB(1).NE.1)GO TO 49
      GO TO 53
C
C     NO SUBSCRIPTS TYPED BY USER, CHECK IF UNDIMENSIONED
   43 KIND=1
      LOWBFR=NXTBFR
      GO TO 45
   44 KIND=2
      LOWBFR=NXTBFR+1
   45 IF(NEEDED.EQ.0)GO TO 46
      IF(NEEDED.GT.1)GO TO 49
      IF(NUMSTR(NUMINI+3).NE.1)GO TO 49
      IF(NUMSTR(NUMINI+4).NE.1)GO TO 49
   46 KNTSUB=1
      INISUB(1)=1
      LMTSUB(1)=1
      GO TO 53
C
C     RETURN TO CALLING PROGRAM
   47 LOWBFR=MAXBFR+1
      IF(KONTNU.GE.0)GO TO 48
      KIND=3
      GO TO 53
   48 KIND=4
      GO TO 53
   49 KIND=5
      GO TO 53
   50 KIND=6
      GO TO 53
   51 KIND=7
      GO TO 53
   52 KIND=8
   53 RETURN
C502952324441:!&;
      END
      SUBROUTINE DALIST(JTTY  ,LTRLOW,LTRUSD,LTRSTR,NUMLOW,
     1NUMUSD,NUMSTR,NAMMAX,NAME)
C     RENBR(/LIST ARRAY MANIPULATION DICTIONARY)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
      DIMENSION LTRSTR(LTRUSD),NUMSTR(NUMUSD),NAME(NAMMAX)
      DATA ISPACE/1H /
C
C     LOCATIONS OF INITIAL NUMBER AND INITIAL CHARACTER
      NUMNXT=NUMLOW
      LTRNXT=LTRLOW
      NAMUSD=0
C
C     GET INFORMATION ABOUT NEXT ARRAY
    1 NUMINI=NUMNXT
      IF(NUMINI.GT.NUMUSD)GO TO 3
      LTRINI=LTRNXT
      LTRKNT=NUMSTR(NUMINI)
      KNTSUB=NUMSTR(NUMINI+2)
      IF(KNTSUB.LT.0)GO TO 8
      NUMNXT=NUMINI+3+KNTSUB+KNTSUB
      IF(NUMNXT.GT.(NUMUSD+1))GO TO 8
      IF(LTRKNT.GT.0)GO TO 2
C
C     START OF RECORD DESCRIPTION
      LTRNXT=LTRNXT-LTRKNT
      GO TO 3
C
C     PRINT PREVIOUS LINE OF DESCRIPTIONS IF LINE FULL
    2 LTRNXT=LTRINI+LTRKNT
      IF(LMTTYP.EQ.-2)GO TO 3
      IF(LSTTYP.NE.NUMSTR(NUMINI+1))GO TO 3
      IF(NAMUSD.LE.0)GO TO 5
      IF(NAMUSD.LT.NAMMAX)GO TO 6
    3 IF(NAMUSD.GT.0)WRITE(JTTY,4)(NAME(I),I=1,NAMUSD)
    4 FORMAT(1X,100A1)
      IF(NUMINI.GT.NUMUSD)GO TO 10
      NAMUSD=0
    5 LMTTYP=-2
      GO TO 7
C
C     INSERT NEXT DESCRIPTION INTO LINE
    6 NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ISPACE
    7 LSTBFR=NAMUSD
      CALL DALONE(LMTTYP,LTRINI,LTRUSD,LTRSTR,NUMINI,
     1NUMUSD,NUMSTR,1,NUMSTR,NAMMAX,NAME,NAMUSD)
      IF(NAMUSD.LE.0)GO TO 8
      IF(NAMUSD.LE.LSTBFR)GO TO 3
      LMTTYP=-1
      LSTTYP=NUMSTR(NUMINI+1)
      IF(NUMSTR(NUMINI).LE.0)LMTTYP=-2
      GO TO 1
C
C     RETURN TO CALLING PROGRAM
    8 WRITE(JTTY,9)
    9 FORMAT(' DALIST - ARRAY DESCRIPTION ERROR')
   10 RETURN
C400023395953'
      END
      SUBROUTINE DALONE(LMTTYP,LTRINI,LTRUSD,LTRSTR,NUMINI,
     1    NUMUSD,NUMSTR,KNTSUB,NOWSUB,NAMMAX,NAME  ,NAMUSD)
C     RENBR(/REPRESENT ARRAY NAME AND SUBSCRIPT LIMITS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
      DIMENSION LTRSTR(LTRUSD),NUMSTR(NUMUSD),
     1NAME(NAMMAX),NOWSUB(KNTSUB),ITYPE(16),LTRBGN(4)
      DATA LTRBGN/1,6,13,18/
      DATA ITYPE/
     11HO,1HC,1HT,1HA,1HL,
     21HI,1HN,1HT,1HE,1HG,1HE,1HR,
     31HR,1HE,1HA,1HL/
      DATA ILEFT,IRIGHT,ICOMMA,ISLASH,ISPACE/
     11H(,1H),1H,,1H/,1H /
C
      INITAL=NAMUSD
      LTRGET=LTRINI
      NUMGET=NUMINI+1
      LTRKNT=NUMSTR(NUMINI)
C
C     INSERT NUMBER TYPE OR SIZE OF RECORD
      IF(LMTTYP.GE.-1)GO TO 3
      IVALUE=NUMSTR(NUMINI+1)
      IPART=-1
      IF(LTRKNT.LE.0)GO TO 15
      IVALUE=IVALUE+2
      J=LTRBGN(IVALUE)
      K=LTRBGN(IVALUE+1)-1
      DO 1 I=J,K
      IF(NAMUSD.GE.NAMMAX)GO TO 17
      NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ITYPE(I)
    1 CONTINUE
    2 IF(NAMUSD.GE.NAMMAX)GO TO 17
      NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ISPACE
C
C     INSERT ARRAY NAME INTO OUTPUT BUFFER
    3 IF(LTRKNT.LT.0)LTRKNT=-LTRKNT
    4 IF(LTRKNT.LE.0)GO TO 5
      IF(NAMUSD.GE.NAMMAX)GO TO 17
      NAMUSD=NAMUSD+1
      IF(LTRGET.GT.LTRUSD)GO TO 17
      NAME(NAMUSD)=LTRSTR(LTRGET)
      LTRGET=LTRGET+1
      LTRKNT=LTRKNT-1
      GO TO 4
C
C     INSERT SUBSCRIPT LIMITS INTO OUTPUT BUFFER
    5 IF(LMTTYP.LE.0)GO TO 6
      MAXSUB=1
      GO TO 7
    6 MAXSUB=NUMSTR(NUMINI+2)
      IF(MAXSUB.LE.0)GO TO 18
    7 IF(NAMUSD.GE.NAMMAX)GO TO 17
      NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ILEFT
      NEWSUB=0
    8 NEWSUB=NEWSUB+1
      IF(NEWSUB.GT.MAXSUB)GO TO 16
      IF(LMTTYP.LT.0)GO TO 10
      IF(LMTTYP.EQ.0)GO TO 9
      IVALUE=LMTTYP
      GO TO 14
    9 IVALUE=NOWSUB(NEWSUB)
      GO TO 14
   10 NUMGET=NUMGET+2
      IF(NUMSTR(NUMGET+1).LE.0)GO TO 11
      IF(NUMSTR(NUMGET).EQ.1)GO TO 13
   11 IVALUE=NUMSTR(NUMGET)
      IPART=0
      GO TO 15
   12 IF(NAMUSD.GE.NAMMAX)GO TO 17
      NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ISLASH
   13 IVALUE=NUMSTR(NUMGET+1)
   14 IPART=1
   15 LFTCOL=NAMUSD
      CALL DANUMB(0,IVALUE,10,NAME,NAMUSD,LFTCOL,NAMMAX)
      IF(NAMUSD.EQ.LFTCOL)GO TO 17
      IF(NAMUSD.GE.NAMMAX)GO TO 17
      IF(IPART.EQ.0)GO TO 12
      IF(IPART.LT.0)GO TO 2
      NAMUSD=NAMUSD+1
      NAME(NAMUSD)=ICOMMA
      GO TO 8
   16 NAME(NAMUSD)=IRIGHT
      GO TO 18
C
C     RETURN TO CALLING PROGRAM
   17 NAMUSD=INITAL
   18 RETURN
C590391099687
      END
      SUBROUTINE DAVARY(KONTRL,ITTY  ,JTTY  ,LOCATN,NAMUSD,
     1    NAMMAX,MAXBFR,NOTATN,MINDEC,MAXDEC,MINSIG,MAXSIG,
     2    IDECML,AARRAY,IARRAY,NAME  ,IBUFFR,LOWBFR,KIND  ,
     3    MODIFY)
C     RENBR(/TYPE CURRENT VALUE AND ACCEPT NEW VALUE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
C     CONTENTS OF THE FASPH COMMON BLOCK MUST BE
C     MAINTAINED FROM ONE CALL OF THIS ROUTINE TO NEXT
      COMMON/FASPH/INIVAL,INCVAL,LMTVAL,
     1VALINI,VALINC,VALLMT
C
      DIMENSION NAME(NAMMAX),AARRAY(LOCATN),IARRAY(LOCATN),
     1IBUFFR(MAXBFR)
      DATA IEQUAL,ISPACE/1H=,1H /
C
C     REPRESENT THE FORMER VALUE
      MANY=KIND-2
      LOCAL=0
      KOUNT=NAMUSD
      NAMINI=NAMUSD+1
    1 IF((KOUNT+3).GT.NAMMAX)GO TO 3
      NAME(KOUNT+1)=ISPACE
      NAME(KOUNT+2)=IEQUAL
      NAME(KOUNT+3)=ISPACE
      KOUNT=KOUNT+3
      LFTCOL=KOUNT
      IF(KONTRL.GT.0)GO TO 2
      IRADIX=10
      IF(KONTRL.LT.0)IRADIX=8
      CALL DANUMB(0,IARRAY(LOCATN),IRADIX,NAME,KOUNT,
     1LFTCOL,NAMMAX)
      GO TO 3
    2 CALL DARITE(AARRAY(LOCATN),-1,NOTATN,0,0,
     1-3,0,20,MINDEC,MAXDEC,MINSIG,MAXSIG,
     2-1,0,IDECML,0,0,-1,LFTCOL,
     3NAMMAX,NAME,KOUNT,IERR)
    3 IF(MANY.LT.0)GO TO 19
      IF(LOCAL.NE.0)GO TO 20
C
C     GET NEXT VALUE SPECIFIED BY USER
    4 CALL DANEXT(KONTRL,0.01,IBUFFR,MAXBFR,LOWBFR,
     1MANY,KIND,INIVAL,INCVAL,LMTVAL,VALINI,VALINC,
     2VALLMT)
      GO TO(14,22,16,23,5,23,8,10,12),KIND
C
C     STORE NEW VALUE AND REPORT IT IF FROM FORMER LINE
    5 MODIFY=MODIFY+1
      IF(KONTRL.GT.0)GO TO 6
      IARRAY(LOCATN)=INIVAL
      GO TO 7
    6 AARRAY(LOCATN)=VALINI
    7 IF(LOCAL.NE.0)GO TO 23
      LOCAL=1
      GO TO 1
C
C     ILLEGAL ANSWER, CANCEL REST OF BUFFER
    8 WRITE(JTTY,9)
    9 FORMAT(' POSITIVE NUMBER REQUIRED LEFT OF ASTERISK')
      GO TO 15
   10 WRITE(JTTY,11)
   11 FORMAT(' ILLEGAL RANGE SPECIFICATION')
      GO TO 15
   12 WRITE(JTTY,13)IBUFFR(LOWBFR-1)
   13 FORMAT(' ILLEGAL CHARACTER ',1A1)
      GO TO 15
C
C     INPUT BUFFER IS EMPTY
   14 KIND=3
      IF(LOCAL.NE.0)GO TO 23
C
C     ASK USER FOR VALUE IF NOTHING IN INPUT BUFFER
   15 MANY=0
   16 WRITE(JTTY,17)(NAME(I),I=1,KOUNT),ISPACE,IEQUAL,
     1ISPACE
   17 FORMAT(1X,$,100A1)
      READ(ITTY,18)IBUFFR
   18 FORMAT(100A1)
      LOCAL=1
      LOWBFR=1
      GO TO 4
C
C     TELL USER THE NEW VALUE IF BASED ON FORMER ANSWER
C     OR IF THE VALUE IS NOT BEING CHANGED
   19 KIND=1
   20 WRITE(JTTY,21)(NAME(I),I=1,KOUNT)
   21 FORMAT(1X,100A1)
      GO TO 23
C
C     TERMINATE LOOP IF SEMICOLON FOUND
   22 KIND=0
C
C     RETURN TO CALLING PROGRAM
   23 RETURN
C594944882435'$
      END
      SUBROUTINE DAROLL(IRAPID,LOWSUB,KNTSUB,INISUB,LMTSUB,
     1    INCSUB,INLOOP,NOWSUB)
C     RENBR(/OBTAIN NEXT LOOP DESCRIPTION)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO VARY A SET OF LOOP CONTROL PARAMETERS
C     BETWEEN A SET OF LOWER AND UPPER BOUNDS.
C
C     ***************************************************
C     *  CAUTION,  DAROLL MUST BE  CALLED INITIALLY TO  *
C     *  DEFINE LOOP STRUCTURE, THEN AT EACH LOOP END.  *
C     *  NONE OF THE CALLING  ARGUMENTS CAN BE CHANGED  *
C     *  BY CALLING  PROGRAM UNTIL ALL LOOPS ARE DONE.  *
C     ***************************************************
C
C     THE FOLLOWING ARGUMENTS ARE USED AS INPUT ONLY
C
C     IRAPID = 0, THE INNERMOST LOOP (ONE DONE THE MOST
C              RAPIDLY) IS THAT WITH THE SMALLEST
C              SUBSCRIPT.
C            = 1, THE INNERMOST LOOP IS THAT WITH THE
C              LARGEST SUBSCRIPT.
C     LOWSUB = THE INITIAL SUBSCRIPT OF THE ARRAYS WHICH
C              ARE TO BE USED AS THE LOOP DESCRIPTORS.
C     KNTSUB = THE FINAL SUBSCRIPT OF THE ARRAYS WHICH
C              ARE TO BE USED AS THE LOOP DESCRIPTORS.
C              KNTSUB MUST BE GREATER THAN OR EQUAL TO
C              LOWSUB.
C     INISUB = ARRAY CONTAINING THE STARTING VALUES OF THE
C              INDIVIDUAL LOOP LIMITS.
C     LMTSUB = ARRAY CONTAINING ENDING VALUES OF THE
C              INDIVIDUAL LOOP LIMITS.  AN INDIVIDUAL ITEM
C              IN THE LMTSUB ARRAY CAN BE EITHER LESS THAN,
C              EQUAL TO, OR GREATER THAN THE CORRESPONDING
C              ITEM IN THE INISUB ARRAY.
C     INCSUB = ARRAY CONTAINING THE INCREMENT BY WHICH THE
C              NOWSUB ARRAY IS VARIED BETWEEN THE STARTING
C              VALUES IN INISUB ARRAY, AND THE ENDING
C              VALUES IN LMTSUB ARRAY.  IF THE INCREMENT
C              IS ZERO, IT IS CHANGED TO 1.  IF THE
C              INCREMENT HAS THE WRONG SIGN, ITS SIGN IS
C              CHANGED.
C
C     THE FOLLOWING ARGUMENT IS USED AS INPUT, THEN IS
C     RETURNED CHANGED FOR USE BY BOTH THE CALLING PROGRAM
C     AND BY SUBSEQUENT CALLS TO DAROLL
C
C     INLOOP = MUST BE SET TO ZERO BEFORE INITIAL CALL TO
C              DAROLL.  THIS INITIAL CALL WILL SET INLOOP
C              NONZERO, AND WILL COPY THE INISUB ARRAY
C              INTO THE NOWSUB ARRAY FOR USE AS THE LOOP
C              PARAMETERS.  EACH SUBSEQUENT CALL TO DAROLL
C              WILL EITHER LOAD THE PARAMETERS FOR THE
C              NEXT SET OF LOOPS INTO THE NOWSUB ARRAY OR
C              SET INLOOP TO ZERO IF THE LOOP STRUCTURE
C              HAS BEEN COMPLETED.
C
C     THE FOLLOWING ARGUMENT IS RETURNED CHANGED FOR USE
C     BY BOTH THE CALLING PROGRAM AND SUBSEQUENT CALLS TO
C     DAROLL.  THE ORIGINAL CONTENTS ARE IGNORED.
C
C     NOWSUB = ARRAY RETURNED CONTAINING THE LOOP CONTROL
C              PARAMETERS FOR THE NEXT LOOP STRUCTURE.
C              THE CONTENTS OF NOWSUB(LOWSUB) THROUGH
C              NOWSUB(KNTSUB) ARE USED IN THE SAME MANNER
C              AS THE INDEXES OF FORTRAN DO LOOPS.
C              THE VALUES UPON INPUT TO THE INITIAL CALL
C              TO DAROLL ARE IGNORED.
C
      DIMENSION NOWSUB(KNTSUB),INISUB(KNTSUB),
     1LMTSUB(KNTSUB),INCSUB(KNTSUB)
      IF(INLOOP.GT.0)GO TO 5
C
C     OBTAIN STARTING VALUES
      IF(LOWSUB.GT.KNTSUB)GO TO 14
      INLOOP=1
      INDEX=LOWSUB
    1 IF(INDEX.GT.KNTSUB)GO TO 15
      NOWSUB(INDEX)=INISUB(INDEX)
      IF(INCSUB(INDEX).EQ.0)INCSUB(INDEX)=1
      IF(INISUB(INDEX).GT.LMTSUB(INDEX))GO TO 2
      IF(INCSUB(INDEX).GE.0)GO TO 4
      GO TO 3
    2 IF(INCSUB(INDEX).LE.0)GO TO 4
    3 INCSUB(INDEX)=-INCSUB(INDEX)
    4 INDEX=INDEX+1
      GO TO 1
C
C     IF ALREADY INITIALIZED, FIND NEXT VALUES
    5 IF(IRAPID.LE.0)GO TO 6
      INDEX=KNTSUB
      GO TO 8
    6 INDEX=LOWSUB
      GO TO 10
    7 IF(IRAPID.LE.0)GO TO 9
      INDEX=INDEX-1
    8 IF(INDEX.LT.LOWSUB)GO TO 14
      GO TO 11
    9 INDEX=INDEX+1
   10 IF(INDEX.GT.KNTSUB)GO TO 14
   11 NOWSUB(INDEX)=NOWSUB(INDEX)+INCSUB(INDEX)
      IF(INISUB(INDEX).GT.LMTSUB(INDEX))GO TO 12
      IF(NOWSUB(INDEX).LE.LMTSUB(INDEX))GO TO 15
      GO TO 13
   12 IF(NOWSUB(INDEX).GE.LMTSUB(INDEX))GO TO 15
   13 NOWSUB(INDEX)=INISUB(INDEX)
      GO TO 7
C
C     ALL DONE
   14 INLOOP=0
   15 RETURN
C340913287832
      END
      SUBROUTINE DABELT(KOLUMN,INTRVL,JSTIFY,LINE  ,ILEFT ,
     1    IRIGHT,LFTCOL,MAXBFR,IBUFFR,MAXLIN,MAXPRT,MAXUSD)
C     RENBR(/IDENTIFY COLUMN NUMBERS)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JAN 2, 1970 / LOGICAL IF VERSION JUL 26, 1975
C
C     WHEN A PROGRAM NEEDS TO DISPLAY TO THE USER A LINE OF
C     CHARACTERS  IN  WHICH  THE CHARACTERS ARE ORIENTED BY
C     COLUMNS, A BAND OF NUMBERS  IDENTIFYING  THE  COLUMNS
C     CAN  BE  PRINTED,  EITHER  ABOVE  OR  BELOW  THE MAIN
C     DISPLAY, BY CALLING THE DABELT  ROUTINE  TO  GENERATE
C     EACH LINE OF THE REPRESENTATION OF THE COLUMN NUMBERS
C     IN A BUFFER ARRAY WHICH THE CALLING PROGRAM CAN  THEN
C     PRINT  WITH  A  MULTIPLE  OF AN A1 FORMAT.  DABELT IS
C     CALLED AS MANY  TIMES  AS  THERE  ARE  LINES  IN  THE
C     REPRESENTATION  OF  THE  COLUMN  NUMBERS, THE CALLING
C     PROGRAM PRINTING THE RETURNED CHARACTERS BEFORE AGAIN
C     ASKING DABELT TO GENERATE THE NEXT LINE.
C
C     NUMBERS CAN BE GENERATED WITH  EACH  LINE  CONTAINING
C     DIGITS  CORRESPONDING  TO  SAME  POWER  OF  10  AS IN
C     FOLLOWING EXAMPLE
C
C                5432109876543210123456789012345
C                111111---------          111111
C                ------
C
C     OR  WITH  EACH  LINE  CONTAINING   DIGITS   OF   SAME
C     SIGNIFICANCE AS IN FOLLOWING EXAMPLE.
C
C                ---------------0123456789111111
C                111111987654321          012345
C                543210
C
C     NUMBERS  CAN  DECREASE  FROM  LEFT  TO  RIGHT  AS  IN
C     FOLLOWING EXAMPLE
C
C                5432109876543210123456789012345
C                111111          ---------111111
C                                         ------
C
C     AND  CAN  HAVE  ANY  DESIRED  SPACING  AND  INCREMENT
C     BETWEEN ADJACENT NUMBERS AS IN FOLLOWING EXAMPLE.
C
C         - - 0 1 2 3 4 5 6 7 8 9 1 1 1 1 1 1 1 1 1 1 2
C         2 1   0 0 0 0 0 0 0 0 0 0 1 2 3 4 5 6 7 8 9 0
C         0 0   0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
C         0 0                     0 0 0 0 0 0 0 0 0 0 0
C
C     FOLLOWING ARE INPUT ARGUMENTS LEFT UNCHANGED.
C
C     KOLUMN = NUMBER OF COLUMNS  TO  BE  USED  FOR  SINGLE
C              NUMBER.   IF  KOLUMN IS GREATER THAN 1, THEN
C              KOLUMN-1 COLUMNS OF SPACES WILL BE  INSERTED
C              BETWEEN   NUMBERS.   NO  EXTRA  SPACES  WILL
C              APPEAR TO RIGHT  OF  RIGHT  NUMBER  EVEN  IF
C              KOLUMN  IS  GREATER THAN 1.  EFFECTIVE VALUE
C              OF KOLUMN IS 1 IF KOLUMN IS INPUT LESS  THAN
C              OR EQUAL TO ZERO.
C
C     INTRVL = DIFFERENCE BETWEEN  ADJACENT  NUMBERS  WHICH
C              ARE  TO  BE REPRESENTED IN IBUFFR ARRAY.  IF
C              SIGN OF INTRVL  IS  WRONG  TO  PROCEED  FROM
C              ILEFT  TO  IRIGHT,  THEN  SIGN  OF EFFECTIVE
C              VALUE OF INTRVL IS REVERSED,  BUT  SIGN  AND
C              VALUE   OF   ARGUMENT  SUPPLIED  BY  CALLING
C              PROGRAM ARE LEFT UNCHANGED.  EFFECTIVE VALUE
C              OF  INTRVL  IS 1 IF INTRVL IS INPUT EQUAL TO
C              ZERO.
C
C     JSTIFY = 0,  EACH   LINE   IS   TO   CONTAIN   DIGITS
C              CORRESPONDING  TO  SAME  POWER  OF  10 AS IN
C              FIRST EXAMPLE AT START OF  DOCUMENTATION  OF
C              THIS  ROUTINE.   LINE  EQUAL  TO  1  SELECTS
C              DIGITS OF LOWEST  SIGNIFICANCE  IN  NUMBERS.
C              LINE  EQUAL  TO  MAXLIN  WILL  SELECT EITHER
C              MINUS SIGN OR DIGITS OF HIGHEST SIGNIFICANCE
C              IF  POSITIVE  IN NUMBER OR NUMBERS REQUIRING
C              MOST CHARACTERS TO REPRESENT.
C            = 1, EACH LINE IS TO CONTAIN  DIGITS  OF  SAME
C              SIGNIFICANCE  AS  IN SECOND EXAMPLE AT START
C              OF  DOCUMENTATION  OF  THIS  ROUTINE.   LINE
C              EQUAL 1 SELECTS EITHER MINUS SIGNS OR DIGITS
C              OF  HIGHEST  SIGNIFICANCE  IF  POSITIVE   IN
C              NUMBERS.   LINE  EQUAL TO MAXLIN WILL SELECT
C              DIGITS OF LOWEST SIGNIFICANCE IN  NUMBER  OR
C              NUMBERS   REQUIRING   MOST   CHARACTERS   TO
C              REPRESENT.
C
C     LINE   = SELECTS  WHICH  LINE  OF  REPRESENTATION  OF
C              NUMBERS  IS TO BE CONSTRUCTED.  LINE EQUAL 1
C              WILL SELECT DIGITS OF LOWEST SIGNIFICANCE IF
C              JSTIFY  IS ZERO, OR MINUS SIGNS OR DIGITS OF
C              HIGHEST SIGNIFICANCE OF POSITIVE NUMBERS  IF
C              JUSTIFY EQUALS 1.  LINE EQUAL TO MAXLIN WILL
C              SELECT MINUS  SIGNS  OR  DIGITS  OF  HIGHEST
C              SIGNIFICANCE   IF   POSITIVE  OF  NUMBER  OR
C              NUMBERS   REQUIRING   MOST   CHARACTERS   TO
C              REPRESENT  IF  JSTIFY  IS ZERO, OR DIGITS OF
C              LOWEST SIGNIFICANCE  OF  NUMBER  OR  NUMBERS
C              REQUIRING  MOST  CHARACTERS  TO REPRESENT IF
C              JSTIFY EQUALS 1.  MAXPRT AND MAXUSD ARE BOTH
C              RETURNED  EQUAL  TO INPUT VALUE OF LFTCOL IF
C              LINE IS INPUT GREATER THAN MAXLIN.
C
C              FOLLOWING EXAMPLES ILLUSTRATE DEFINITION  OF
C              LINE FOR JSTIFY EQUAL TO BOTH ZERO AND ONE.
C
C              KOLUMN= 2, INTRVL=75, JSTIFY= 0, ILEFT=-1052
C              LINE=1   2 7 2 7 2 7 2 7 2 7 2 7 2 7 2 3 8 3
C              LINE=2   5 7 0 2 5 7 0 2 5 7 0 2 5 7 - 7 4 2
C              LINE=3   0 9 9 8 7 6 6 5 4 3 3 2 1 -     1 2
C              LINE=4   1 - - - - - - - - - - - -
C              LINE=5   -
C              LINE=6
C
C              KOLUMN= 2, INTRVL=75, JSTIFY= 1, ILEFT=-1052
C              LINE=1   - - - - - - - - - - - - - - - 7 1 2
C              LINE=2   1 9 9 8 7 6 6 5 4 3 3 2 1 7 2 3 4 2
C              LINE=3   0 7 0 2 5 7 0 2 5 7 0 2 5 7     8 3
C              LINE=4   5 7 2 7 2 7 2 7 2 7 2 7 2
C              LINE=5   2
C              LINE=6
C
C              SINCE EFFECTIVE VALUE OF MAXLIN IS NOT KNOWN
C              PRIOR  TO  FIRST  CALL TO THIS ROUTINE, LINE
C              CAN BE SET TO ZERO TO REPRESENT SAME LINE AS
C              IF LINE WAS INPUT EQUAL TO RETURNED VALUE OF
C              MAXLIN.   LINE  IS  RETURNED  UNCHANGED,  SO
C              CALLING  PROGRAM  WOULD IN THIS CASE HAVE TO
C              SET LINE EQUAL TO RETURNED VALUE OF MAXLIN-1
C              PRIOR TO SECOND CALL TO THIS ROUTINE.
C
C     ILEFT  = THE LEFT OR FIRST NUMBER TO BE REPRESENTED.
C
C     IRIGHT = THE RIGHT OR FINAL LIMIT OF  NUMBERS  TO  BE
C              REPRESENTED.   UNLIKE  ILEFT WHICH IS ALWAYS
C              REPRESENTED, IRIGHT IS REPRESENTED  ONLY  IF
C              BUFFER  IS  LARGE  ENOUGH TO INCLUDE NUMBERS
C              THROUGH IRIGHT PLUS EXTRA SPACES  IF  KOLUMN
C              IS  GREATER  THAN  1, AND IF IRIGHT-ILEFT IS
C              EXACTLY WHOLE NUMBER MULTIPLE OF INTRVL.  IF
C              IRIGHT-ILEFT  IS  NOT  EXACTLY  WHOLE NUMBER
C              MULTIPLE OF INTRVL,  THEN  RIGHTMOST  NUMBER
C              WHICH  COULD  BE  REPRESENTED  IF  BUFFER IS
C              LARGE ENOUGH IS NUMBER WHICH IS NEXT SMALLER
C              WHOLE NUMBER MULTIPLE TO RIGHT OF ILEFT.
C
C     LFTCOL = THE SUBSCRIPT OF IBUFFR  ARRAY  LOCATION  TO
C              IMMEDIATE  LEFT OF LOCATION INTO WHICH IS TO
C              BE   PLACED   DIGIT    OR    SIGN    FORMING
C              REPRESENTATION  UPON  CURRENT  LINE  OF LEFT
C              NUMBER.
C
C     MAXBFR = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  IBUFFR
C              ARRAY    INTO    WHICH    CAN    BE   PLACED
C              REPRESENTATIONS  OF   NUMBERS   FROM   ILEFT
C              THROUGH  IRIGHT.   THIS  WOULD  NORMALLY  BE
C              DIMENSION OF IBUFFR ARRAY.
C
C     FOLLOWING ARGUMENTS ARE USED FOR OUTPUT.  THEIR INPUT
C     VALUES ARE IGNORED.
C
C     IBUFFR = ARRAY IN WHICH NUMBERS ARE TO BE REPRESENTED
C              AND  WHICH  CAN  THEN  BE PRINTED BY CALLING
C              PROGRAM USING MULTIPLE OF A1 FORMAT.
C
C     MAXLIN = RETURNED CONTAINING NUMBER OF  LINES  NEEDED
C              TO  REPRESENT  NUMBERS ILEFT THROUGH IRIGHT.
C              ACTUAL NUMBER OF LINES WHICH  WOULD  INCLUDE
C              PRINTING  CHARACTERS MAY BE LESS SINCE RIGHT
C              NUMBER ACTUALLY DISPLAYED CAN REQUIRE  FEWER
C              CHARACTERS FOR ITS REPRESENTATION THAN WOULD
C              IRIGHT.
C
C     MAXPRT = RETURNED  CONTAINING  SUBSCRIPT   OF   RIGHT
C              LOCATION IN IBUFFR ARRAY CONTAINING PRINTING
C              CHARACTER GENERATED  BY  THIS  ROUTINE.   IF
C              CURRENT  CALL  TO THIS ROUTINE HAS NOT ADDED
C              ANY  PRINTING  CHARACTERS  TO  IBUFFR,  THEN
C              MAXPRT WILL BE RETURNED EQUAL TO LFTCOL.
C
C     MAXUSD = RETURNED  CONTAINING  SUBSCRIPT   OF   RIGHT
C              LOCATION  IN  IBUFFR  ARRAY  CONTAINING  ANY
C              CHARACTER GENERATED  BY  THIS  ROUTINE.   IF
C              LINE  IS  LESS THAN OR EQUAL TO MAXLIN, THEN
C              MAXUSD WILL BE RETURNED EQUAL  TO  VALUE  OF
C              MAXPRT  WHICH  WOULD BE RETURNED IF LINE WAS
C              INPUT  AS  1.   SINCE   RIGHTMOST   PRINTING
C              CHARACTER  GENERATED BY CURRENT CALL TO THIS
C              ROUTINE CAN BE TO LEFT OF THAT GENERATED  IF
C              LINE  IS  1,  ARRAY  LOCATIONS  STARTING  AT
C              IBUFFR(MAXPRT+1) THROUGH IBUFFR(MAXUSD) WILL
C              CONTAIN  SPACES.   IF  LINE  IS GREATER THAN
C              RETURNED VALUE OF  MAXLIN,  THEN  MAXUSD  IS
C              RETURNED EQUAL TO LFTCOL.
C
      DIMENSION IBUFFR(MAXBFR),IDGT(10)
      DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA ISPACE,IMINUS/1H ,1H-/
C
C     FIND OUT WHICH DIRECTION TO TRAVEL
      MAXUSD=LFTCOL
      MAXPRT=LFTCOL
      JNCRMT=INTRVL
      IF(JNCRMT.LT.0)JNCRMT=-JNCRMT
      IF(JNCRMT.EQ.0)JNCRMT=1
      IF(ILEFT.GT.IRIGHT)JNCRMT=-JNCRMT
      INCRMT=INTRVL
      IF(INCRMT.LT.0)INCRMT=-INCRMT
      IF(INCRMT.LE.0)INCRMT=1
C
C     FIND LIMITING VALUE OF INTERVAL
      IF(ILEFT.LE.IRIGHT)GO TO 2
      IF(IRIGHT.GE.0)GO TO 1
      ITEST=-10*IRIGHT
      IF(ILEFT.LE.ITEST)GO TO 4
    1 ITEST=ILEFT
      GO TO 4
    2 IF(ILEFT.GE.0)GO TO 3
      ITEST=-10*ILEFT
      IF(IRIGHT.LE.ITEST)GO TO 4
    3 ITEST=IRIGHT
C
C     FIND INTERVAL CORRESPONDING TO LINE NUMBER
    4 IPWR10=1
      MAXLIN=0
    5 MAXLIN=MAXLIN+1
      IF(LINE.EQ.MAXLIN)IUSE=IPWR10
      IPWR10=10*IPWR10
      IF(IPWR10.LE.ITEST)GO TO 5
C
C     DETERMINE IF LINE NUMBER IS IN PROPER RANGE
      IF(LINE.GT.MAXLIN)GO TO 38
C
C     INITIAL CONDITIONS
      ITOTAL=ILEFT
      IPOSN=LFTCOL
      LEVEL=LINE
      IF(LINE.GT.0)GO TO 6
      IUSE=IPWR10/10
      LEVEL=MAXLIN
    6 IF(JSTIFY.GT.0)GO TO 26
C
C     DETERMINE HOW MANY TIMES FIRST DIGIT APPEARS
    7 LIMIT=ITOTAL
      IF(LIMIT.LT.0)LIMIT=-LIMIT
      LIMIT=LIMIT/IUSE
      IF(ILEFT.GT.IRIGHT)GO TO 8
      JUSE=IUSE
      IF(ITOTAL.LT.0)GO TO 10
      LIMIT=(JUSE*LIMIT)+IUSE-1
      GO TO 9
    8 JUSE=-IUSE
      IF(ITOTAL.GT.0)GO TO 10
      LIMIT=(JUSE*LIMIT)-IUSE+1
    9 JDRCTN=1
      GO TO 11
   10 LIMIT=-(JUSE*LIMIT)
      JDRCTN=-1
   11 IADD=1
      IF(IUSE.LE.INCRMT)IADD=INCRMT/IUSE
      IADD=JUSE*IADD
      GO TO 33
C
C     PUT IN DIGITS OR SPACES OR MINUS SIGNS
   12 IF(ILEFT.LE.IRIGHT)GO TO 13
      IF(LIMIT.LT.IRIGHT)LIMIT=IRIGHT
      GO TO 14
   13 IF(LIMIT.GT.IRIGHT)LIMIT=IRIGHT
   14 IF(ILEFT.LE.IRIGHT)GO TO 15
      IF(ITOTAL.GE.LIMIT)GO TO 16
      IF(ITOTAL.LT.IRIGHT)GO TO 38
      GO TO 27
   15 IF(ITOTAL.LE.LIMIT)GO TO 16
      IF(ITOTAL.GT.IRIGHT)GO TO 38
      GO TO 27
   16 IF(IPOSN.GE.MAXBFR)GO TO 38
      IPOSN=IPOSN+1
      IF(JSTIFY.LE.0)GO TO 18
      IF(LEVEL.NE.1)GO TO 17
      IF(ITOTAL.LT.0)GO TO 19
      IF(ITOTAL.EQ.0)INDEX=1
      GO TO 22
   17 IF(IUSE.LE.0)GO TO 21
      GO TO 22
   18 IF(IUSE.EQ.1)GO TO 22
      IF(ITOTAL.GE.0)GO TO 20
      IF(ITOTAL.LE.-IUSE)GO TO 22
      IF(ITOTAL.GT.-(IUSE/10))GO TO 21
   19 IBUFFR(IPOSN)=IMINUS
      GO TO 23
   20 IF(ITOTAL.GE.IUSE)GO TO 22
   21 IBUFFR(IPOSN)=ISPACE
      GO TO 24
   22 IBUFFR(IPOSN)=IDGT(INDEX)
   23 MAXPRT=IPOSN
   24 MAXUSD=IPOSN
      JSPACE=KOLUMN
      ITOTAL=ITOTAL+JNCRMT
   25 IF(IPOSN.GE.MAXBFR)GO TO 38
      JSPACE=JSPACE-1
      IF(JSPACE.LE.0)GO TO 14
      IPOSN=IPOSN+1
      IBUFFR(IPOSN)=ISPACE
      GO TO 25
C
C     FIND NEXT POWER OF 10 IF JSTIFY IS GREATER THAN ZERO
   26 LUSE=10*IUSE
      KUSE=IUSE
      GO TO 28
   27 IF(JSTIFY.LE.0)GO TO 31
   28 ITEST=ITOTAL
      IF(ITEST.LT.0)ITEST=-10*ITEST
      IF(ITEST.LT.KUSE)GO TO 30
      ITEST=ITEST/LUSE
      IUSE=1
   29 IF(IUSE.GT.ITEST)GO TO 7
      IUSE=10*IUSE
      GO TO 29
   30 IUSE=0
      LIMIT=ITOTAL
      GO TO 12
C
C     GET LIMIT IF JSTIFY EQUALS ZERO
   31 LIMIT=LIMIT+IADD
      IF(JDRCTN.GE.0)GO TO 33
      IF(ILEFT.LE.IRIGHT)GO TO 32
      IF(ITOTAL.GT.0)GO TO 35
      IF(IADD.NE.-1)LIMIT=LIMIT+1
      JDRCTN=1
      GO TO 34
   32 IF(ITOTAL.LT.0)GO TO 34
      IF(IADD.NE.1)LIMIT=LIMIT-1
      JDRCTN=1
      GO TO 35
C
C     GET NEXT DIGIT TO DISPLAY
   33 IF(ITOTAL.GE.0)GO TO 35
   34 INDEX=-ITOTAL/IUSE
      GO TO 36
   35 INDEX=ITOTAL/IUSE
   36 IF(INDEX.LE.9)GO TO 37
      I=INDEX/10
      INDEX=INDEX-(10*I)
   37 INDEX=INDEX+1
      GO TO 12
C
C     RETURN TO CALLING PROGRAM
   38 RETURN
C830889848930
      END
      SUBROUTINE DAIBLT(                     LINE  ,ILEFT ,
     1    IRIGHT,LFTCOL,MAXBFR,IBUFFR,MAXLIN,MAXPRT,MAXUSD)
C     RENBR(/IDENTIFY COLUMN NUMBERS)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JAN 2, 1970
C
C     WHEN A PROGRAM NEEDS TO DISPLAY TO THE USER A LINE OF
C     CHARACTERS  IN  WHICH  THE CHARACTERS ARE ORIENTED BY
C     COLUMNS, A BAND OF NUMBERS  IDENTIFYING  THE  COLUMNS
C     CAN  BE  PRINTED,  EITHER  ABOVE  OR  BELOW  THE MAIN
C     DISPLAY, BY CALLING THE DAIBLT  ROUTINE  TO  GENERATE
C     EACH LINE OF THE REPRESENTATION OF THE COLUMN NUMBERS
C     IN A BUFFER ARRAY WHICH THE CALLING PROGRAM CAN  THEN
C     PRINT  WITH  A  MULTIPLE  OF AN A1 FORMAT.  DAIBLT IS
C     CALLED AS MANY  TIMES  AS  THERE  ARE  LINES  IN  THE
C     REPRESENTATION  OF  THE  COLUMN  NUMBERS, THE CALLING
C     PROGRAM PRINTING THE RETURNED CHARACTERS BEFORE AGAIN
C     ASKING DAIBLT TO GENERATE THE NEXT LINE.
C
C     EACH LINE OF THE  NUMBER REPRESENTATION  GENERATED BY
C     THIS ROUTINE  CONTAINS  DIGITS  CORRESPONDING  TO THE
C     SAME POWER OF 10 AS IN THE FOLLOWING EXAMPLE.
C
C                5432109876543210123456789012345
C                111111---------          111111
C                ------
C
C     THE FOLLOWING ARE INPUT ARGUMENTS LEFT UNCHANGED.
C
C     LINE   = SELECTS  WHICH  LINE  OF  REPRESENTATION  OF
C              NUMBERS  IS TO BE CONSTRUCTED.  LINE EQUAL 1
C              WILL SELECT  DIGITS OF LOWEST  SIGNIFICANCE.
C              LINE SET  EQUAL TO MAXLIN  (OR TO ZERO) WILL
C              SELECT MINUS  SIGNS  OR  DIGITS  OF  HIGHEST
C              SIGNIFICANCE   IF   POSITIVE  OF  NUMBER  OR
C              NUMBERS   REQUIRING   MOST   CHARACTERS   TO
C              REPRESENT.    MAXPRT  AND  MAXUSD  ARE  BOTH
C              RETURNED  EQUAL  TO INPUT VALUE OF LFTCOL IF
C              LINE IS INPUT GREATER THAN MAXLIN.
C
C              SINCE EFFECTIVE VALUE OF MAXLIN IS NOT KNOWN
C              PRIOR  TO  FIRST  CALL TO THIS ROUTINE, LINE
C              CAN BE SET TO ZERO TO REPRESENT SAME LINE AS
C              IF LINE WAS INPUT EQUAL TO RETURNED VALUE OF
C              MAXLIN.   LINE  IS  RETURNED  UNCHANGED,  SO
C              CALLING  PROGRAM  WOULD IN THIS CASE HAVE TO
C              SET LINE EQUAL TO RETURNED VALUE OF MAXLIN-1
C              PRIOR TO SECOND CALL TO THIS ROUTINE.
C
C     ILEFT  = THE LEFT OR FIRST NUMBER TO BE REPRESENTED.
C
C     IRIGHT = THE RIGHT OR FINAL LIMIT OF  NUMBERS  TO  BE
C              REPRESENTED.   UNLIKE  ILEFT WHICH IS ALWAYS
C              REPRESENTED, IRIGHT IS REPRESENTED  ONLY  IF
C              BUFFER  IS  LARGE  ENOUGH TO INCLUDE NUMBERS
C              THROUGH IRIGHT.   IRIGHT MUST BE EQUAL TO OR
C              GREATER THAN ILEFT.
C
C     LFTCOL = THE SUBSCRIPT OF IBUFFR  ARRAY  LOCATION  TO
C              IMMEDIATE  LEFT OF LOCATION INTO WHICH IS TO
C              BE   PLACED   DIGIT    OR    SIGN    FORMING
C              REPRESENTATION  UPON  CURRENT  LINE  OF LEFT
C              NUMBER.
C
C     MAXBFR = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  IBUFFR
C              ARRAY    INTO    WHICH    CAN    BE   PLACED
C              REPRESENTATIONS  OF   NUMBERS   FROM   ILEFT
C              THROUGH  IRIGHT.   THIS  WOULD  NORMALLY  BE
C              DIMENSION OF IBUFFR ARRAY.
C
C     FOLLOWING ARGUMENTS ARE USED FOR OUTPUT.  THEIR INPUT
C     VALUES ARE IGNORED.
C
C     IBUFFR = ARRAY IN WHICH NUMBERS ARE TO BE REPRESENTED
C              AND  WHICH  CAN  THEN  BE PRINTED BY CALLING
C              PROGRAM USING MULTIPLE OF A1 FORMAT.
C
C     MAXLIN = RETURNED CONTAINING NUMBER OF  LINES  NEEDED
C              TO  REPRESENT  NUMBERS ILEFT THROUGH IRIGHT.
C              ACTUAL NUMBER OF LINES WHICH  WOULD  INCLUDE
C              PRINTING  CHARACTERS MAY BE LESS SINCE RIGHT
C              NUMBER ACTUALLY DISPLAYED CAN REQUIRE  FEWER
C              CHARACTERS FOR ITS REPRESENTATION THAN WOULD
C              IRIGHT.
C
C     MAXPRT = RETURNED  CONTAINING  SUBSCRIPT   OF   RIGHT
C              LOCATION IN IBUFFR ARRAY CONTAINING PRINTING
C              CHARACTER GENERATED  BY  THIS  ROUTINE.   IF
C              CURRENT  CALL  TO THIS ROUTINE HAS NOT ADDED
C              ANY  PRINTING  CHARACTERS  TO  IBUFFR,  THEN
C              MAXPRT WILL BE RETURNED EQUAL TO LFTCOL.
C
C     MAXUSD = RETURNED  CONTAINING  SUBSCRIPT   OF   RIGHT
C              LOCATION  IN  IBUFFR  ARRAY  CONTAINING  ANY
C              CHARACTER GENERATED  BY  THIS  ROUTINE.   IF
C              LINE  IS  LESS THAN OR EQUAL TO MAXLIN, THEN
C              MAXUSD WILL BE RETURNED EQUAL  TO  VALUE  OF
C              MAXPRT  WHICH  WOULD BE RETURNED IF LINE WAS
C              INPUT  AS  1.   SINCE   RIGHTMOST   PRINTING
C              CHARACTER  GENERATED BY CURRENT CALL TO THIS
C              ROUTINE CAN BE TO LEFT OF THAT GENERATED  IF
C              LINE  IS  1,  ARRAY  LOCATIONS  STARTING  AT
C              IBUFFR(MAXPRT+1) THROUGH IBUFFR(MAXUSD) WILL
C              CONTAIN  SPACES.   IF  LINE  IS GREATER THAN
C              RETURNED VALUE OF  MAXLIN,  THEN  MAXUSD  IS
C              RETURNED EQUAL TO LFTCOL.
C
      DIMENSION IBUFFR(MAXBFR),IDGT(10)
      DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA IBLANK,IMINUS/1H ,1H-/
C
      MAXPRT=LFTCOL
      MAXUSD=LFTCOL
      MAXLIN=0
      IF(ILEFT.GT.IRIGHT)GO TO 13
      IF(LFTCOL.GE.MAXBFR)GO TO 13
      IZERO=LFTCOL-ILEFT+1
      MOST=IRIGHT+IZERO
      IF(MOST.GT.MAXBFR)MOST=MAXBFR
      INTRVL=1
      LIMIT=ILEFT
      IF(LIMIT.LT.0)LIMIT=-10*LIMIT
      IF(LIMIT.LT.IRIGHT)LIMIT=IRIGHT
      IPWR10=1
    1 MAXLIN=MAXLIN+1
      IF(LINE.EQ.MAXLIN)INTRVL=IPWR10
      IPWR10=10*IPWR10
      IF(IPWR10.LE.LIMIT)GO TO 1
      IF(LINE.GT.MAXLIN)GO TO 13
C
C     DETERMINE LEFT DIGIT
      LIMIT=ILEFT
      IF(ILEFT.LT.0)LIMIT=-LIMIT
      LIMIT=LIMIT/INTRVL
      INDEX=LIMIT-(10*(LIMIT/10))+1
      IF(ILEFT.GE.0)GO TO 2
      LIMIT=IZERO-(INTRVL*LIMIT)-INTRVL
      GO TO 3
    2 LIMIT=IZERO+(INTRVL*LIMIT)-1
    3 IF(MAXUSD.GE.IZERO)GO TO 4
      IF(MAXUSD.LT.(IZERO-1))GO TO 5
      IF(INTRVL.LE.1)GO TO 9
      GO TO 7
    4 IF(MAXUSD.LT.(IZERO+INTRVL-1))GO TO 7
      GO TO 9
    5 IF(MAXUSD.LT.(IZERO-INTRVL))GO TO 9
C
C     PUT IN MINUS SIGNS IF NECESSARY
      LIMIT=IZERO-(INTRVL/10)
      IF(LIMIT.GT.MOST)LIMIT=MOST
    6 MAXUSD=MAXUSD+1
      IBUFFR(MAXUSD)=IMINUS
      IF(MAXUSD.LT.LIMIT)GO TO 6
      MAXPRT=MAXUSD
      IF(MAXUSD.GE.MOST)GO TO 13
C
C     PUT IN BLANKS IF NECESSARY
    7 LIMIT=IZERO+INTRVL-1
      IF(LIMIT.GT.MOST)LIMIT=MOST
    8 MAXUSD=MAXUSD+1
      IBUFFR(MAXUSD)=IBLANK
      IF(MAXUSD.LT.LIMIT)GO TO 8
      GO TO 11
C
C     PUT IN DIGITS
    9 LIMIT=LIMIT+INTRVL
      IF(LIMIT.GT.MOST)LIMIT=MOST
   10 MAXUSD=MAXUSD+1
      IBUFFR(MAXUSD)=IDGT(INDEX)
      IF(MAXUSD.LT.LIMIT)GO TO 10
      MAXPRT=MAXUSD
   11 IF(MAXUSD.GE.MOST)GO TO 13
C
C     INCREMENT THE DIGIT
      IF(MAXUSD.GE.IZERO)GO TO 12
      INDEX=INDEX-1
      IF(INDEX.LE.0)INDEX=10
      GO TO 3
   12 INDEX=INDEX+1
      IF(INDEX.GT.10)INDEX=1
      GO TO 3
C
C     RETURN TO CALLING PROGRAM
   13 RETURN
C     INDEX  = DIGIT PRESENTLY BEING PUT INTO ARRAY.
C     INTRVL = REPETITIONS OF DIGIT BEFORE INCREMENT.
C     IZERO  = SUBSCRIPT CORRESPONDING TO ZERO (0).
C     MAXUSD  = NUMBER OF CHARACTERS IN IBUFFR ARRAY.
C     LIMIT  = SUBSCRIPT CORRESPONDING TO RIGHT
C              APPEARANCE OF PRESENTLY ADDED DIGIT.
C     MOST   = SUBSCRIPT CORRESPONDING TO IRIGHT.
C536160823302
      END
      SUBROUTINE DABASE(LOCATE,LTRLFT,LTRRIT,LTRNAM,IVALUE,
     1    LTRLOW,LTRUSD,LTRSTR,NUMLOW,NUMUSD,NUMSTR,LRGLTR,
     2    LRGNUM,LRGKNT)
C     RENBR(/LOCATE START OF LOGICAL GROUP DESCRIPTION)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE IS USED ALONG  WITH  SEVERAL  OTHERS  IN
C     FASP,  THE FORTRAN ALPHAMERIC SUBROUTINE PACKAGE, FOR
C     THE PURPOSE OF  SELECTING  BY  NAME  AND  SUBSCRIPTS,
C     EXAMINING AND MODIFYING THE VALUES IN ARRAY LOCATIONS
C     KNOWN TO THE CALLING  PROGRAM.   PLEASE  CONSULT  THE
C     FASP DOCUMENTATION FOR DESCRIPTIONS OF THESE ROUTINES
C
      DIMENSION LTRNAM(LTRRIT),LTRSTR(LTRUSD),
     1NUMSTR(NUMUSD)
C
      LRGLTR=LTRLOW
      LRGNUM=NUMLOW
      LRGKNT=0
      IF(LOCATE.GE.0)GO TO 1
      LTRSIZ=LTRRIT-LTRLFT+1
      IF(LTRSIZ.EQ.0)LTRSIZ=-1
C
C     OBTAIN NUMBER OF LETTERS AND NUMBERS IN ITEM STORAGE
    1 IF(LRGNUM.GE.NUMUSD)GO TO 6
      IF(NUMSTR(LRGNUM+2).LT.0)GO TO 6
      KNTLTR=NUMSTR(LRGNUM)
      KNTNUM=3+(2*NUMSTR(LRGNUM+2))
      IF(KNTLTR.GT.0)GO TO 5
C
C     START OF LOGICAL GROUP FOUND
      LRGKNT=LRGKNT+1
      KNTLTR=-KNTLTR
      IF(LOCATE.GT.0)GO TO 3
      IF(LOCATE.EQ.0)GO TO 4
C
C     TEST IF NAME MATCHES THAT OF LOGICAL GROUP
      IF(KNTLTR.NE.LTRSIZ)GO TO 5
      ITEST=LRGLTR
      JTEST=LTRLFT
    2 IF(LTRSTR(ITEST).NE.LTRNAM(JTEST))GO TO 5
      ITEST=ITEST+1
      JTEST=JTEST+1
      IF(JTEST.LE.LTRRIT)GO TO 2
      GO TO 7
C
C     TEST IF SUBSCRIPT BOUND HAS PROPER VALUE
    3 IF(KNTNUM.LT.(LOCATE+3))GO TO 5
      ITEST=LRGNUM+2+LOCATE
      IF(NUMSTR(ITEST).EQ.IVALUE)GO TO 7
      GO TO 5
C
C     CHECK FOR LRGKNT EQUAL TO IVALUE
    4 IF(LRGKNT.EQ.IVALUE)GO TO 7
C
C     ADVANCE BEYOND CURRENT ITEM IN DICTIONARY
    5 LRGLTR=LRGLTR+KNTLTR
      LRGNUM=LRGNUM+KNTNUM
      GO TO 1
C
C     NO MATCH FOUND
    6 LRGKNT=0
C
C     RETURN TO CALLING PROGRAM
    7 RETURN
C317478262830
      END
      SUBROUTINE DAPAIR(SLACK ,KNDBGN,KNDEND,KONECT,IBUFFR,
     1    MAXBFR,LOWBFR,KIND  ,NEWBGN,NEWEND,BGNNEW,ENDNEW,
     2    IWHERE,INCBGN,LMTBGN,BGNINC,BGNLMT,INCEND,LMTEND,
     3    ENDINC,ENDLMT)
C     RENBR(/INTERPRET PAIR OF ASSOCIATED VALUES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY, AND  ARE
C     RETURNED UNCHANGED.
C
C     SLACK  = FRACTION OF INCREMENT OF  REAL  NUMBER  (NOT
C              INTEGER)  RANGE EXPRESSED IN SLASH NOTATION,
C              BY WHICH RETURNED  VALUE  CAN  EXCEED  FINAL
C              BOUND  AND  STILL BE CONSIDERED TO BE WITHIN
C              RANGE.
C     KNDBGN = SPECIFIES  WHETHER  INDEX  IS  RETURNED   AS
C              INTEGER  ARGUMENT NEWBGN OR AS REAL ARGUMENT
C              BGNNEW.  NUMBER CAN BE  TYPED  WITH  DECIMAL
C              POINT AND/OR EXPONENT REGARDLESS OF VALUE OF
C              KNDBGN.
C            = -1, INDEX IS CALCULATED AS OCTAL INTEGER AND
C              IS  RETURNED  AS  ARGUMENT NEWBGN.  HOWEVER,
C              NUMBER FOLLOWING LETTER  E  OF  EXPONENT  IS
C              EVALUATED IN DECIMAL.
C            = 0, INDEX IS CALCULATED  AS  DECIMAL  INTEGER
C              AND IS RETURNED AS ARGUMENT NEWBGN.
C            = 1 OR GREATER,  INDEX  IS  RETURNED  AS  REAL
C              ARGUMENT  BGNNEW.   IF POSSIBLE, REAL NUMBER
C              WILL BE  ACCUMULATED  AS  INTEGER,  THEN  BE
C              CONVERTED  TO REAL AND SHIFTED AS NECESSARY.
C              KNDBGN  IS  MAXIMUM  NUMBER  OF  DIGITS   IN
C              INTEGER.
C     KNDEND = SPECIFIES  WHETHER   ASSOCIATED   VALUE   IS
C              RETURNED  AS  INTEGER  ARGUMENT NEWEND OR AS
C              REAL ARGUMENT ENDNEW.  NUMBER CAN  BE  TYPED
C              WITH    DECIMAL    POINT   AND/OR   EXPONENT
C              REGARDLESS OF VALUE OF KNDEND.
C            = -1, ASSOCIATED VALUE IS CALCULATED AS  OCTAL
C              INTEGER  AND IS RETURNED AS ARGUMENT NEWEND.
C              HOWEVER,  NUMBER  FOLLOWING  LETTER   E   OF
C              EXPONENT IS EVALUATED IN DECIMAL.
C            = 0, ASSOCIATED VALUE IS CALCULATED AS DECIMAL
C              INTEGER AND IS RETURNED AS ARGUMENT NEWEND.
C            = 1 OR GREATER, ASSOCIATED VALUE  IS  RETURNED
C              AS  REAL ARGUMENT ENDNEW.  IF POSSIBLE, REAL
C              NUMBER WILL BE ACCUMULATED AS INTEGER,  THEN
C              BE   CONVERTED   TO   REAL  AND  SHIFTED  AS
C              NECESSARY.   KNDEND  IS  MAXIMUM  NUMBER  OF
C              DIGITS IN INTEGER.
C
C     KONECT = SPECIFIES  MANNER   OF   INTERPRETATION   OF
C              FOLLOWING  NUMBER  WHEN RANGE OF INDEXES AND
C              RANGE OF ASSOCIATED VALUES  HAVE  BOTH  BEEN
C              EXHAUSTED.   KONECT  ALSO  SPECIFIES WHETHER
C              COMMAS  ARE  TO  INDICATE   THAT   FOLLOWING
C              NUMBER, IF ANY, IS TO BE INDEX OF SUBSEQUENT
C              PAIR, OR WHETHER COMMAS ARE ALLOWED  BETWEEN
C              SUBSEQUENT VALUES ASSOCIATED WITH SAME INDEX
C              OR RANGE OF INDEXES.  REGARDLESS OF VALUE OF
C              KONECT,  ALL  COMMAS  APPEARING  TO  LEFT OF
C              INDEX ARE IGNORED.
C            = -1, 0 OR 1,  COMMAS  CANNOT  APPEAR  BETWEEN
C              SPECIFICATION OF INDEX AND OF ITS ASSOCIATED
C              VALUE    AND    CANNOT    APPEAR     BETWEEN
C              REPRESENTATIONS   OF  SUBSEQUENT  ASSOCIATED
C              VALUES.  IF COMMA IS FOUND,  THEN  FOLLOWING
C              NUMBER,  IF  ANY,  IS  TAKEN  TO BE INDEX OF
C              SUBSEQUENT PAIR OF NUMBERS.
C            = -1, WHEN  RANGE  OF  INDEXES  AND  RANGE  OF
C              ASSOCIATED  VALUES HAVE BOTH BEEN EXHAUSTED,
C              FOLLOWING REPRESENTATION  OF  NUMBER  OR  OF
C              RANGE  OF  NUMBERS  ON SAME LINE IS TAKEN TO
C              SPECIFY ADDITIONAL ASSOCIATED VALUES.
C
C              IF END OF LINE  IS  FOUND  BEFORE  RANGE  OF
C              INDEXES  HAS  BEEN  EXHAUSTED,  THEN CALLING
C              PROGRAM CAN REQUEST (BY  SETTING  KIND=4  TO
C              SIMULATE    FINDING   OF   AMPERSAND)   THAT
C              EVALUATION OF ASSOCIATED  VALUES  IS  TO  BE
C              CONTINUED  BY  NEXT  CALL TO THIS ROUTINE IN
C              NEW TEXT READ INTO INPUT BUFFER.  IF END  OF
C              LINE  IS  FOUND  BEFORE RANGE OF INDEXES HAS
C              BEEN EXHAUSTED, BUT CALLING  PROGRAM  LEAVES
C              KIND  UNCHANGED  BEFORE  AGAIN  CALLING THIS
C              ROUTINE, THEN REMAINING INDEX VALUES WILL BE
C              RETURNED    WITHOUT    ASSOCIATED    VALUES,
C              FOLLOWING WHICH FIRST NUMBER IN NEW CONTENTS
C              OF  TEXT BUFFER WILL BE INTERPRETED AS INDEX
C              OF NEW PAIR.
C
C              IF AMPERSAND IS  FOUND  TO  RIGHT  OF  INDEX
C              SPECIFICATION,  REGARDLESS  OF WHETHER RANGE
C              OF  INDEXES   HAS   BEEN   EXHAUSTED,   THEN
C              EVALUATION  OF  ASSOCIATED  VALUES  WILL  BE
C              CONTINUED BY NEXT CALL TO  THIS  ROUTINE  IN
C              NEW   TEXT   READ  INTO  INPUT  BUFFER.   IF
C              AMPERSAND IS FOUND PRIOR  TO  EXHAUSTION  OF
C              RANGE  OF  INDEXES,  BUT NEXT LINE READ INTO
C              INPUT BUFFER IS TO START NEW PAIR, THEN KIND
C              SHOULD  BE  SET  TO  6  BY  CALLING  PROGRAM
C              CAUSING REMAINING INDEXES  TO  BE  GENERATED
C              FIRST   BUT   MARKED   AS   HAVING   MISSING
C              ASSOCIATED VALUES.  IF  AMPERSAND  IS  FOUND
C              AFTER  EXHAUSTION  OF  RANGE OF INDEXES, BUT
C              NEXT LINE READ INTO INPUT BUFFER IS TO START
C              NEW PAIR, THEN KIND SHOULD BE SET TO ONE.
C
C            = 0,  WHEN  RANGE  OF  INDEXES  AND  RANGE  OF
C              ASSOCIATED  VALUES HAVE BOTH BEEN EXHAUSTED,
C              FOLLOWING REPRESENTATION  OF  NUMBER  OR  OF
C              RANGE  OF  NUMBERS  ON SAME LINE CAUSES THIS
C              ROUTINE  TO  REPORT   MISSING   COMMA,   AND
C              SUBSEQUENT  CALL TO THIS ROUTINE THEN BEGINS
C              EVALUATION OF THIS FOLLOWING NUMBER AS INDEX
C              OR RANGE OF INDEXES OF SUBSEQUENT PAIR.
C
C              IF END OF LINE  IS  FOUND  BEFORE  RANGE  OF
C              INDEXES  HAS  BEEN  EXHAUSTED,  THEN CALLING
C              PROGRAM CAN REQUEST (BY  SETTING  KIND=4  TO
C              SIMULATE    FINDING   OF   AMPERSAND)   THAT
C              EVALUATION OF ASSOCIATED  VALUES  IS  TO  BE
C              CONTINUED  BY  NEXT  CALL TO THIS ROUTINE IN
C              NEW TEXT READ INTO INPUT BUFFER.  IF END  OF
C              LINE  IS  FOUND  BEFORE RANGE OF INDEXES HAS
C              BEEN EXHAUSTED, BUT CALLING  PROGRAM  LEAVES
C              KIND  UNCHANGED  BEFORE  AGAIN  CALLING THIS
C              ROUTINE, THEN REMAINING INDEX VALUES WILL BE
C              RETURNED    WITHOUT    ASSOCIATED    VALUES,
C              FOLLOWING WHICH FIRST NUMBER IN NEW CONTENTS
C              OF  TEXT BUFFER WILL BE INTERPRETED AS INDEX
C              OF SUBSEQUENT PAIR.
C
C              IF AMPERSAND IS FOUND PRIOR TO EXHAUSTION OF
C              RANGE   OF   INDEXES,   THEN  EVALUATION  OF
C              ASSOCIATED VALUES WILL BE CONTINUED BY  NEXT
C              CALL  TO  THIS ROUTINE IN NEW TEXT READ INTO
C              INPUT BUFFER  UNLESS  CALLING  PROGRAM  SETS
C              KIND  TO  6 PRIOR TO SUBSEQUENT CALL TO THIS
C              ROUTINE, CAUSING  REMAINING  INDEXES  TO  BE
C              GENERATED   BUT  MARKED  AS  HAVING  MISSING
C              ASSOCIATED VALUES.  IF  AMPERSAND  IS  FOUND
C              AFTER   RANGE   OF   INDEXES  AND  RANGE  OF
C              ASSOCIATED VALUES HAVE BOTH BEEN  EXHAUSTED,
C              THEN  FIRST  NUMBER  EVALUATED BY SUBSEQUENT
C              CALL TO THIS ROUTINE IN NEW TEXT  READ  INTO
C              INPUT  BUFFER  IS ASSUMED TO BE INDEX OF NEW
C              PAIR OF VALUES.
C
C              = 1, WHEN RANGE  OF  INDEXES  AND  RANGE  OF
C              ASSOCIATED  VALUES HAVE BOTH BEEN EXHAUSTED,
C              FOLLOWING REPRESENTATION  OF  NUMBER  OR  OF
C              RANGE  OF  NUMBERS  ON SAME LINE IS TAKEN TO
C              SPECIFY ADDITIONAL ASSOCIATED VALUES.
C
C              IF EITHER AMPERSAND OR END OF LINE IS  FOUND
C              BEFORE  RANGE OF INDEXES HAS BEEN EXHAUSTED,
C              THEN REMAINING INDEX VALUES WILL BE RETURNED
C              WITHOUT  ASSOCIATED  VALUES, FOLLOWING WHICH
C              CALLING PROGRAM WILL BE INFORMED THAT END OF
C              LINE OR AMPERSAND HAS BEEN REACHED.
C
C            = 2, 3 OR 4, SAME AS WHEN KONECT=-1,  0  OR  1
C              RESPECTIVELY,  EXCEPT THAT COMMAS CAN APPEAR
C              (BUT    ARE    NOT     REQUIRED)     BETWEEN
C              REPRESENTATIONS    OF    INDEX   AND   FIRST
C              ASSOCIATED VALUE AND BETWEEN REPRESENTATIONS
C              OF   SUBSEQUENT  ASSOCIATED  VALUES.   EXTRA
C              COMMA INDICATES  MISSING  ASSOCIATED  VALUE.
C              IF  KONECT=3,  AND  IF  RANGE OF INDEXES AND
C              RANGE OF ASSOCIATED VALUES  HAVE  BOTH  BEEN
C              EXHAUSTED, THEN KIND WILL BE RETURNED SET TO
C              10  TO   INDICATE   MISSING   SEMICOLON   IF
C              FOLLOWING  NUMBER  IS  FOUND  WHETHER OR NOT
C              THIS FOLLOWING NUMBER IS PRECEDED BY  COMMA,
C              AND  SUBSEQUENT  CALL  TO  THIS ROUTINE WILL
C              BEGIN  EVALUATION  OF  FOLLOWING  NUMBER  AS
C              INDEX  OR  RANGE  OF  INDEXES  OF SUBSEQUENT
C              PAIR.  UNLIKE COMMAS, SEMICOLONS ARE  ALWAYS
C              REPORTED  TO  CALLING  PROGRAM REGARDLESS OF
C              VALUE OF KONECT.
C
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED  BY  USER,  READ  BY  MULTIPLE  OF  A1
C              FORMAT, WHICH IS TO BE SEARCHED  FOR  NUMBER
C              SPECIFICATIONS.   IBUFFR  THEN  CONTAINS ONE
C              CHARACTER PER COMPUTER STORAGE LOCATION.
C
C     MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY  LOCATIONS
C              TO BE SEARCHED.
C
C     FOLLOWING ARGUMENTS ARE USED BOTH FOR INPUT  TO  THIS
C     ROUTINE, AND FOR OUTPUT TO CALLING PROGRAM.
C
C     LOWBFR = INPUT  CONTAINING  SUBSCRIPT  WITHIN  IBUFFR
C              ARRAY  OF  FIRST  (LEFTMOST) CHARACTER WHICH
C              CAN BE  SCANNED  FOR  NUMBER  SPECIFICATION.
C              LOWBFR   IS   RETURNED   POINTING   TO  NEXT
C              CHARACTER  WHICH  WOULD  BE  INTERPRETED  BY
C              SUBSEQUENT  CALL  TO  THIS  ROUTINE  IF THIS
C              SUBSEQUENT CALL NEEDS  TO  EVALUATE  FURTHER
C              NUMBER  SPECIFICATIONS.   LOWBFR IS RETURNED
C              UNCHANGED IF THIS ROUTINE  MERELY  GENERATES
C              NEXT   ASSOCIATED  VALUE  WITHIN  PREVIOUSLY
C              DETERMINED RANGE.  IF THERE ARE NO  PRINTING
C              CHARACTERS AT OR TO RIGHT OF IBUFFR(LOWBFR),
C              BUT INTERPRETATION OF ADDITIONAL  CHARACTERS
C              IS  ATTEMPTED,  THEN LOWBFR WILL BE RETURNED
C              CONTAINING MAXBFR+1.  LOWBFR MUST  BE  RESET
C              BY   CALLING   PROGRAM  TO  POINT  TO  FIRST
C              CHARACTER IN IBUFFR ARRAY EACH TIME NEW LINE
C              OF TEXT IS READ.
C
C     KIND   = INPUT CONTAINING -1, ERROR WAS  DETECTED  BY
C              CALLING   PROGRAM   (RATHER   THAN  BY  THIS
C              ROUTINE) IN  RESULTS  RETURNED  BY  PREVIOUS
C              CALL  TO  THIS  ROUTINE  AND  ANY ADDITIONAL
C              NUMBERS THROUGH  NEXT  APPEARANCE  OF  COMMA
C              (UNLESS   KONECT   IS  GREATER  THAN  1)  OR
C              SEMICOLON OR AMPERSAND OR UNKNOWN  CHARACTER
C              OR  END  OF  LINE  ARE  TO BE IGNORED.  NEXT
C              NUMBER  TO  RIGHT  OF  COMMA  OR   ON   LINE
C              FOLLOWING  AMPERSAND OR END OF LINE IS TO BE
C              INTERPRETED AS INDEX OF NEXT PAIR.   UNKNOWN
C              CHARACTER   OR   SEMICOLON  IS  REPORTED  TO
C              CALLING PROGRAM IF IT IS FOUND INSTEAD.
C            = INPUT CONTAINING 0, THIS ROUTINE HAS NOT YET
C              BEEN  CALLED  DURING  EXECUTION  OF  CURRENT
C              LOGICAL SECTION OF  CALLING  PROGRAM.   THIS
C              ROUTINE  IS  TO BEGIN EVALUATION OF CONTENTS
C              OF   INPUT   TEXT   BUFFER,   NOT   CONTINUE
C              GENERATION  OF  RANGES EVALUATED BY PREVIOUS
C              CALLS TO THIS ROUTINE.  LOWBFR SHOULD  POINT
C              TO  FIRST  CHARACTER  IN  IBUFFR ARRAY TO BE
C              INTERPRETED.
C            = INPUT  GREATER  THAN  ZERO,  VALUE  OF  KIND
C              INDICATES  CONDITION  RETURNED  BY  PREVIOUS
C              CALL TO THIS ROUTINE AND IN MOST  CASES  HAS
C              NOT  BEEN MODIFIED BY CALLING PROGRAM.  KIND
C              BEING RETURNED WITH ONE OF VALUES 7,  8,  9,
C              10  (IF  KONECT  IS  2  OR  4),  13  AND  14
C              INDICATES  THAT  PAIR  OF  VALUES  IS  BEING
C              RETURNED, ALTHOUGH EITHER OR BOTH MEMBERS OF
C              PAIR COULD BE MISSING.  OTHER VALUES OF KIND
C              INDICATE  SPECIAL  CONDITIONS FOR WHICH PAIR
C              OF NUMBERS IS NOT RETURNED.
C            = 1, NOTHING, EXCEPT PERHAPS LEADING COMMAS OR
C              ELSE    COMMENT    INDICATED    BY   LEADING
C              EXCLAMATION POINT, WAS FOUND AT OR TO  RIGHT
C              OF  IBUFFR(LOWBFR).   CALLING PROGRAM SHOULD
C              READ NEW LINE OF TEXT INTO IBUFFR.
C            = 2, SEMICOLON WAS  FOUND  AS  FIRST  PRINTING
C              CHARACTER  AT OR TO RIGHT OF IBUFFR(LOWBFR).
C              IF RANGE OF INDEXES HAS NOT  BEEN  EXHAUSTED
C              WHEN  SEMICOLON  IS  FOUND,  THEN  REMAINING
C              MEMBERS OF RANGE  ARE  REPORTED  TO  CALLING
C              PROGRAM BEFORE SEMICOLON IS REPORTED.  IT IS
C              ASSUMED  THAT  CALLING  PROGRAM  WILL  TREAT
C              SEMICOLON AS MARKING END OF LOGICAL GROUP OF
C              PAIR SPECIFICATIONS IF KONECT IS NOT GREATER
C              THAN  1, OR END OF SINGLE PAIR SPECIFICATION
C              IF KONECT IS GREATER THAN 1.
C            = 3, AMPERSAND WAS FOUND WHILE  SEARCHING  FOR
C              NEXT  RANGE  OF INDEXES.  LOWBFR IS RETURNED
C              POINTING  BEYOND  END  OF  BUFFER.   CALLING
C              PROGRAM  SHOULD  READ  NEW LINE OF TEXT INTO
C              INPUT  BUFFER  BEFORE  AGAIN  CALLING   THIS
C              ROUTINE.  THIS VALUE OF KIND IS NOT RETURNED
C              IF AMPERSAND IS FOUND  WHILE  SEARCHING  FOR
C              RANGE OF ASSOCIATED VALUES.
C            = 4, RANGE OF INDEXES WAS NOT  EXHAUSTED,  BUT
C              AMPERSAND  WAS  FOUND  INSTEAD  OF  RANGE OF
C              ASSOCIATED VALUES.  CALLING  PROGRAM  SHOULD
C              READ  NEW  LINE  OF  TEXT INTO BUFFER BEFORE
C              AGAIN CALLING THIS ROUTINE.  SUBSEQUENT CALL
C              TO  THIS ROUTINE WILL CONTINUE EVALUATION OF
C              ASSOCIATED RANGES IN NEW CONTENTS OF BUFFER.
C              IF  SEMICOLON  (OR  COMMA  IF  KONECT IS NOT
C              GREATER THAN 1) IS FOUND  AT  START  OF  NEW
C              CONTENTS  OF  BUFFER,  THEN  REMAINING INDEX
C              VALUES WILL BE RETURNED TO  CALLING  PROGRAM
C              BUT  CALLING  PROGRAM  WILL BE INFORMED THAT
C              ASSOCIATED   VALUES   ARE    MISSING.     IF
C              SUBSEQUENT  CALL  TO THIS ROUTINE IS INSTEAD
C              TO BEGIN EVALUATION OF NEW  SET  OF  LEADING
C              INDEXES  AND ASSOCIATED VALUES, THEN CALLING
C              PROGRAM SHOULD SET KIND  TO  6  TO  SIMULATE
C              LACK OF AMPERSAND, CAUSING REMAINING INDEXES
C              TO  BE  GENERATED,  BUT  MARKED  AS   HAVING
C              MISSING  ASSOCIATED  VALUES.   IF  REMAINING
C              INDEXES ARE NOT WANTED, THEN KIND SHOULD  BE
C              SET TO ONE.
C            = 5,  RANGE  OF  INDEXES  WAS  EXHAUSTED,  BUT
C              AMPERSAND  WAS  FOUND  INSTEAD  OF  RANGE OF
C              ASSOCIATED VALUES.  CALLING  PROGRAM  SHOULD
C              READ  NEW  LINE  OF  TEXT INTO BUFFER BEFORE
C              AGAIN CALLING THIS ROUTINE.  SUBSEQUENT CALL
C              TO  THIS ROUTINE WILL CONTINUE EVALUATION OF
C              ASSOCIATED RANGES IN NEW CONTENTS OF BUFFER.
C              SINCE  RANGE  OF INDEXES HAS BEEN EXHAUSTED,
C              NO  ADDITIONAL  MISSING   VALUES   WILL   BE
C              REPORTED IF SEMICOLON (OR COMMA IF KONECT IS
C              NOT GREATER THAN 1) IS FOUND AT START OF NEW
C              CONTENTS  OF  BUFFER.  IF SUBSEQUENT CALL TO
C              THIS ROUTINE IS ALWAYS TO  BEGIN  EVALUATION
C              OF NEW SET OF LEADING INDEXES AND ASSOCIATED
C              VALUES, THEN CALLING PROGRAM SHOULD SET KIND
C              TO ONE.
C            = 6, END  OF  LINE  WAS  FOUND  BUT  RANGE  OF
C              INDEXES  WAS NOT EXHAUSTED.  IF KIND IS SENT
C              UNCHANGED  TO  SUBSEQUENT   CALL   OF   THIS
C              ROUTINE,  THEN  REMAINING  INDEXES  WILL  BE
C              RETURNED TO  CALLING  PROGRAM,  BUT  CALLING
C              PROGRAM  WILL  BE  INFORMED  THAT ASSOCIATED
C              VALUES ARE MISSING.  IF SUBSEQUENT  CALL  TO
C              THIS   ROUTINE   IS   INSTEAD   TO  CONTINUE
C              EVALUATION  OF  ASSOCIATED  RANGES  IN   NEW
C              CONTENTS  OF  BUFFER READ BY CALLING PROGRAM
C              BEFORE THIS ROUTINE IS  AGAIN  CALLED,  THEN
C              KIND   SHOULD   BE  SET  TO  4  TO  SIMULATE
C              APPEARANCE OF AMPERSAND AT END OF  PRECEDING
C              LINE.   IF REMAINING INDEXES ARE NOT WANTED,
C              THEN KIND SHOULD BE SET TO ONE.
C            = 7, BOTH INDEX AND ASSOCIATED VALUE ARE BEING
C              RETURNED TO CALLING PROGRAM.
C            = 8,  INDEX  IS  BEING  RETURNED  TO   CALLING
C              PROGRAM,  BUT  ASSOCIATED  VALUE IS MISSING.
C              NEWEND AND ENDNEW ARE RETURNED UNDEFINED.
C            = 9, ASSOCIATED VALUE  IS  BEING  RETURNED  TO
C              CALLING  PROGRAM,  BUT  RANGE OF INDEXES HAS
C              BEEN EXHAUSTED.  NEWBGN OR BGNNEW, WHICHEVER
C              IS  APPROPRIATE,  IS RETURNED UNCHANGED (BUT
C              CAN  BE  MODIFIED  AS  DESIRED  BY   CALLING
C              PROGRAM).
C            = 10, RANGES OF BOTH  INDEXES  AND  ASSOCIATED
C              VALUES  HAVE  BEEN EXHAUSTED.  THIS VALUE IS
C              NEVER RETURNED IF KONECT=-1 OR 1.
C
C              IF KONECT HAS EITHER OF VALUES 2 OR 4,  THEN
C              RANGES OF BOTH INDEXES AND ASSOCIATED VALUES
C              HAVE BEEN EXHAUSTED,  BUT  EXTRA  COMMA  WAS
C              FOUND  INDICATING  MISSING ASSOCIATED VALUE.
C              NEWBGN OR BGNNEW, WHICHEVER IS  APPROPRIATE,
C              IS  RETURNED  UNCHANGED (BUT CAN BE MODIFIED
C              AS DESIRED BY CALLING PROGRAM).
C
C              IF KONECT=0, THEN RANGES OF BOTH INDEXES AND
C              ASSOCIATED  VALUES  HAVE BEEN EXHAUSTED, BUT
C              FOLLOWING NUMBER WAS  FOUND  WHICH  WAS  NOT
C              PRECEDED BY COMMA.  KIND SHOULD BE SET TO -1
C              BY CALLING PROGRAM BEFORE  THIS  ROUTINE  IS
C              CALLED  NEXT  IF  LACK  OF  COMMA  INDICATES
C              SERIOUS ENOUGH ERROR THAT ALL NUMBERS SHOULD
C              BE  IGNORED  UNTIL  NEXT COMMA IS FOUND.  IF
C              KONECT=3, THEN RANGES OF  BOTH  INDEXES  AND
C              ASSOCIATED  VALUES  HAVE BEEN EXHAUSTED, BUT
C              FOLLOWING NUMBER WAS  FOUND  WHICH  WAS  NOT
C              PRECEDED  BY SEMICOLON, BUT WHICH MAY OR MAY
C              NOT  HAVE  BEEN  PRECEDED  BY  ONE  OR  MORE
C              COMMAS.  KIND SHOULD BE SET TO -1 BY CALLING
C              PROGRAM BEFORE THIS ROUTINE IS  CALLED  NEXT
C              IF   LACK  OF  SEMICOLON  INDICATES  SERIOUS
C              ENOUGH ERROR  THAT  ALL  NUMBERS  SHOULD  BE
C              IGNORED  UNTIL  NEXT SEMICOLON IS FOUND.  IF
C              KONECT IS 0 OR 3, THEN  LOWBFR  IS  RETURNED
C              POINTING   TO   FIRST  CHARACTER  OF  NUMBER
C              SPECIFICATION, AND NUMBER WILL BE  EVALUATED
C              AS  INDEX  IF  THIS  ROUTINE IS CALLED AGAIN
C              WITHOUT KIND HAVING BEEN CHANGED.
C            = 11, UNKNOWN CHARACTER WAS FOUND.   IF  RANGE
C              OF  INDEXES  HAS  NOT  BEEN  EXHAUSTED  WHEN
C              UNKNOWN CHARACTER IS FOUND,  THEN  REMAINING
C              MEMBERS  OF  RANGE  ARE  REPORTED TO CALLING
C              PROGRAM   BEFORE   UNKNOWN   CHARACTER    IS
C              REPORTED.   LOWBFR  IS  RETURNED POINTING TO
C              NEXT   CHARACTER   TO   RIGHT   OF   UNKNOWN
C              CHARACTER.    IF   THIS  ROUTINE  IS  CALLED
C              WITHOUT CHANGING VALUE OF KIND, THEN  NUMBER
C              TO   RIGHT  OF  UNKNOWN  CHARACTER  WILL  BE
C              INTERPRETED AS INDEX OF NEXT PAIR.
C            = 12,   ERROR   WAS   FOUND    WITHIN    RANGE
C              SPECIFICATION.    FINDING   OF   SUCH  ERROR
C              TERMINATES GENERATION OF RANGE  OF  INDEXES.
C              IWHERE  IS RETURNED POINTING TO CHARACTER AT
C              START  OF  SPECIFICATION  CONTAINING  ERROR.
C              LOWBFR  IS RETURNED POINTING TO CHARACTER TO
C              RIGHT OF SPECIFICATION CONTAINING ERROR.  IF
C              THIS  ROUTINE  IS  CALLED  WITHOUT  CHANGING
C              VALUE OF  KIND,  THEN  NUMBER  TO  RIGHT  OF
C              UNKNOWN  CHARACTER  WILL  BE  INTERPRETED AS
C              INDEX OF NEXT PAIR.
C            = 13, INDEX  AND  ASSOCIATED  VALUE  ZERO  ARE
C              BEING RETURNED TO CALLING PROGRAM.  ZERO WAS
C              INDICATED BY LACK  OF  NUMBER  TO  RIGHT  OF
C              ASTERISK.    MISSING   NUMBER  TO  RIGHT  OF
C              ASTERISK  IN  SPECIFICATION  OF   RANGE   OF
C              INDEXES IS NOT ALLOWED AND WOULD RETURN KIND
C              CONTAINING VALUE 12.
C            = 14, SAME AS KIND=13  EXCEPT  THAT  RANGE  OF
C              INDEXES  WAS  EXHAUSTED.   NEWBGN OR BGNNEW,
C              WHICHEVER  IS   APPROPRIATE,   IS   RETURNED
C              UNCHANGED (BUT CAN BE MODIFIED AS DESIRED BY
C              CALLING PROGRAM).
C
C     NEWBGN = RETURNED CONTAINING NEXT  VALUE  OF  INTEGER
C              INDEX  IF KIND IS RETURNED CONTAINING ONE OF
C              VALUES 7, 8 OR 13 AND IF KNDBGN IS LESS THAN
C              OR  EQUAL  TO  ZERO.   NEWBGN  SHOULD NOT BE
C              CHANGED BY CALLING PROGRAM  UNLESS  KIND  IS
C              RETURNED  CONTAINING  ONE OF VALUES 9, 10 OR
C              14 INDICATING THAT RANGE OF INDEXES HAS BEEN
C              EXHAUSTED.
C
C     NEWEND = RETURNED CONTAINING NEXT ASSOCIATED  INTEGER
C              VALUE IF KIND IS RETURNED WITH ONE OF VALUES
C              7, 9, 13 OR 14 AND IF KNDEND IS LESS THAN OR
C              EQUAL  TO  ZERO.   NEWEND  CAN  BE  RETURNED
C              CHANGED BY THIS ROUTINE EVEN  IF  ASSOCIATED
C              VALUE  IS  NOT  FOUND  BUT  THEN MUST NOT BE
C              CHANGED BY CALLING  PROGRAM.   IF  RANGE  OF
C              ASSOCIATED  VALUES HAS BEEN EXHAUSTED, OR IF
C              ASSOCIATED VALUE IS INDICATED BY EXTRA COMMA
C              TO  BE MISSING, THEN NEWEND DOES NOT CONTAIN
C              ASSOCIATED   INTEGER   VALUE   BUT   INSTEAD
C              INDICATES TO SUBSEQUENT CALL TO THIS ROUTINE
C              REASON WHY VALUE COULD NOT BE RETURNED.
C
C     BGNNEW = RETURNED CONTAINING NEXT VALUE OF REAL INDEX
C              IF KIND IS RETURNED CONTAINING ONE OF VALUES
C              7, 8 OR 13 AND IF  KNDBGN  IS  GREATER  THAN
C              ZERO.   BGNNEW  SHOULD  NOT  BE  CHANGED  BY
C              CALLING  PROGRAM  UNLESS  KIND  IS  RETURNED
C              CONTAINING   ONE  OF  VALUES  9,  10  OR  14
C              INDICATING THAT RANGE OF  INDEXES  HAS  BEEN
C              EXHAUSTED.
C
C     ENDNEW = RETURNED  CONTAINING  NEXT  ASSOCIATED  REAL
C              VALUE IF KIND IS RETURNED WITH ONE OF VALUES
C              7, 9, 13 OR 14 AND IF KNDEND IS GREATER THAN
C              ZERO.   ENDNEW  SHOULD  NOT  BE  CHANGED  BY
C              CALLING PROGRAM.
C
C     FOLLOWING ARGUMENT IS USED FOR OUTPUT ONLY.
C
C     IWHERE = RETURNED POINTING TO LEFT CHARACTER OF RANGE
C              NOTATION  WHICH  WAS  FOUND TO CONTAIN ERROR
C              SUCH  AS  TOO  MANY  ASTERISKS,   TOO   MANY
C              SLASHES,  TOO  MANY  COLONS,  OR  ABSENCE OF
C              NUMBER TO RIGHT OF ASTERISK IN SPECIFICATION
C              OF RANGE OF LEADING INDEXES.
C
C     REMAINING  DAPAIR  ARGUMENTS  ARE  USED  ONLY  DURING
C     GENERATION OF VALUES WITHIN RANGES AND SHOULD BE SENT
C     TO SUBSEQUENT DAPAIR CALL UNCHANGED.  THESE ARGUMENTS
C     SHOULD  BE  STATED  BY  NAME  IN  CALL STATEMENTS AND
C     SHOULD BE IGNORED BY CALLING PROGRAM  EXCEPT  INSOFAR
C     AS   IS   NECESSARY   TO  TRANSMIT  THEIR  VALUES  TO
C     SUBSEQUENT CALL TO THIS ROUTINE.
C
      DIMENSION IBUFFR(MAXBFR)
      DATA KOMENT,IEND,IAND,KOMMA,IBLANK,ITAB/
     11H!,1H;,1H&,1H,,1H ,1H	/
C
C     TEST IF ARE CONTINUING PREVIOUSLY EVALUATED SERIES
      MISSIN=0
      IKNCT=KONECT
      IF(IKNCT.GT.1)IKNCT=IKNCT-3
      MANY=0
      IPLACE=0
      IF(KIND.LE.0)GO TO 31
      IF(KIND.GT.14)GO TO 31
      GO TO(31,31,31,13,11,43, 1, 1, 9, 5,31,31, 1, 6),KIND
C
C     GET NEXT INDEX
    1 ITYPE=5
      LIMIT=LOWBFR-1
      IF(KNDBGN.LE.0)INIBGN=NEWBGN
      IF(KNDBGN.GT.0)BGNINI=BGNNEW
      GO TO 32
    2 IF(ITYPE.NE.5)GO TO 4
      IF(KIND.EQ.7)GO TO 9
      IF(KIND.EQ.8)GO TO 3
      KIND=7
      GO TO 7
    3 IF(NEWEND.LE.0)GO TO 50
      GO TO 14
C
C     SERIES OF INDEXES EXHAUSTED
    4 IF(KNDBGN.LE.0)NEWBGN=INIBGN
      IF(KNDBGN.GT.0)BGNNEW=BGNINI
      IF(KIND.EQ.7)GO TO 8
      IF(KIND.NE.8)GO TO 6
      IF(NEWEND.LE.0)GO TO 31
      IF(IKNCT.NE.0)GO TO 12
      KIND=9
      GO TO 31
C
C     GET NEXT ASSOCIATED VALUE
    5 IF(IKNCT.EQ.0)GO TO 31
    6 KIND=9
    7 ITYPE=6
      GO TO 10
    8 KIND=9
    9 ITYPE=5
   10 LIMIT=LOWBFR-1
      GO TO 18
C
C     LOOK FOR NEXT ASSOCIATED RANGE OF VALUES
   11 MISSIN=NEWEND
   12 KIND=9
      GO TO 17
   13 MISSIN=NEWEND
   14 KIND=7
      GO TO 17
   15 IF(KONECT.LE.1)GO TO 28
      IF(MISSIN.GT.0)GO TO 42
      MISSIN=1
   16 LOWBFR=LOWBFR+1
   17 IF(LOWBFR.GT.MAXBFR)GO TO 25
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 16
      IF(LETTER.EQ.ITAB)GO TO 16
      IF(LETTER.EQ.KOMMA)GO TO 15
      IF(LETTER.EQ.KOMENT)GO TO 24
      IF(LETTER.EQ.IEND)GO TO 23
      IF(LETTER.EQ.IAND)GO TO 21
C
C     EVALUATE NEXT ASSOCIATED RANGE OF VALUES
      ITYPE=0
      LIMIT=MAXBFR
      IWHERE=LOWBFR
   18 CALL DANEXT(KNDEND,SLACK ,IBUFFR,LIMIT,LOWBFR,
     1MANY,ITYPE,NEWEND,INCEND,LMTEND,ENDNEW,ENDINC,
     2ENDLMT)
      IF(ITYPE.EQ.9)GO TO 20
      IF(ITYPE.GT.6)GO TO 47
      IF(ITYPE.EQ.5)GO TO 50
      IF(ITYPE.NE.6)GO TO 19
      IF(KIND.EQ.7)GO TO 48
      GO TO 49
   19 IF(KIND.EQ.7)GO TO 17
      IF(IKNCT.NE.0)GO TO 17
      GO TO 31
   20 IF(KIND.EQ.9)GO TO 46
      LOWBFR=LOWBFR-1
      GO TO 43
C
C     AMPERSAND FOUND INSTEAD OF ADDITIONAL RANGE
   21 IF(KIND.EQ.7)GO TO 22
      IF(IKNCT.GT.0)GO TO 36
      GO TO 38
   22 IF(IKNCT.GT.0)GO TO 43
      GO TO 37
C
C     SEMICOLON FOUND INSTEAD OF ASSOCIATED VALUE
   23 IF(KIND.EQ.7)GO TO 43
      IF(MISSIN.GT.0)GO TO 45
      GO TO 35
C
C     NO ADDITIONAL ASSOCIATED RANGE FOUND
   24 LOWBFR=MAXBFR+1
   25 IF(KIND.EQ.7)GO TO 26
      IF(MISSIN.GT.0)GO TO 45
      GO TO 34
   26 IF(IKNCT.GT.0)GO TO 43
      GO TO 40
C
C     COMMA FOUND INSTEAD OF NEXT ASSOCIATED RANGE
   27 IF(KONECT.LE.1)GO TO 29
      GO TO 30
   28 IF(KIND.EQ.7)GO TO 43
   29 KIND=7
C
C     FIND NEXT PAIR OF SERIES
   30 LOWBFR=LOWBFR+1
   31 IF(LOWBFR.GT.MAXBFR)GO TO 34
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 30
      IF(LETTER.EQ.ITAB)GO TO 30
      IF(LETTER.EQ.KOMMA)GO TO 27
      IF(LETTER.EQ.KOMENT)GO TO 33
      IF(LETTER.EQ.IEND)GO TO 35
      IF(LETTER.EQ.IAND)GO TO 36
C
C     OBTAIN FIRST LEADING RANGE
      ITYPE=0
      LIMIT=MAXBFR
      IPLACE=1
      IWHERE=LOWBFR
   32 CALL DANEXT(KNDBGN,SLACK,IBUFFR,LIMIT,LOWBFR,
     1MANY,ITYPE,NEWBGN,INCBGN,LMTBGN,BGNNEW,BGNINC,
     2BGNLMT)
      IF(IPLACE.EQ.0)GO TO 2
      IF(ITYPE.EQ.9)GO TO 46
      IF(KIND.LT.0)GO TO 31
      IF(ITYPE.NE.5)GO TO 47
      IF(KIND.NE.9)GO TO 14
      LOWBFR=IWHERE
      GO TO 45
C
C     RETURN TO CALLING PROGRAM
   33 LOWBFR=MAXBFR+1
   34 KIND=1
      GO TO 50
   35 KIND=2
      LOWBFR=LOWBFR+1
      GO TO 50
   36 KIND=3
      LOWBFR=MAXBFR+1
      GO TO 50
   37 KIND=4
      GO TO 39
   38 KIND=5
   39 LOWBFR=MAXBFR+1
      GO TO 41
   40 KIND=6
   41 NEWEND=MISSIN
      GO TO 50
   42 IF(KIND.EQ.9)GO TO 45
      NEWEND=1
      GO TO 44
   43 NEWEND=0
   44 KIND=8
      GO TO 50
   45 KIND=10
      GO TO 50
   46 KIND=11
      GO TO 50
   47 KIND=12
      GO TO 50
   48 KIND=13
      GO TO 50
   49 KIND=14
   50 RETURN
C863065281593!;&
      END
      SUBROUTINE DAIPAR(       KNDBGN,KNDEND,KONECT,IBUFFR,
     1    MAXBFR,LOWBFR,KIND  ,NEWBGN,NEWEND,BGNNEW,ENDNEW)
C     RENBR(/INTERPRET PAIR OF ASSOCIATED VALUES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY, AND  ARE
C     RETURNED UNCHANGED.
C
C     KNDBGN = SPECIFIES  WHETHER  INDEX  IS  RETURNED   AS
C              INTEGER  ARGUMENT NEWBGN OR AS REAL ARGUMENT
C              BGNNEW.  NUMBER CAN BE  TYPED  WITH  DECIMAL
C              POINT AND/OR EXPONENT REGARDLESS OF VALUE OF
C              KNDBGN.
C            = -1, INDEX IS CALCULATED AS OCTAL INTEGER AND
C              IS  RETURNED  AS  ARGUMENT NEWBGN.  HOWEVER,
C              NUMBER FOLLOWING LETTER  E  OF  EXPONENT  IS
C              EVALUATED IN DECIMAL.
C            = 0, INDEX IS CALCULATED  AS  DECIMAL  INTEGER
C              AND IS RETURNED AS ARGUMENT NEWBGN.
C            = 1 OR GREATER,  INDEX  IS  RETURNED  AS  REAL
C              ARGUMENT  BGNNEW.   IF POSSIBLE, REAL NUMBER
C              WILL BE  ACCUMULATED  AS  INTEGER,  THEN  BE
C              CONVERTED  TO REAL AND SHIFTED AS NECESSARY.
C              KNDBGN  IS  MAXIMUM  NUMBER  OF  DIGITS   IN
C              INTEGER.
C     KNDEND = SPECIFIES  WHETHER   ASSOCIATED   VALUE   IS
C              RETURNED  AS  INTEGER  ARGUMENT NEWEND OR AS
C              REAL ARGUMENT ENDNEW.  NUMBER CAN  BE  TYPED
C              WITH    DECIMAL    POINT   AND/OR   EXPONENT
C              REGARDLESS OF VALUE OF KNDEND.
C            = -1, ASSOCIATED VALUE IS CALCULATED AS  OCTAL
C              INTEGER  AND IS RETURNED AS ARGUMENT NEWEND.
C              HOWEVER,  NUMBER  FOLLOWING  LETTER   E   OF
C              EXPONENT IS EVALUATED IN DECIMAL.
C            = 0, ASSOCIATED VALUE IS CALCULATED AS DECIMAL
C              INTEGER AND IS RETURNED AS ARGUMENT NEWEND.
C            = 1 OR GREATER, ASSOCIATED VALUE  IS  RETURNED
C              AS  REAL ARGUMENT ENDNEW.  IF POSSIBLE, REAL
C              NUMBER WILL BE ACCUMULATED AS INTEGER,  THEN
C              BE   CONVERTED   TO   REAL  AND  SHIFTED  AS
C              NECESSARY.   KNDEND  IS  MAXIMUM  NUMBER  OF
C              DIGITS IN INTEGER.
C
C
C
C     KONECT = SPECIFIES  MANNER   OF   INTERPRETATION   OF
C              FOLLOWING  NUMBER  WHEN  PREVIOUS  CALL  HAS
C              ALREADY RETURNED  PAIR  OF  VALUES.   KONECT
C              ALSO   SPECIFIES   WHETHER   COMMAS  ARE  TO
C              INDICATE THAT FOLLOWING NUMBER, IF  ANY,  IS
C              TO  BE  INDEX OF SUBSEQUENT PAIR, OR WHETHER
C              COMMAS ARE ALLOWED BETWEEN SUBSEQUENT VALUES
C              ASSOCIATED  WITH  SAME INDEX.  REGARDLESS OF
C              VALUE OF KONECT,  ALL  COMMAS  APPEARING  TO
C              LEFT OF INDEX ARE IGNORED.
C            = -1, 0 OR 1,  COMMAS  CANNOT  APPEAR  BETWEEN
C              SPECIFICATION OF INDEX AND OF ITS ASSOCIATED
C              VALUE    AND    CANNOT    APPEAR     BETWEEN
C              REPRESENTATIONS   OF  SUBSEQUENT  ASSOCIATED
C              VALUES.  IF COMMA IS FOUND,  THEN  FOLLOWING
C              NUMBER,  IF  ANY,  IS  TAKEN  TO BE INDEX OF
C              SUBSEQUENT PAIR OF NUMBERS.
C            = -1, WHEN PREVIOUS CALL HAS ALREADY  RETURNED
C              PAIR  OF VALUES, FOLLOWING REPRESENTATION OF
C              NUMBER ON SAME  LINE  IS  TAKEN  TO  SPECIFY
C              ADDITIONAL ASSOCIATED VALUE.
C
C              IF END OF LINE IS  FOUND  INSTEAD  OF  FIRST
C              ASSOCIATED  VALUE,  THEN CALLING PROGRAM CAN
C              REQUEST  (BY  SETTING  KIND=4  TO   SIMULATE
C              FINDING  OF  AMPERSAND)  THAT  EVALUATION OF
C              ASSOCIATED VALUES IS TO BE CONTINUED BY NEXT
C              CALL  TO  THIS ROUTINE IN NEW TEXT READ INTO
C              INPUT BUFFER.   IF  END  OF  LINE  IS  FOUND
C              BEFORE  FIRST  ASSOCIATED VALUE, BUT CALLING
C              PROGRAM LEAVES KIND UNCHANGED  BEFORE  AGAIN
C              CALLING  THIS ROUTINE, THEN INDEX VALUE WILL
C              BE  RETURNED   WITHOUT   ASSOCIATED   VALUE,
C              FOLLOWING WHICH FIRST NUMBER IN NEW CONTENTS
C              OF TEXT BUFFER WILL BE INTERPRETED AS  INDEX
C              OF NEW PAIR.
C
C              IF AMPERSAND IS  FOUND  TO  RIGHT  OF  INDEX
C              SPECIFICATION,    REGARDLESS    OF   WHETHER
C              ASSOCIATED VALUE HAS BEEN FOUND BY  PREVIOUS
C              CALL,  THEN  EVALUATION OF ASSOCIATED VALUES
C              WILL BE  CONTINUED  BY  NEXT  CALL  TO  THIS
C              ROUTINE  IN NEW TEXT READ INTO INPUT BUFFER.
C              IF  AMPERSAND  IS  FOUND  PRIOR   TO   FIRST
C              ASSOCIATED  VALUE,  BUT  NEXT LINE READ INTO
C              INPUT BUFFER IS TO START NEW PAIR, THEN KIND
C              SHOULD  BE  SET  TO  6  BY  CALLING  PROGRAM
C              CAUSING INDEX  TO  BE  GENERATED  FIRST  BUT
C              MARKED  AS  HAVING MISSING ASSOCIATED VALUE.
C              IF AMPERSAND IS FOUND AFTER ASSOCIATED VALUE
C              HAS  BEEN  FOUND  BY PREVIOUS CALL, BUT NEXT
C              LINE READ INTO INPUT BUFFER IS TO START  NEW
C              PAIR, THEN KIND SHOULD BE SET TO ONE.
C
C            = 0, WHEN PREVIOUS CALL HAS  ALREADY  RETURNED
C              PAIR  OF VALUES, FOLLOWING REPRESENTATION OF
C              NUMBER ON SAME LINE CAUSES THIS  ROUTINE  TO
C              REPORT MISSING COMMA, AND SUBSEQUENT CALL TO
C              THIS ROUTINE THEN BEGINS EVALUATION OF  THIS
C              FOLLOWING  NUMBER  AS  INDEX  OF  SUBSEQUENT
C              PAIR.
C
C              IF END OF LINE IS  FOUND  INSTEAD  OF  FIRST
C              ASSOCIATED  VALUE,  THEN CALLING PROGRAM CAN
C              REQUEST  (BY  SETTING  KIND=4  TO   SIMULATE
C              FINDING  OF  AMPERSAND)  THAT  EVALUATION OF
C              ASSOCIATED VALUE IS TO BE CONTINUED BY  NEXT
C              CALL  TO  THIS ROUTINE IN NEW TEXT READ INTO
C              INPUT BUFFER.   IF  END  OF  LINE  IS  FOUND
C              BEFORE  FIRST  ASSOCIATED VALUE, BUT CALLING
C              PROGRAM LEAVES KIND UNCHANGED  BEFORE  AGAIN
C              CALLING  THIS ROUTINE, THEN INDEX VALUE WILL
C              BE  RETURNED   WITHOUT   ASSOCIATED   VALUE,
C              FOLLOWING WHICH FIRST NUMBER IN NEW CONTENTS
C              OF TEXT BUFFER WILL BE INTERPRETED AS  INDEX
C              OF SUBSEQUENT PAIR.
C
C              IF   AMPERSAND   IS   FOUND   BEFORE   FIRST
C              ASSOCIATED   VALUE,   THEN   EVALUATION   OF
C              ASSOCIATED VALUE WILL BE CONTINUED  BY  NEXT
C              CALL  TO  THIS ROUTINE IN NEW TEXT READ INTO
C              INPUT BUFFER  UNLESS  CALLING  PROGRAM  SETS
C              KIND  TO  6 PRIOR TO SUBSEQUENT CALL TO THIS
C              ROUTINE, CAUSING INDEX TO BE  GENERATED  BUT
C              MARKED  AS  HAVING MISSING ASSOCIATED VALUE.
C              IF AMPERSAND IS FOUND AFTER ASSOCIATED VALUE
C              HAS  BEEN FOUND, THEN FIRST NUMBER EVALUATED
C              BY SUBSEQUENT CALL TO THIS  ROUTINE  IN  NEW
C              TEXT READ INTO INPUT BUFFER IS ASSUMED TO BE
C              INDEX OF NEW PAIR OF VALUES.
C
C              = 1, WHEN PREVIOUS CALL HAS ALREADY RETURNED
C              PAIR  OF VALUES, FOLLOWING REPRESENTATION OF
C              NUMBER ON SAME  LINE  IS  TAKEN  TO  SPECIFY
C              ADDITIONAL ASSOCIATED VALUE.
C
C              IF EITHER AMPERSAND OR END OF LINE IS  FOUND
C              BEFORE  FIRST  ASSOCIATED  VALUE, THEN INDEX
C              VALUE WILL BE  RETURNED  WITHOUT  ASSOCIATED
C              VALUE,  FOLLOWING WHICH CALLING PROGRAM WILL
C              BE INFORMED THAT END OF  LINE  OR  AMPERSAND
C              HAS BEEN REACHED.
C
C            = 2, 3 OR 4, SAME AS WHEN KONECT=-1,  0  OR  1
C              RESPECTIVELY,  EXCEPT THAT COMMAS CAN APPEAR
C              (BUT    ARE    NOT     REQUIRED)     BETWEEN
C              REPRESENTATIONS    OF    INDEX   AND   FIRST
C              ASSOCIATED VALUE AND BETWEEN REPRESENTATIONS
C              OF   SUBSEQUENT  ASSOCIATED  VALUES.   EXTRA
C              COMMA INDICATES  MISSING  ASSOCIATED  VALUE.
C              IF  KONECT=3,  AND IF PREVIOUS CALL RETURNED
C              PAIR OF VALUES, THEN KIND WILL  BE  RETURNED
C              SET  TO  10 TO INDICATE MISSING SEMICOLON IF
C              FOLLOWING NUMBER IS  FOUND  WHETHER  OR  NOT
C              THIS  FOLLOWING NUMBER IS PRECEDED BY COMMA,
C              AND SUBSEQUENT CALL  TO  THIS  ROUTINE  WILL
C              BEGIN  EVALUATION  OF  FOLLOWING  NUMBER  AS
C              INDEX OF SUBSEQUENT  PAIR.   UNLIKE  COMMAS,
C              SEMICOLONS  ARE  ALWAYS  REPORTED TO CALLING
C              PROGRAM REGARDLESS OF VALUE OF KONECT.
C
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED  BY  USER,  READ  BY  MULTIPLE  OF  A1
C              FORMAT, WHICH IS TO BE SEARCHED  FOR  NUMBER
C              SPECIFICATIONS.   IBUFFR  THEN  CONTAINS ONE
C              CHARACTER PER COMPUTER STORAGE LOCATION.
C
C     MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY  LOCATIONS
C              TO BE SEARCHED.
C
C     FOLLOWING ARGUMENTS ARE USED BOTH FOR INPUT  TO  THIS
C     ROUTINE, AND FOR OUTPUT TO CALLING PROGRAM.
C
C     LOWBFR = INPUT  CONTAINING  SUBSCRIPT  WITHIN  IBUFFR
C              ARRAY  OF  FIRST  (LEFTMOST) CHARACTER WHICH
C              CAN BE  SCANNED  FOR  NUMBER  SPECIFICATION.
C              LOWBFR   IS   RETURNED   POINTING   TO  NEXT
C              CHARACTER  WHICH  WOULD  BE  INTERPRETED  BY
C              SUBSEQUENT  CALL  TO  THIS  ROUTINE  IF THIS
C              SUBSEQUENT CALL NEEDS  TO  EVALUATE  FURTHER
C              NUMBER  SPECIFICATIONS.   IF  THERE  ARE  NO
C              PRINTING  CHARACTERS  AT  OR  TO  RIGHT   OF
C              IBUFFR(LOWBFR),    BUT   INTERPRETATION   OF
C              ADDITIONAL  CHARACTERS  IS  ATTEMPTED,  THEN
C              LOWBFR WILL BE RETURNED CONTAINING MAXBFR+1.
C              LOWBFR MUST BE RESET BY CALLING  PROGRAM  TO
C              POINT  TO  FIRST  CHARACTER  IN IBUFFR ARRAY
C              EACH TIME NEW LINE OF TEXT IS READ.
C
C     KIND   = INPUT CONTAINING -1, ERROR WAS  DETECTED  BY
C              CALLING   PROGRAM   (RATHER   THAN  BY  THIS
C              ROUTINE) IN  RESULTS  RETURNED  BY  PREVIOUS
C              CALL  TO  THIS  ROUTINE  AND  ANY ADDITIONAL
C              NUMBERS THROUGH  NEXT  APPEARANCE  OF  COMMA
C              (UNLESS   KONECT   IS  GREATER  THAN  1)  OR
C              SEMICOLON OR AMPERSAND OR UNKNOWN  CHARACTER
C              OR  END  OF  LINE  ARE  TO BE IGNORED.  NEXT
C              NUMBER  TO  RIGHT  OF  COMMA  OR   ON   LINE
C              FOLLOWING  AMPERSAND OR END OF LINE IS TO BE
C              INTERPRETED AS INDEX OF NEXT PAIR.   UNKNOWN
C              CHARACTER   OR   SEMICOLON  IS  REPORTED  TO
C              CALLING PROGRAM IF IT IS FOUND INSTEAD.
C            = INPUT CONTAINING 0, THIS ROUTINE HAS NOT YET
C              BEEN  CALLED  DURING  EXECUTION  OF  CURRENT
C              LOGICAL SECTION OF  CALLING  PROGRAM.   THIS
C              ROUTINE  IS  TO BEGIN EVALUATION OF CONTENTS
C              OF INPUT TEXT BUFFER, NOT CONTINUE SEARCHING
C              FOR  VALUES  ASSOCIATED  WITH INDEX FOUND BY
C              PREVIOUS  CALL  TO  THIS  ROUTINE.    LOWBFR
C              SHOULD  POINT  TO  FIRST CHARACTER IN IBUFFR
C              ARRAY TO BE INTERPRETED.
C            = INPUT  GREATER  THAN  ZERO,  VALUE  OF  KIND
C              INDICATES  CONDITION  RETURNED  BY  PREVIOUS
C              CALL TO THIS ROUTINE AND IN MOST  CASES  HAS
C              NOT  BEEN MODIFIED BY CALLING PROGRAM.  KIND
C              BEING RETURNED WITH ONE OF VALUES 7, 8, 9 OR
C              10 (IF KONECT IS 2 OR 4) INDICATES THAT PAIR
C              OF VALUES IS BEING RETURNED, ALTHOUGH EITHER
C              OR  BOTH  MEMBERS  OF PAIR COULD BE MISSING.
C              OTHER  VALUES  OF  KIND   INDICATE   SPECIAL
C              CONDITIONS  FOR WHICH PAIR OF NUMBERS IS NOT
C              RETURNED.
C            = 1, NOTHING, EXCEPT PERHAPS LEADING COMMAS OR
C              ELSE    COMMENT    INDICATED    BY   LEADING
C              EXCLAMATION POINT, WAS FOUND AT OR TO  RIGHT
C              OF  IBUFFR(LOWBFR).   CALLING PROGRAM SHOULD
C              READ NEW LINE OF TEXT INTO IBUFFR.
C            = 2, SEMICOLON WAS  FOUND  AS  FIRST  PRINTING
C              CHARACTER  AT OR TO RIGHT OF IBUFFR(LOWBFR).
C              IF INDEX BUT NOT ASSOCIATED VALUE  HAS  BEEN
C              FOUND  WHEN  SEMICOLON  IS ENCOUNTERED, THEN
C              INDEX IS REPORTED TO CALLING PROGRAM  BEFORE
C              SEMICOLON  IS  REPORTED.  IT IS ASSUMED THAT
C              CALLING  PROGRAM  WILL  TREAT  SEMICOLON  AS
C              MARKING   END   OF  LOGICAL  GROUP  OF  PAIR
C              SPECIFICATIONS IF KONECT IS NOT GREATER THAN
C              1,  OR  END  OF SINGLE PAIR SPECIFICATION IF
C              KONECT IS GREATER THAN 1.
C            = 3, AMPERSAND WAS FOUND WHILE  SEARCHING  FOR
C              NEXT  INDEX.   LOWBFR  IS  RETURNED POINTING
C              BEYOND  END  OF  BUFFER.   CALLING   PROGRAM
C              SHOULD  READ  NEW  LINE  OF  TEXT INTO INPUT
C              BUFFER BEFORE AGAIN  CALLING  THIS  ROUTINE.
C              THIS  VALUE  OF  KIND  IS  NOT  RETURNED  IF
C              AMPERSAND  IS  FOUND  WHILE  SEARCHING   FOR
C              ASSOCIATED VALUES.
C            = 4, AMPERSAND WAS FOUND AFTER  INDEX  INSTEAD
C              OF  FIRST  ASSOCIAED VALUE.  CALLING PROGRAM
C              SHOULD READ NEW LINE  OF  TEXT  INTO  BUFFER
C              BEFORE    AGAIN    CALLING   THIS   ROUTINE.
C              SUBSEQUENT  CALL  TO   THIS   ROUTINE   WILL
C              CONTINUE  EVALUATION OF ASSOCIATED VALUES IN
C              NEW CONTENTS OF BUFFER.   IF  SEMICOLON  (OR
C              COMMA  IF  KONECT  IS NOT GREATER THAN 1) IS
C              FOUND AT START OF NEW  CONTENTS  OF  BUFFER,
C              THEN INDEX VALUE WILL BE RETURNED TO CALLING
C              PROGRAM BUT CALLING PROGRAM WILL BE INFORMED
C              THAT   ASSOCIATED   VALUE  IS  MISSING.   IF
C              SUBSEQUENT CALL TO THIS ROUTINE  IS  INSTEAD
C              TO  BEGIN  EVALUATION  OF NEW SET OF LEADING
C              INDEX AND ASSOCIATED  VALUES,  THEN  CALLING
C              PROGRAM  SHOULD  SET  KIND  TO 6 TO SIMULATE
C              LACK  OF  AMPERSAND,  CAUSING  INDEX  TO  BE
C              GENERATED,  BUT  MARKED  AS  HAVING  MISSING
C              ASSOCIATED VALUE.  IF INDEX IS  NOT  WANTED,
C              THEN KIND SHOULD BE SET TO ONE.
C            = 5, PREVIOUS CALL HAS ALREADY  RETURNED  PAIR
C              OF  VALUES,  BUT AMPERSAND WAS FOUND INSTEAD
C              OF  ANOTHER   ASSOCIATED   VALUE.    CALLING
C              PROGRAM  SHOULD  READ  NEW LINE OF TEXT INTO
C              BUFFER BEFORE AGAIN  CALLING  THIS  ROUTINE.
C              SUBSEQUENT   CALL   TO   THIS  ROUTINE  WILL
C              CONTINUE EVALUATION OF ASSOCIATED VALUES  IN
C              NEW  CONTENTS  OF  BUFFER.   SINCE INDEX HAS
C              ALREADY BEEN RETURNED, NO ADDITIONAL MISSING
C              VALUE  WILL  BE  REPORTED  IF  SEMICOLON (OR
C              COMMA IF KONECT IS NOT GREATER  THAN  1)  IS
C              FOUND  AT  START  OF NEW CONTENTS OF BUFFER.
C              IF SUBSEQUENT CALL TO THIS ROUTINE IS ALWAYS
C              TO  BEGIN  EVALUATION OF NEW PAIR OF VALUES,
C              THEN CALLING PROGRAM SHOULD SET KIND TO ONE.
C            = 6, END OF LINE WAS FOUND  INSTEAD  OF  FIRST
C              ASSOCIATED VALUE.  IF KIND IS SENT UNCHANGED
C              TO SUBSEQUENT CALL  OF  THIS  ROUTINE,  THEN
C              INDEX  WILL  BE RETURNED TO CALLING PROGRAM,
C              BUT CALLING PROGRAM WILL  BE  INFORMED  THAT
C              ASSOCIATED  VALUE IS MISSING.  IF SUBSEQUENT
C              CALL TO THIS ROUTINE IS INSTEAD TO  CONTINUE
C              EVALUATION   OF  ASSOCIATED  VALUES  IN  NEW
C              CONTENTS OF BUFFER READ BY  CALLING  PROGRAM
C              BEFORE  THIS  ROUTINE  IS AGAIN CALLED, THEN
C              KIND  SHOULD  BE  SET  TO  4   TO   SIMULATE
C              APPEARANCE  OF AMPERSAND AT END OF PRECEDING
C              LINE.  IF INDEX IS  NOT  WANTED,  THEN  KIND
C              SHOULD BE SET TO ONE.
C            = 7, BOTH INDEX AND ASSOCIATED VALUE ARE BEING
C              RETURNED TO CALLING PROGRAM.
C            = 8,  INDEX  IS  BEING  RETURNED  TO   CALLING
C              PROGRAM,  BUT  ASSOCIATED  VALUE IS MISSING.
C              NEWEND AND ENDNEW ARE RETURNED UNDEFINED.
C            = 9, ASSOCIATED VALUE  IS  BEING  RETURNED  TO
C              CALLING  PROGRAM, BUT INDEX HAS ALREADY BEEN
C              RETURNED  BY  PREVIOUS  CALL.    NEWBGN   OR
C              BGNNEW,   WHICHEVER   IS   APPROPRIATE,   IS
C              RETURNED UNCHANGED (BUT CAN BE  MODIFIED  AS
C              DESIRED BY CALLING PROGRAM).
C            = 10, NEVER RETURNED IF KONECT=-1 OR 1.
C
C              IF KONECT HAS EITHER OF VALUES 2 OR 4,  PAIR
C              OF  VALUES  HAS  ALREADY  BEEN  RETURNED  BY
C              PREVIOUS CALL, BUT  EXTRA  COMMA  WAS  FOUND
C              INDICATING MISSING ASSOCIATED VALUE.  NEWBGN
C              OR  BGNNEW,  WHICHEVER  IS  APPROPRIATE,  IS
C              RETURNED  UNCHANGED  (BUT CAN BE MODIFIED AS
C              DESIRED BY CALLING PROGRAM).
C
C              IF KONECT=0, THEN PAIR OF VALUES HAS ALREADY
C              BEEN   RETURNED   BY   PREVIOUS   CALL,  BUT
C              FOLLOWING NUMBER WAS  FOUND  WHICH  WAS  NOT
C              PRECEDED BY COMMA.  KIND SHOULD BE SET TO -1
C              BY CALLING PROGRAM BEFORE  THIS  ROUTINE  IS
C              CALLED  NEXT  IF  LACK  OF  COMMA  INDICATES
C              SERIOUS ENOUGH ERROR THAT ALL NUMBERS SHOULD
C              BE  IGNORED  UNTIL  NEXT COMMA IS FOUND.  IF
C              KONECT=3, THEN PAIR OF  VALUES  HAS  ALREADY
C              BEEN   RETURNED   BY   PREVIOUS   CALL,  BUT
C              FOLLOWING NUMBER WAS  FOUND  WHICH  WAS  NOT
C              PRECEDED  BY SEMICOLON, BUT WHICH MAY OR MAY
C              NOT  HAVE  BEEN  PRECEDED  BY  ONE  OR  MORE
C              COMMAS.  KIND SHOULD BE SET TO -1 BY CALLING
C              PROGRAM BEFORE THIS ROUTINE IS  CALLED  NEXT
C              IF   LACK  OF  SEMICOLON  INDICATES  SERIOUS
C              ENOUGH ERROR  THAT  ALL  NUMBERS  SHOULD  BE
C              IGNORED  UNTIL  NEXT SEMICOLON IS FOUND.  IF
C              KONECT IS 0 OR 3, THEN  LOWBFR  IS  RETURNED
C              POINTING   TO   FIRST  CHARACTER  OF  NUMBER
C              SPECIFICATION, AND NUMBER WILL BE  EVALUATED
C              AS  INDEX  IF  THIS  ROUTINE IS CALLED AGAIN
C              WITHOUT KIND HAVING BEEN CHANGED.
C            = 11, UNKNOWN CHARACTER WAS  FOUND.   IF  THIS
C              APPEARS  BEFORE FIRST ASSOCIATED VALUE, THEN
C              INDEX IS REPORTED TO CALLING PROGRAM  BEFORE
C              UNKNOWN  CHARACTER  IS  REPORTED.  LOWBFR IS
C              RETURNED POINTING TO NEXT CHARACTER TO RIGHT
C              OF  UNKNOWN  CHARACTER.   IF THIS ROUTINE IS
C              CALLED WITHOUT CHANGING VALUE OF KIND,  THEN
C              NUMBER TO RIGHT OF UNKNOWN CHARACTER WILL BE
C              INTERPRETED AS INDEX OF NEXT PAIR.
C
C     NEWBGN = RETURNED CONTAINING NEXT  VALUE  OF  INTEGER
C              INDEX  IF KIND IS RETURNED CONTAINING EITHER
C              7 OR 8 AND IF KNDBGN IS LESS THAN  OR  EQUAL
C              TO  ZERO.   NEWBGN IS NOT CHANGED IF KIND IS
C              RETURNED CONTAINING EITHER 9 OR 10.   NEWBGN
C              CAN  BE  CHANGED  AS REQUIRED BY THE CALLING
C              PROGRAM.
C
C     NEWEND = RETURNED CONTAINING NEXT ASSOCIATED  INTEGER
C              VALUE  IF KIND IS RETURNED CONTAINING EITHER
C              7 OR 9 AND IF KNDEND IS LESS THAN  OR  EQUAL
C              TO  ZERO.  NEWEND CAN BE RETURNED CHANGED BY
C              THIS ROUTINE EVEN IF ASSOCIATED VALUE IS NOT
C              FOUND  BUT  THEN  MUST  NOT  BE  CHANGED  BY
C              CALLING PROGRAM.  IF  AMPERSAND  OR  END  OF
C              LINE  IS  FOUND INSTEAD OF ASSOCIATED VALUE,
C              THEN NEWEND  INDICATES  TO  SUBSEQUENT  CALL
C              WHETHER  COMMA WAS FOUND BEFORE AMPERSAND OR
C              END OF LINE.
C
C     BGNNEW = RETURNED CONTAINING VALUE OF REAL  INDEX  IF
C              KIND  IS  RETURNED  CONTAINING EITHER 7 OR 8
C              AND IF KNDBGN IS GREATER THAN ZERO.   BGNNEW
C              IS   NOT   CHANGED   IF   KIND  IS  RETURNED
C              CONTAINING EITHER 9 OR 10.   BGNNEW  CAN  BE
C              CHANGED AS REQUIRED BY THE CALLING PROGRAM.
C
C     ENDNEW = RETURNED  CONTAINING  NEXT  ASSOCIATED  REAL
C              VALUE  IF KIND IS RETURNED CONTAINING EITHER
C              7 OR 9 AND IF KNDEND IS GREATER THAN ZERO.
C
      DIMENSION IBUFFR(MAXBFR)
      DATA KOMENT,IEND,IAND,KOMMA,IBLANK,ITAB/
     11H!,1H;,1H&,1H,,1H ,1H	/
C
C     TEST IF ARE CONTINUING PREVIOUSLY EVALUATED VALUES
      MISSIN=0
      IKNCT=KONECT
      IF(IKNCT.GT.1)IKNCT=IKNCT-3
      IF(KIND.LE.0)GO TO 21
      IF(KIND.GT.10)GO TO 21
      GO TO(21,21,21, 6, 4,32, 2, 1,10, 3),KIND
    1 IF(NEWEND.LE.0)GO TO 21
    2 KIND=9
    3 IF(IKNCT.EQ.0)GO TO 21
      GO TO 5
    4 MISSIN=NEWEND
    5 KIND=9
      GO TO 10
    6 MISSIN=NEWEND
    7 KIND=7
      GO TO 10
    8 IF(KONECT.LE.1)GO TO 18
      IF(MISSIN.GT.0)GO TO 31
      MISSIN=1
    9 LOWBFR=LOWBFR+1
   10 IF(LOWBFR.GT.MAXBFR)GO TO 15
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 9
      IF(LETTER.EQ.ITAB)GO TO 9
      IF(LETTER.EQ.KOMMA)GO TO 8
      IF(LETTER.EQ.KOMENT)GO TO 14
      IF(LETTER.EQ.IEND)GO TO 13
      IF(LETTER.EQ.IAND)GO TO 11
C
C     EVALUATE NEXT ASSOCIATED VALUE
      CALL DAHEFT(KNDEND,1,0,IBUFFR,MAXBFR,
     1LOWBFR,ITYPE,ISHIFT,JSHIFT,KSHIFT,LSHIFT,NEWEND,
     2ENDNEW)
      IF(ITYPE.EQ.3)GO TO 36
      IF(KIND.EQ.7)GO TO 32
      GO TO 35
C
C     AMPERSAND FOUND INSTEAD OF ASSOCIATED VALUE
   11 IF(KIND.EQ.7)GO TO 12
      IF(IKNCT.GT.0)GO TO 25
      GO TO 27
   12 IF(IKNCT.GT.0)GO TO 32
      GO TO 26
C
C     SEMICOLON FOUND INSTEAD OF ASSSOCIATED VALUE
   13 IF(KIND.EQ.7)GO TO 32
      IF(MISSIN.GT.0)GO TO 34
      GO TO 24
C
C     NO ASSOCIATED VALUE FOUND
   14 LOWBFR=MAXBFR+1
   15 IF(KIND.EQ.7)GO TO 16
      IF(MISSIN.GT.0)GO TO 34
      GO TO 23
   16 IF(IKNCT.GT.0)GO TO 32
      GO TO 29
C
C     COMMA FOUND INSTEAD OF ASSOCIATED VALUE
   17 IF(KONECT.LE.1)GO TO 19
      GO TO 20
   18 IF(KIND.EQ.7)GO TO 32
   19 KIND=7
C
C     FIND NEXT PAIR OF SERIES
   20 LOWBFR=LOWBFR+1
   21 IF(LOWBFR.GT.MAXBFR)GO TO 23
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 20
      IF(LETTER.EQ.ITAB)GO TO 20
      IF(LETTER.EQ.KOMMA)GO TO 17
      IF(LETTER.EQ.KOMENT)GO TO 22
      IF(LETTER.EQ.IEND)GO TO 24
      IF(LETTER.EQ.IAND)GO TO 25
C
C     OBTAIN LEADING VALUE
      INIBFR=LOWBFR
      CALL DAHEFT(KNDBGN,1,0,IBUFFR,MAXBFR,
     1LOWBFR,ITYPE,ISHIFT,JSHIFT,KSHIFT,LSHIFT,NEWBGN,
     2BGNNEW)
      IF(ITYPE.NE.3)GO TO 35
      IF(KIND.LT.0)GO TO 21
      IF(KIND.NE.9)GO TO 7
      LOWBFR=INIBFR
      GO TO 34
C
C     RETURN TO CALLING PROGRAM
   22 LOWBFR=MAXBFR+1
   23 KIND=1
      GO TO 36
   24 KIND=2
      LOWBFR=LOWBFR+1
      GO TO 36
   25 KIND=3
      LOWBFR=MAXBFR+1
      GO TO 36
   26 KIND=4
      GO TO 28
   27 KIND=5
   28 LOWBFR=MAXBFR+1
      GO TO 30
   29 KIND=6
   30 NEWEND=MISSIN
      GO TO 36
   31 IF(KIND.EQ.9)GO TO 34
      NEWEND=1
      GO TO 33
   32 NEWEND=0
   33 KIND=8
      GO TO 36
   34 KIND=10
      GO TO 36
   35 LOWBFR=LOWBFR+1
      KIND=11
   36 RETURN
C610242504579!;&
      END
      SUBROUTINE DAMISS(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
     1    LOWBFR,KIND  ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2    VALUE ,MANY  ,LCNBFR,LCNERR)
C     RENBR(/DELIMITER WRAPPER FOR DAHEFT)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAMISS  EVALUATES  NUMBERS,  ALLOWS  COMMAS   BETWEEN
C     NUMBERS,  IDENTIFIES MISSING ITEMS INDICATED BY EXTRA
C     COMMAS, SKIPS OVER ANY TEXT  WHICH  IS  TO  RIGHT  OF
C     EITHER  EXCLAMATION  POINT  OR AMPERSAND, AND REPORTS
C     ANY SEMICOLONS FOUND IN TEXT BEING EVALUATED.
C
C     ARGUMENT LISTS OF DAMISS  AND  DAHEFT  ARE  IDENTICAL
C     EXCEPT FOR ARGUMENTS MANY, LCNBFR AND LCNERR WHICH DO
C     NOT APPEAR IN DAHEFT ARGUMENT LIST, AND  EXCEPT  THAT
C     DAMISS  CAN  RETURN  ARGUMENT  NAMED  KIND CONTAINING
C     ADDITIONAL VALUES 4, 5, 6 AND 7.  ARGUMENT NAMED MANY
C     MUST BE SET TO ZERO BY CALLING PROGRAM BEFORE CALLING
C     EITHER THIS ROUTINE OR ANY OF OTHER ROUTINES IN  FASP
C     PACKAGE  (SUCH  AS  DANEXT,  DASPAN AND DATEST) WHICH
C     DEFINE THIS ARGUMENT IN  SIMILAR  MANNER.   ARGUMENTS
C     NAMED  KIND  AND  LCNBFR  ARE USED ONLY FOR OUTPUT TO
C     CALLING PROGRAM AND THEIR INPUT VALUES  ARE  IGNORED.
C     THESE  ARGUMENTS  ARE DESCRIBED BELOW.  DOCUMENTATION
C     OF DAHEFT SHOULD BE  CONSULTED  FOR  DESCRIPTIONS  OF
C     REMAINING ARGUMENTS.
C
C     KIND   = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C              BY  LEADING  EXCLAMATION POINT, WAS FOUND AT
C              OR  TO  RIGHT  OF  IBUFFR(LOWBFR).   CALLING
C              PROGRAM  SHOULD  READ  NEW  LINE INTO IBUFFR
C              ARRAY BEFORE AGAIN CALLING THIS  ROUTINE  IF
C              ADDITIONAL  VALUES  ARE REQUIRED.  LOWBFR IS
C              RETURNED  POINTING  BEYOND  END  OF  BUFFER.
C              MANY  IS  RETURNED  SET TO ZERO.  IVALUE AND
C              VALUE ARE RETURNED UNDEFINED.
C            = 2,  FIRST  PRINTING  CHARACTER  (OTHER  THAN
C              POSSIBLE  COMMA  IF  MANY  WAS INPUT GREATER
C              THAN ZERO) IN OR TO RIGHT OF  IBUFFR(LOWBFR)
C              WAS   NOT   CHARACTER   WHICH   COULD  BEGIN
C              REPRESENTATION OF NUMBER AND WAS NOT  COMMA,
C              SEMICOLON,  AMPERSAND  OR EXCLAMATION POINT.
C              LOWBFR IS RETURNED POINTING TO THIS PRINTING
C              CHARACTER.   IT  IS  EXPECTED  THAT  CALLING
C              PROGRAM WILL OTHERWISE PROCESS THIS PRINTING
C              CHARACTER  SINCE  DAMISS  WOULD  RETURN SAME
C              RESULTS IF CALLED AGAIN WITH SAME  VALUE  OF
C              LOWBFR  AND WITH SAME BUFFER CONTENTS.  MANY
C              IS RETURNED CONTAINING ONE  PLUS  ITS  INPUT
C              ABSOLUTE   VALUE.    IVALUE  AND  VALUE  ARE
C              RETURNED UNDEFINED.
C            = 3, NUMBER WAS FOUND WHICH WAS FOLLOWED BY  A
C              SPACE,   TAB  CHARACTER,  COMMA,  SEMICOLON,
C              EXCLAMATION  POINT  OR  AMPERSAND.  MANY  IS
C              RETURNED   CONTAINING  ONE  PLUS  ITS  INPUT
C              ABSOLUTE VALUE.  LOWBFR IS RETURNED POINTING
C              TO    CHARACTER    TO    RIGHT   OF   NUMBER
C              REPRESENTATION.
C            = 4, NUMBER WAS FOUND WHICH  WAS  FOLLOWED  BY
C              CHARACTER  OTHER  THAN SPACE, TAB CHARACTER,
C              COMMA,  SEMICOLON,  EXCLAMATION   POINT   OR
C              AMPERSAND.   LCNBFR  IS RETURNED POINTING IN
C              BUFFER TO FIRST CHARACTER OF NUMBER.  LOWBFR
C              IS  RETURNED POINTING IN BUFFER TO CHARACTER
C              TO RIGHT  OF  NUMBER.   LCNERR  IS  RETURNED
C              POINTING   IN  BUFFER  TO  NEXT  SPACE,  TAB
C              CHARACTER,  COMMA,  SEMICOLON,   EXCLAMATION
C              POINT OR AMPERSAND TO RIGHT OF NUMBER, OR IS
C              RETURNED POINTING BEYOND END OF BUFFER IF NO
C              SPACE,   TAB  CHARACTER,  COMMA,  SEMICOLON,
C              EXCLAMATION POINT OR AMPERSAND IS  FOUND  TO
C              RIGHT   OF   NUMBER.    MANY   IS   RETURNED
C              CONTAINING  ONE  PLUS  ITS  INPUT   ABSOLUTE
C              VALUE.
C            = 5, SEMICOLON WAS  FOUND  AS  FIRST  PRINTING
C              CHARACTER  AT OR TO RIGHT OF IBUFFR(LOWBFR).
C              LOWBFR  IS   RETURNED   POINTING   TO   NEXT
C              CHARACTER  BEYOND  SEMICOLON.  IT IS ASSUMED
C              THAT CALLING PROGRAM WILL  TREAT  APPEARANCE
C              OF  SEMICOLON  AS  MARKING END OF STATEMENT.
C              MANY IS RETURNED SET TO  ZERO.   IVALUE  AND
C              VALUE ARE RETURNED UNDEFINED.
C            = 6, AMPERSAND WAS  FOUND  AS  FIRST  PRINTING
C              CHARACTER AT OR TO RIGHT OF LOWBFR.  TEXT TO
C              RIGHT OF AMPERSAND IS TAKEN  AS  COMMENT  SO
C              LOWBFR IS RETURNED POINTING BEYOND RIGHT END
C              OF  BUFFER.   IT  IS  ASSUMED  THAT  CALLING
C              PROGRAM WILL READ IN CONTENTS OF NEW BUFFER,
C              THEN AGAIN  REQUEST  NEW  NUMBER  EVALUATION
C              FROM  THIS  ROUTINE.  VALUE OF MANY MUST NOT
C              BE CHANGED BY CALLING PROGRAM PRIOR TO  THIS
C              FOLLOWING CALL.  EFFECT IS NOT QUITE SAME AS
C              IF USER HAD TYPED ALL OF TEXT ON SINGLE LINE
C              SINCE  SINGLE NUMBER  CANNOT BE SPLIT ACROSS
C              LINE BOUNDARY. IVALUE AND VALUE ARE RETURNED
C              UNDEFINED.
C            = 7, NUMBER WAS NOT FOUND, BUT EXTRA COMMA WAS
C              FOUND  INDICATING  MISSING  NUMBER.  MANY IS
C              RETURNED  CONTAINING  ONE  PLUS  ITS   INPUT
C              ABSOLUTE  VALUE.  IVALUE OR VALUE, WHICHEVER
C              IS APPROPRIATE, IS RETURNED SET TO ZERO.
C
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF NEW  LOGICAL  SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE WHEN BEGINNING PROCESSING OF LINE OF
C              TEXT NOT TIED TO PREVIOUS LINE BY  AMPERSAND
C              AT  END OF PREVIOUS LINE, OR WHEN PROCESSING
C              TEXT TO RIGHT OF SEMICOLON.  INITIAL ZEROING
C              OF  THIS  ARGUMENT  MUST  BE DONE BY CALLING
C              PROGRAM, BUT THEREAFTER  VALUE  RETURNED  BY
C              PREVIOUS CALL TO THIS ROUTINE CAN USUALLY BE
C              USED.  MANY IS RETURNED  SET  TO  ZERO  EACH
C              TIME  SEMICOLON  (KIND=5) IS FOUND, AND EACH
C              TIME END OF LINE NOT TIED TO FOLLOWING  LINE
C              BY  AMPERSAND  (KIND=1)  IS  FOUND.  MANY IS
C              RETURNED  CONTAINING  ONE  PLUS  ITS   INPUT
C              ABSOLUTE  VALUE  EACH  TIME NUMBER IS FOUND,
C              EACH TIME UNKNOWN  CHARACTER  IS  FOUND,  OR
C              EACH  TIME  INDICATION  OF MISSING NUMBER IS
C              FOUND.  KIND IS RETURNED CONTAINING VALUE  6
C              AND  MANY IS RETURNED CONTAINING NEGATIVE OF
C              NUMBER  OF  ITEMS  FOUND  IF  NEXT  PRINTING
C              CHARACTER   FOLLOWING  COMMA  IS  AMPERSAND.
C              MANY  SHOULD  NOT  BE  CHANGED  BY   CALLING
C              PROGRAM IF AMPERSAND (KIND BEING RETURNED=6)
C              IS FOUND INDICATING THAT SUBSEQUENT CALL  TO
C              THIS  ROUTINE IS TO PROCESS TEXT WHICH IS TO
C              BE TREATED AS THOUGH IT APPEARED IN PLACE OF
C              AMPERSAND   AND  CHARACTERS  TO  ITS  RIGHT.
C              EFFECT IS NOT QUITE  SAME  AS  IF  USER  HAD
C              TYPED  ALL  OF  TEXT  ON  SINGLE  LINE SINCE
C              SINGLE NUMBER  CANNOT  BE SPLIT  ACROSS LINE
C              BOUNDARY.
C
C              IF  MANY  IS  INPUT  CONTAINING  ZERO,  THEN
C              INITIAL  COMMA IN INPUT TEXT BUFFER IS TAKEN
C              TO INDICATE INITIAL MISSING ITEM,  AND  MANY
C              IS  THEN  RETURNED CONTAINING 1.  IF MANY IS
C              INPUT GREATER THAN ZERO, THEN INITIAL  COMMA
C              IS  IGNORED  IF FOLLOWED BY NUMBER.  IF MANY
C              IS INPUT GREATER  THAN  ZERO,  THEN  INITIAL
C              COMMA   FOLLOWED   BY   NO   OTHER  PRINTING
C              CHARACTERS, BY SEMICOLON, OR BY  EXCLAMATION
C              POINT  INDICATES  MISSING  ITEM.  IF MANY IS
C              INPUT GREATER THAN ZERO, THEN INITIAL  COMMA
C              FOLLOWED  BY  AMPERSAND WILL CAUSE REMAINING
C              CHARACTERS IN BUFFER TO BE IGNORED, AND MANY
C              WILL  BE RETURNED CONTAINING NEGATIVE OF ITS
C              INPUT VALUE.  IF  MANY  IS  INPUT  NEGATIVE,
C              THEN  IT IS ASSUMED THAT CONTENTS OF CURRENT
C              BUFFER   CONTINUE   PREVIOUS   LINE    WHICH
C              TERMINATED WITH COMMA FOLLOWED BY AMPERSAND,
C              AND MANY IS RETURNED GREATER THAN ZERO.
C
C     LCNBFR = IF  NUMBER  REPRESENTATION  IS  FOUND,  KIND
C              BEING  RETURNED  CONTAINING  EITHER  3 OR 4,
C              THEN LCNBFR IS RETURNED CONTAINING SUBSCRIPT
C              OF  IBUFFR  ARRAY  LOCATION  WHICH  CONTAINS
C              FIRST   (LEFTMOST)   CHARACTER   OF   NUMBER
C              REPRESENTATION. LCNBFR IS RETURNED UNDEFINED
C              IF NUMBER REPRESENTATION IS NOT FOUND.
C
C     LCNERR = IF KIND IS RETURNED SET TO 4 INDICATING THAT
C              NUMBER  WAS  FOLLOWED  BY PRINTING CHARACTER
C              OTHER  THAN  COMMA,  SEMICOLON,  EXCLAMATION
C              POINT  OR  AMPERSAND,  THEN  LCNERR CONTAINS
C              SUBSCRIPT IN IBUFFR ARRAY OF LOCATION  WHICH
C              CONTAINS NEXT  SPACE, TAB CHARACTER,  COMMA,
C              SEMICOLON, EXCLAMATION POINT OR AMPERSAND OR
C              IS SET TO  MAXBFR+1 IF NO  ALLOWED DELIMITER
C              CHARACTERS APPEARS TO RIGHT OF NUMBER.
C
      DIMENSION IBUFFR(MAXBFR)
      DATA KOMENT,IEND,IAND,KOMMA,ISPACE,ITAB/
     11H!,1H;,1H&,1H,,1H ,1H	/
      KIND=1
      IF(MANY.GE.0)GO TO 1
      KIND=7
      MANY=-MANY
    1 IF(KONTRL.LE.0)IVALUE=0
      IF(KONTRL.GT.0)VALUE=0.0
      GO TO 3
C
C     IDENTIFY NEXT CHARACTER
    2 LOWBFR=LOWBFR+1
    3 IF(LOWBFR.GT.MAXBFR)GO TO 9
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.ISPACE)GO TO 2
      IF(LETTER.EQ.ITAB)GO TO 2
      IF(LETTER.EQ.KOMENT)GO TO 8
      IF(LETTER.EQ.IEND)GO TO 6
      IF(LETTER.EQ.KOMMA)GO TO 5
      IF(LETTER.EQ.IAND)GO TO 7
C
C     TEST IF CHARACTER STARTS A NUMBER
      LCNBFR=LOWBFR
      CALL DAHEFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
     1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE)
      LCNERR=LOWBFR
    4 IF(LCNERR.GT.MAXBFR)GO TO 11
      LETTER=IBUFFR(LCNERR)
      IF(LETTER.EQ.ISPACE)GO TO 11
      IF(LETTER.EQ.ITAB)GO TO 11
      IF(LETTER.EQ.KOMENT)GO TO 11
      IF(LETTER.EQ.IEND)GO TO 11
      IF(LETTER.EQ.KOMMA)GO TO 11
      IF(LETTER.EQ.IAND)GO TO 11
      LCNERR=LCNERR+1
      IF(KIND.EQ.3)KIND=4
      GO TO 4
C
C     TEST IF COMMA CAN PRECEDE A VALUE
    5 IF(KIND.NE.1)GO TO 11
      KIND=7
      IF(MANY.EQ.0)GO TO 11
      GO TO 2
C
C     SEMICOLON FOUND
    6 IF(KIND.NE.1)GO TO 11
      LOWBFR=LOWBFR+1
      KIND=5
      GO TO 10
C
C     AMPERSAND FOUND
    7 IF(KIND.NE.1)MANY=-MANY
      KIND=6
      LOWBFR=MAXBFR+1
      GO TO 12
C
C     EXCLAMATION POINT FOUND
    8 IF(KIND.NE.1)GO TO 11
      LOWBFR=MAXBFR+1
      GO TO 10
C
C     END OF LINE FOUND
    9 IF(KIND.NE.1)GO TO 11
C
C     RETURN TO CALLING ROUTINE
   10 MANY=0
      GO TO 12
   11 MANY=MANY+1
   12 RETURN
C404203515168!;&
      END
      SUBROUTINE DALOSS(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
     1    KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MATCH ,LCNWRD,
     2    LCNKNT,LCNBFR,MANY  ,LCNERR)
C     RENBR(/DELIMITER WRAPPER FOR DAVERB)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DALOSS IDENTIFIES  WORDS  AND  ABBREVIATIONS,  ALLOWS
C     COMMAS   BETWEEN   WORDS,  IDENTIFIES  MISSING  ITEMS
C     INDICATED BY EXTRA COMMAS, SKIPS OVER ANY TEXT  WHICH
C     IS TO RIGHT OF EITHER EXCLAMATION POINT OR AMPERSAND,
C     AND  REPORTS  ANY  SEMICOLONS  FOUND  IN  TEXT  BEING
C     EVALUATED.    IN  ADDITION,  DALOSS  REPORTS  WHETHER
C     CHARACTER TO RIGHT OF WORD  OR  ITS  ABBREVIATION  IS
C     CHARACTER  OTHER THAN SPACE, TAB CHARACTER OR ALLOWED
C     PUNCTUATION CHARACTER.
C
C     ARGUMENT LISTS OF DALOSS  AND  DAVERB  ARE  IDENTICAL
C     EXCEPT  FOR DALOSS ARGUMENTS MANY AND LCNERR WHICH DO
C     NOT APPEAR IN DAVERB ARGUMENT LIST, AND  EXCEPT  THAT
C     DALOSS  CAN  RETURN  ARGUMENT  NAMED  KIND CONTAINING
C     ADDITIONAL VALUES 6 THROUGH 11.  ARGUMENT NAMED  MANY
C     MUST BE SET TO ZERO BY CALLING PROGRAM BEFORE CALLING
C     EITHER THIS ROUTINE OR ANY OF OTHER ROUTINES IN  FASP
C     PACKAGE  (SUCH  AS  DAMISS,  DANEXT AND DASPAN) WHICH
C     DEFINE THIS ARGUMENT IN  SIMILAR  MANNER.   ARGUMENTS
C     NAMED  KIND  AND  LCNERR  ARE USED ONLY FOR OUTPUT TO
C     CALLING PROGRAM AND THEIR INPUT VALUES  ARE  IGNORED.
C     THESE  ARGUMENTS  ARE DESCRIBED BELOW.  DOCUMENTATION
C     OF DAVERB SHOULD BE  CONSULTED  FOR  DESCRIPTIONS  OF
C     REMAINING ARGUMENTS.
C
C     KIND   = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C              BY  LEADING  EXCLAMATION POINT, WAS FOUND AT
C              OR  TO  RIGHT  OF  IBUFFR(LOWBFR).   CALLING
C              PROGRAM  SHOULD  READ  NEW  LINE INTO IBUFFR
C              ARRAY BEFORE AGAIN CALLING THIS  ROUTINE  IF
C              ADDITIONAL  WORDS  ARE  REQUIRED.  LOWBFR IS
C              RETURNED  POINTING  BEYOND  END  OF  BUFFER.
C              MANY  IS  RETURNED  SET  TO  ZERO.  MATCH IS
C              RETURNED UNDEFINED.
C            = 2,  FIRST  PRINTING  CHARACTER  (OTHER  THAN
C              POSSIBLE  COMMA  IF  MANY  WAS INPUT GREATER
C              THAN ZERO) IN OR TO RIGHT OF  IBUFFR(LOWBFR)
C              DID NOT MATCH FIRST CHARACTER OF ANY WORD IN
C              DICTIONARY AND  WAS  NOT  COMMA,  SEMICOLON,
C              AMPERSAND  OR  EXCLAMATION POINT.  LOWBFR IS
C              RETURNED   POINTING   TO    THIS    PRINTING
C              CHARACTER.   IT  IS  EXPECTED  THAT  CALLING
C              PROGRAM WILL OTHERWISE PROCESS THIS PRINTING
C              CHARACTER  SINCE  DALOSS  WOULD  RETURN SAME
C              RESULTS IF CALLED AGAIN WITH SAME  VALUE  OF
C              LOWBFR,  WITH  SAME DICTIONARY AND WITH SAME
C              BUFFER   CONTENTS.    MANY    IS    RETURNED
C              CONTAINING   ONE  PLUS  ITS  INPUT  ABSOLUTE
C              VALUE.  MATCH IS RETURNED UNDEFINED.
C            = 3 OR 4 OR 5, SAME  AS  WHEN  DAVERB  RETURNS
C              THESE  VALUES,  EXCEPT  THAT  IF  THERE  ARE
C              ADDITIONAL CHARACTERS TO RIGHT  OF  WORD  OR
C              ITS    ABBREVIATION,   THEN   CHARACTER   TO
C              IMMEDIATE RIGHT OF WORD OR ITS  ABBREVIATION
C              IS   EITHER  SPACE,  TAB  CHARACTER,  COMMA,
C              SEMICOLON, EXCLAMATION POINT  OR  AMPERSAND.
C              MANY  IS  RETURNED  CONTAINING  ONE PLUS ITS
C              INPUT ABSOLUTE VALUE.   LOWBFR  IS  RETURNED
C              POINTING  TO  CHARACTER  TO RIGHT OF WORD OR
C              ITS ABBREVIATION.
C            = 3, WORD IN IWORD ARRAY WAS MATCHED  EXACTLY.
C              MATCH IS RETURNED CONTAINING SEQUENCE NUMBER
C              OF WORD MATCHED IN IWORD ARRAY.
C            = 4,  NONAMBIGUOUS  ABBREVIATION  OF  WORD  IN
C              IWORD  ARRAY  WAS  FOUND.  MATCH IS RETURNED
C              CONTAINING SEQUENCE NUMBER OF WORD IN  IWORD
C              ARRAY.
C            = 5, AMBIGUOUS ABBREVIATION OF WORD WAS FOUND.
C              MATCH IS RETURNED CONTAINING SEQUENCE NUMBER
C              OF FIRST WORD MATCHED IN IWORD ARRAY.
C            = 6  OR  7  OR  8,  SAME  AS   KIND   RETURNED
C              CONTAINING  3 OR 4 OR 5 RESPECTIVELY, EXCEPT
C              THAT  CHARACTER  OTHER   THAN   SPACE,   TAB
C              CHARACTER,   COMMA,  SEMICOLON,  EXCLAMATION
C              POINT OR  AMPERSAND  APPEARED  TO  IMMEDIATE
C              RIGHT  OF  WORD OR ITS ABBREVIATION.  LCNBFR
C              IS RETURNED  POINTING  IN  BUFFER  TO  FIRST
C              CHARACTER   OF  WORD  OR  ITS  ABBREVIATION.
C              LOWBFR IS RETURNED  POINTING  IN  BUFFER  TO
C              CHARACTER   TO   RIGHT   OF   WORD   OR  ITS
C              ABBREVIATION.  LCNERR IS  RETURNED  POINTING
C              IN  BUFFER  TO  NEXT  SPACE,  TAB CHARACTER,
C              COMMA,  SEMICOLON,  EXCLAMATION   POINT   OR
C              AMPERSAND   TO   RIGHT   OF   WORD   OR  ITS
C              ABBREVIATION, OR IS RETURNED POINTING BEYOND
C              END  OF  BUFFER  IF NO SPACE, TAB CHARACTER,
C              COMMA,  SEMICOLON,  EXCLAMATION   POINT   OR
C              AMPERSAND  IS  FOUND TO RIGHT OF WORD OR ITS
C              ABBREVIATION.  MANY IS  RETURNED  CONTAINING
C              ONE PLUS ITS INPUT ABSOLUTE VALUE.
C            = 9, SEMICOLON WAS  FOUND  AS  FIRST  PRINTING
C              CHARACTER  AT OR TO RIGHT OF IBUFFR(LOWBFR).
C              LOWBFR  IS   RETURNED   POINTING   TO   NEXT
C              CHARACTER  BEYOND  SEMICOLON.  IT IS ASSUMED
C              THAT CALLING PROGRAM WILL  TREAT  APPEARANCE
C              OF  SEMICOLON  AS  MARKING END OF STATEMENT.
C              MANY IS RETURNED  SET  TO  ZERO.   MATCH  IS
C              RETURNED UNDEFINED.
C            = 10, AMPERSAND WAS FOUND  AS  FIRST  PRINTING
C              CHARACTER AT OR TO RIGHT OF LOWBFR.  TEXT TO
C              RIGHT OF AMPERSAND IS TAKEN  AS  COMMENT  SO
C              LOWBFR IS RETURNED POINTING BEYOND RIGHT END
C              OF  BUFFER.   IT  IS  ASSUMED  THAT  CALLING
C              PROGRAM WILL READ IN CONTENTS OF NEW BUFFER,
C              THEN AGAIN REQUEST NEW  WORD  IDENTIFICATION
C              FROM  THIS  ROUTINE.  VALUE OF MANY MUST NOT
C              BE CHANGED BY CALLING PROGRAM PRIOR TO  THIS
C              FOLLOWING CALL.  EFFECT IS NOT QUITE SAME AS
C              IF USER HAD TYPED ALL OF TEXT ON SINGLE LINE
C              SINCE  SINGLE  WORD  CANNOT  BE SPLIT ACROSS
C              LINE BOUNDARY.  MATCH IS RETURNED UNDEFINED.
C            = 11, WORD WAS NOT FOUND, BUT EXTRA COMMA  WAS
C              FOUND  INDICATING  MISSING  WORD.   MANY  IS
C              RETURNED  CONTAINING  ONE  PLUS  ITS   INPUT
C              ABSOLUTE    VALUE.     MATCH   IS   RETURNED
C              UNDEFINED.
C
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF NEW  LOGICAL  SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE WHEN BEGINNING PROCESSING OF LINE OF
C              TEXT NOT TIED TO PREVIOUS LINE BY  AMPERSAND
C              AT  END OF PREVIOUS LINE, OR WHEN PROCESSING
C              TEXT TO RIGHT OF SEMICOLON.  INITIAL ZEROING
C              OF  THIS  ARGUMENT  MUST  BE DONE BY CALLING
C              PROGRAM, BUT THEREAFTER  VALUE  RETURNED  BY
C              PREVIOUS CALL TO THIS ROUTINE CAN USUALLY BE
C              USED.  MANY IS RETURNED  SET  TO  ZERO  EACH
C              TIME  SEMICOLON  (KIND=9) IS FOUND, AND EACH
C              TIME END OF LINE NOT TIED TO FOLLOWING  LINE
C              BY  AMPERSAND  (KIND=1)  IS  FOUND.  MANY IS
C              RETURNED  CONTAINING  ONE  PLUS  ITS   INPUT
C              ABSOLUTE VALUE EACH TIME WORD IS FOUND, EACH
C              TIME UNKNOWN CHARACTER  IS  FOUND,  OR  EACH
C              TIME  INDICATION  OF  MISSING WORD IS FOUND.
C              KIND IS RETURNED  CONTAINING  VALUE  10  AND
C              MANY  IS  RETURNED  CONTAINING  NEGATIVE  OF
C              NUMBER  OF  ITEMS  FOUND  IF  NEXT  PRINTING
C              CHARACTER   FOLLOWING  COMMA  IS  AMPERSAND.
C              MANY  SHOULD  NOT  BE  CHANGED  BY   CALLING
C              PROGRAM    IF    AMPERSAND    (KIND    BEING
C              RETURNED=10)  IS   FOUND   INDICATING   THAT
C              SUBSEQUENT   CALL  TO  THIS  ROUTINE  IS  TO
C              PROCESS TEXT  WHICH  IS  TO  BE  TREATED  AS
C              THOUGH IT APPEARED IN PLACE OF AMPERSAND AND
C              CHARACTERS TO  ITS  RIGHT.   EFFECT  IS  NOT
C              QUITE  SAME AS IF USER HAD TYPED ALL OF TEXT
C              ON SINGLE LINE SINCE SINGLE WORD  CANNOT  BE
C              SPLIT ACROSS LINE BOUNDARY.
C
C              IF  MANY  IS  INPUT  CONTAINING  ZERO,  THEN
C              INITIAL  COMMA IN INPUT TEXT BUFFER IS TAKEN
C              TO INDICATE INITIAL MISSING ITEM,  AND  MANY
C              IS  THEN  RETURNED CONTAINING 1.  IF MANY IS
C              INPUT GREATER THAN ZERO, THEN INITIAL  COMMA
C              IS  IGNORED IF FOLLOWED BY WORD.  IF MANY IS
C              INPUT GREATER THAN ZERO, THEN INITIAL  COMMA
C              FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C              SEMICOLON, OR BY EXCLAMATION POINT INDICATES
C              MISSING ITEM.  IF MANY IS INPUT GREATER THAN
C              ZERO,  THEN  INITIAL   COMMA   FOLLOWED   BY
C              AMPERSAND WILL CAUSE REMAINING CHARACTERS IN
C              BUFFER TO  BE  IGNORED,  AND  MANY  WILL  BE
C              RETURNED  CONTAINING  NEGATIVE  OF ITS INPUT
C              VALUE.  IF MANY IS INPUT NEGATIVE,  THEN  IT
C              IS  ASSUMED  THAT CONTENTS OF CURRENT BUFFER
C              CONTINUE PREVIOUS LINE WHICH TERMINATED WITH
C              COMMA  FOLLOWED  BY  AMPERSAND,  AND MANY IS
C              RETURNED GREATER THAN ZERO.
C
C     LCNERR = IF KIND  IS  RETURNED  SET  TO  6,  7  OR  8
C              INDICATING THAT WORD OR ITS ABBREVIATION WAS
C              FOLLOWED BY PRINTING  CHARACTER  OTHER  THAN
C              COMMA,   SEMICOLON,   EXCLAMATION  POINT  OR
C              AMPERSAND, THEN LCNERR CONTAINS SUBSCRIPT IN
C              IBUFFR ARRAY OF LOCATION WHICH CONTAINS NEXT
C              SPACE,  TAB  CHARACTER,   COMMA,  SEMICOLON,
C              EXCLAMATION POINT OR  AMPERSAND OR IS SET TO
C              MAXBFR+1 IF  NO ALLOWED DELIMITER  CHARACTER
C              APPEARS TO RIGHT OF WORD OR ITS ABBREVIATION
C
      DIMENSION IBUFFR(MAXBFR),IWORD(MAXWRD),
     1KNTLTR(MAXKNT)
      DATA KOMENT,IEND,IAND,KOMMA,ISPACE,ITAB/
     11H!,1H;,1H&,1H,,1H ,1H	/
      INIMNY=MANY
      IF(MANY.LT.0)MANY=-MANY
C
C     TEST IF CHARACTER STARTS A WORD
    1 CALL DAVERB(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
     1    KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MATCH ,LCNWRD,
     2    LCNKNT,LCNBFR)
      LCNERR=LOWBFR
      IF(KIND.GT.2)GO TO 3
      IF(KIND.EQ.1)GO TO 8
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.KOMENT)GO TO 7
      IF(LETTER.EQ.IEND)GO TO 5
      IF(LETTER.EQ.KOMMA)GO TO 4
      IF(LETTER.EQ.IAND)GO TO 6
C
C     IF MATCH FOUND, CHECK IF FOLLOWING CHARACTER IS LEGAL
    2 LCNERR=LCNERR+1
      IF(KIND.LE.2)GO TO 3
      IF(KIND.LE.5)KIND=KIND+3
    3 IF(LCNERR.GT.MAXBFR)GO TO 11
      LETTER=IBUFFR(LCNERR)
      IF(LETTER.EQ.ISPACE)GO TO 11
      IF(LETTER.EQ.ITAB)GO TO 11
      IF(LETTER.EQ.KOMENT)GO TO 11
      IF(LETTER.EQ.IEND)GO TO 11
      IF(LETTER.EQ.KOMMA)GO TO 11
      IF(LETTER.EQ.IAND)GO TO 11
      GO TO 2
C
C     TEST IF COMMA CAN PRECEDE A VALUE
    4 IF(INIMNY.LE.0)GO TO 10
      INIMNY=-INIMNY
      LOWBFR=LOWBFR+1
      GO TO 1
C
C     SEMICOLON FOUND
    5 IF(INIMNY.LT.0)GO TO 10
      LOWBFR=LOWBFR+1
      KIND=9
      GO TO 9
C
C     AMPERSAND FOUND
    6 IF(INIMNY.LT.0)MANY=INIMNY
      KIND=10
      LOWBFR=MAXBFR+1
      GO TO 12
C
C     EXCLAMATION POINT FOUND
    7 IF(INIMNY.LT.0)GO TO 10
      LOWBFR=MAXBFR+1
      KIND=1
      GO TO 9
C
C     END OF LINE FOUND
    8 IF(INIMNY.LT.0)GO TO 10
C
C     RETURN TO CALLING ROUTINE
    9 MANY=0
      GO TO 12
   10 KIND=11
   11 MANY=MANY+1
   12 RETURN
C408421442172!;&
      END
      SUBROUTINE DARANK(INCRES,IFTEST,MINMUM,MAXMUM,MINSTR,
     1    MAXSTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MAXUSD,ISTORE)
C     RENBR(/RETURNS SORTED INTEGERS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DARANK RETURNS A GROUP OF INTEGERS SORTED INTO EITHER
C     INCREASING  OR  DECREASING ORDER.  DUPLICATES ARE NOT
C     RETURNED.   NUMBERS  CAN  BE   SPECIFIED   IN   SLASH
C     NOTATION.
C
C     INCRES = 1,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              DECREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              SMALLER VALUES ARE DISCARDED.
C            = 2,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              DECREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              LARGER VALUES ARE DISCARDED.
C            = 3,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              INCREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              SMALLER VALUES ARE DISCARDED.
C            = 4,  RETURN  VALUES  IN  ISTORE  SORTED  INTO
C              INCREASING  ORDER.  IF MORE VALUES ARE FOUND
C              THAN CAN BE RETURNED IN ISTORE  ARRAY,  THEN
C              LARGER VALUES ARE DISCARDED.
C     IFTEST = -2 OR 2, THERE ARE NO  MINIMUM  AND  MAXIMUM
C              LIMITS TO RANGE OF LEGAL VALUES.
C            = -1, REJECT VALUES LESS THAN MINMUM.
C            = 0, REJECT VALUES LESS THAN MINMUM OR GREATER
C              THAN MAXMUM.
C            = 1, REJECT VALUES GREATER THAN MAXMUM.
C     MINMUM = LOWER LIMIT OF ALLOWED VALUES IF  IFTEST  IS
C              -1  OR  0.   VALUES LESS THAN MINMUM ARE NOT
C              RETURNED IN ISTORE IF IFTEST IS -1 OR 0.
C     MAXMUM = UPPER LIMIT OF ALLOWED VALUES IF IFTEST IS 0
C              OR  1.   VALUES  GREATER THAN MAXMUM ARE NOT
C              RETURNED IN ISTORE IF IFTEST IS 0 OR 1.
C     MINSTR = SUBSCRIPT OF LOWEST LOCATION IN ISTORE ARRAY
C              INTO WHICH VALUE CAN BE PLACED.
C     MAXSTR = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  ISTORE
C              ARRAY INTO WHICH VALUE CAN BE PLACED.
C     IBUFFR = INPUT TEXT BUFFER CONTAINING 1 CHARACTER PER
C              ARRAY  LOCATION  AS  READ  BY MULTIPLE OF A1
C              FORMAT.
C     MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR  ARRAY  LOCATION
C              TO BE SEARCHED FOR CHARACTERS.
C     LOWBFR = INPUT CONTAINING SUBSCRIPT OF  IBUFFR  ARRAY
C              LOCATION  CONTAINING  FIRST  CHARACTER TO BE
C              TESTED.   LOWBFR  IS   RETURNED   CONTAINING
C              SUBSCRIPT    OF    IBUFFR   ARRAY   LOCATION
C              CONTAINING NEXT CHARACTER NOT YET EVALUATED.
C     KIND   = SHOULD BE INPUT  CONTAINING  ZERO  (OR  ONE)
C              WHENEVER  THIS ROUTINE IS CALLED TO GENERATE
C              NEW  GROUP  OF  SORTED  NUMBERS.   KIND   IS
C              RETURNED  DESCRIBING  REASON  FOR  RETURN TO
C              CALLING  PROGRAM.   IF  KIND   IS   RETURNED
C              CONTAINING  VALUE  OF  3  OR GREATER, AND IS
C              SENT  TO  SUBSEQUENT  CALL  UNCHANGED,  THEN
C              MAXUSD  IS  NOT  RESET  TO MINSTR-1, AND NEW
C              VALUES ARE APPENDED TO OLD CONTENTS, IF ANY,
C              OF ISTORE.
C            = 1, RETURNED EITHER IF NO PRINTING CHARACTERS
C              ARE  FOUND BEYOND NUMBERS, OR IF EXCLAMATION
C              POINT  IS  NEXT  CHARACTER  BEYOND  NUMBERS.
C              LOWBFR  IS  RETURNED  POINTING BEYOND END OF
C              BUFFER.
C            = 2, RETURNED IF SEMICOLON WAS FOUND  AS  NEXT
C              PRINTING  CHARACTER  BEYOND NUMBERS.  LOWBFR
C              IS  RETURNED  POINTING  TO  NEXT   CHARACTER
C              BEYOND SEMICOLON.
C            = 3, RETURNED IF AMPERSAND WAS FOUND  AS  NEXT
C              PRINTING  CHARACTER  BEYOND NUMBERS.  LOWBFR
C              IS RETURNED POINTING BEYOND END OF BUFFER.
C            = 4, RETURNED IF UNKNOWN CHARACTER  WAS  FOUND
C              AS  NEXT  PRINTING CHARACTER BEYOND NUMBERS.
C              LOWBFR IS RETURNED  POINTING TO THIS UNKNOWN
C              CHARACTER.   LOWBFR  MUST BE  INCREMENTED BY
C              CALLING PROGRAM BEFORE  THIS ROUTINE IS NEXT
C              CALLED.
C            = 5, ILLEGAL SERIES SPECIFICATION  WAS  FOUND.
C              LOWBFR   IS   RETURNED   POINTING   TO  NEXT
C              CHARACTER BEYOND SERIES SPECIFICATION.
C     MAXUSD = RETURNED  CONTAINING  SUBSCRIPT  OF  HIGHEST
C              LOCATION  IN  ISTORE  USED  TO RETURN SORTED
C              VALUES.
C     ISTORE = ARRAY  USED  TO  RETURN  SORTED  VALUES   IN
C              ISTORE(MINSTR)    THROUGH    AND   INCLUDING
C              ISTORE(MAXUSD).
C
      DIMENSION IBUFFR(MAXBFR),ISTORE(MAXSTR)
      JNCRES=INCRES-2
      MANY=0
      MINTST=IFTEST
      IF(MINTST.LT.-1)MINTST=1
      MAXTST=IFTEST
      IF(MAXTST.GT.1)MAXTST=-1
      IF(KIND.LT.3)MAXUSD=MINSTR-1
    1 KIND=0
    2 CALL DANEXT(0,0.0,IBUFFR,MAXBFR,LOWBFR,
     1MANY,KIND,NEWVAL,INCVAL,LMTVAL,VALNEW,VALINC,
     2VALLMT)
      GO TO(34,34,34,2,3,1,1,33,32),KIND
C
C     TEST IF NEW VALUE IS IN REGION BEING DISCARDED
    3 GO TO(5,4,5,4),INCRES
    4 IF(INCVAL.GE.0)GO TO 7
      LEFT=(NEWVAL-LMTVAL)/(-INCVAL)
      GO TO 6
    5 IF(INCVAL.LE.0)GO TO 7
      LEFT=(LMTVAL-NEWVAL)/INCVAL
    6 IF(LEFT.LE.0)GO TO 7
      LMTVAL=NEWVAL
      NEWVAL=NEWVAL+LEFT*INCVAL
      INCVAL=-INCVAL
    7 IF(MINTST.GT.0)GO TO 8
      IF(NEWVAL.GE.MINMUM)GO TO 8
      IF(INCVAL.LE.0)GO TO 1
      LEFT=(MINMUM-NEWVAL-1)/INCVAL
      GO TO 9
    8 IF(MAXTST.LT.0)GO TO 10
      IF(NEWVAL.LE.MAXMUM)GO TO 10
      IF(INCVAL.GE.0)GO TO 1
      LEFT=(NEWVAL-MAXMUM-1)/(-INCVAL)
    9 IF(LEFT.GT.0)NEWVAL=NEWVAL+(LEFT*INCVAL)
      GO TO 2
   10 IF(MAXUSD.LT.MAXSTR)GO TO 15
      IF(MAXSTR.LT.MINSTR)GO TO 1
      GO TO(11,12,13,14),INCRES
   11 IF(NEWVAL.LE.ISTORE(MAXUSD))GO TO 1
      GO TO 15
   12 IF(NEWVAL.GE.ISTORE(MINSTR))GO TO 1
      GO TO 15
   13 IF(NEWVAL.LE.ISTORE(MINSTR))GO TO 1
      GO TO 15
   14 IF(NEWVAL.GE.ISTORE(MAXUSD))GO TO 1
C
C     TEST IF NEW VALUE IS ALREADY KNOWN
   15 MIDDLE=MINSTR-1
      IF(MAXUSD.LT.MINSTR)GO TO 22
      IUPPER=MAXUSD
   16 ILOWER=MIDDLE+1
      GO TO 18
   17 IUPPER=MIDDLE-1
   18 IHALF=(IUPPER-ILOWER)/2
      MIDDLE=IUPPER-IHALF
      IF(NEWVAL.EQ.ISTORE(MIDDLE))GO TO 31
      IF(JNCRES.GT.0)GO TO 19
      IF(NEWVAL.LT.ISTORE(MIDDLE))GO TO 21
      GO TO 20
   19 IF(NEWVAL.GT.ISTORE(MIDDLE))GO TO 21
   20 IF(IHALF.GT.0)GO TO 17
      IF(IUPPER.LE.ILOWER)GO TO 23
      IUPPER=ILOWER
      GO TO 18
   21 IF(IHALF.GT.0)GO TO 16
C
C     SHIFT REST OF ARRAY AND INSERT NEW VALUE
   22 MIDDLE=MIDDLE+1
   23 IF(MAXUSD.LT.MAXSTR)GO TO 25
      GO TO(24,28,28,24),INCRES
   24 IF(MIDDLE.GT.MAXSTR)GO TO 31
      GO TO 26
   25 MAXUSD=MAXUSD+1
   26 I=MAXUSD
   27 IF(I.LE.MIDDLE)GO TO 30
      ISTORE(I)=ISTORE(I-1)
      I=I-1
      GO TO 27
   28 IF(MIDDLE.LE.MINSTR)GO TO 31
      MIDDLE=MIDDLE-1
      I=MINSTR
   29 IF(I.GE.MIDDLE)GO TO 30
      ISTORE(I)=ISTORE(I+1)
      I=I+1
      GO TO 29
   30 ISTORE(MIDDLE)=NEWVAL
   31 IF(INCVAL.EQ.0)GO TO 1
      GO TO 2
   32 KIND=4
      LOWBFR=LOWBFR-1
      GO TO 34
   33 KIND=5
   34 RETURN
C689599426999
      END
      SUBROUTINE DANEXT(KONTRL,SLACK ,IBUFFR,MAXBFR,LOWBFR,
     1    MANY  ,KIND  ,NEWVAL,INCVAL,LMTVAL,VALNEW,VALINC,
     2    VALLMT)
C     RENBR(/RETURNS NEXT NUMBER IN SERIES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DANEXT RETURNS TO THE CALLING PROGRAM THE NEXT NUMBER
C     REPRESENTED BY THE CHARACTERS IN AN INPUT BUFFER READ
C     BY THE CALLING PROGRAM  WITH  A  MULTIPLE  OF  AN  A1
C     FORMAT.   IF A SERIES SPECIFICATION IS ENCOUNTERED IN
C     THE INPUT BUFFER, THEN THE INDIVIDUAL NUMBERS OF  THE
C     SERIES  ARE  RETURNED  BY  THE CALLS TO THIS ROUTINE.
C     WHEN ALL OF THE NUMBERS FORMING THE SERIES HAVE  BEEN
C     RETURNED,  THEN  THE  SUBSEQUENT  NUMBER OR SERIES OF
C     NUMBERS SPECIFIED BY THE CONTENTS OF THE  BUFFER  ARE
C     EVALUATED.
C
C     A SERIES EVALUATED BY THIS ROUTINE CAN BE WRITTEN  AS
C     A LOWER BOUND, INCREMENT AND UPPER BOUND SEPARATED BY
C     SLASHES.  IF THE INCREMENT IS TO  BE  ONE,  THEN  THE
C     LOWER  AND  UPPER  BOUNDS NEED BE SEPARATED ONLY BY A
C     SINGLE SLASH.  IF EITHER  BOUND  IS  MISSING,  IT  IS
C     ASSUMED  TO  BE  ZERO.   THE LOWER BOUND IS THE FIRST
C     NUMBER OF THE SERIES REPORTED TO THE CALLING PROGRAM.
C     THE  SERIES  CAN  THEN  EITHER  INCREASE  OR DECREASE
C     DEPENDING UPON WHETHER THE UPPER BOUND IS LESS  THAN,
C     EQUAL  TO, OR GREATER THAN THE LOWER BOUND.  THE SIGN
C     OF THE INCREMENT IS CHANGED IF IT DOES NOT CONFORM TO
C     THE RELATIVE VALUES OF THE BOUNDS.
C
C     IF THE SERIES IS TO CONSIST OF SEVERAL REPETITIONS OF
C     THE SAME VALUE, THEN THE SERIES IS INSTEAD WRITTEN AS
C     THE NUMBER OF TIMES THE VALUE IS TO BE USED  FOLLOWED
C     IMMEDIATELY BY AN ASTERISK AND THE VALUE ITSELF.  THE
C     VALUE TO BE REPEATED IS ASSUMED TO BE NULL IF  IT  IS
C     MISSING.
C
C     TWO VERSIONS OF THE ROUTINE ARE SUPPLIED.  DANEXT CAN
C     EVALUATE  REAL  NUMBERS AS WELL AS INTEGERS INCLUDING
C     E, K AND M NOTATIONS FOR SPECIFYING EITHER OF  THESE.
C     IF  THE  CALLING PROGRAM DOES NOT OTHERWISE REFERENCE
C     THE  FREE  FORMAT  INPUT  ROUTINE  DAREAD,   IF   THE
C     EVALUATION  OF  REAL  NUMBERS  IS  NOT NEEDED, AND IF
C     INTEGERS CAN BE SPECIFIED WITHOUT RESORTING TO THE E,
C     K  AND M NOTATIONS, THEN THE ROUTINE DAINXT SHOULD BE
C     USED INSTEAD OF DANEXT.  NUMBERS EVALUATED BY  DAINXT
C     MUST  CONSIST  ONLY  OF DIGITS FOLLOWING THE OPTIONAL
C     SIGN.  DAINXT TREATS THE CHARACTERS ., %, K AND M THE
C     SAME AS ANY OTHER DELIMITER CHARACTER.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY AND ARE
C     RETURNED UNCHANGED.
C
C     KONTRL = 1  OR  GREATER,  ITEM  IN  IBUFFR  ARRAY  IS
C              FLOATING  POINT.   IF POSSIBLE, THE FLOATING
C              POINT  NUMBER  WILL  BE  ACCUMULATED  AS  AN
C              INTEGER, THEN BE CONVERTED TO FLOATING POINT
C              AND SHIFTED IF NECESSARY.   KONTRL  IS  THEN
C              THE MAXIMUM NUMBER OF DIGITS IN THE INTEGER.
C              THE VALUE IS OUTPUT AS THE  ARGUMENT VALNEW.
C              IF  THE  ITEM  HAS  MORE THAN KONTRL DIGITS,
C              THEN  THE  ENTIRE  EVALUATION  IS  DONE   IN
C              FLOATING    POINT.     THE    ADVANTAGE   OF
C              CALCULATING THE  FLOATING  POINT  VALUES  IN
C              INTEGER  AS  LONG  AS  THE  PRECISION OF THE
C              COMPUTER  IS  NOT  OVERFLOWED  IS  THAT  THE
C              CALCULATION  OF  THE  PORTION  OF THE NUMBER
C              RIGHT OF THE DECIMAL POINT  IS  MORE  EXACT.
C              AS  AN EXAMPLE, IF KONTRL IS GREATER THAN OR
C              EQUAL TO 4, THEN THE  NUMBER  33.33  CAN  BE
C              STORED   AS   THE   INTEGER  3333,  THEN  BE
C              CONVERTED TO FLOATING POINT VALUE 3333.0 AND
C              DIVIDED   BY  100.0  TO  OBTAIN   THE  FINAL
C              ANSWER.  IF IT MAKES NO  DIFFERENCE  WHETHER
C              THE NUMBER TYPED AS 33.33 HAS VALUE 33.33 OR
C              33.32999...  THEN KONTRL CAN  BE  GIVEN  THE
C              VALUE 1.
C            = 0, ITEM IN IBUFFR ARRAY IS INTEGER  DECIMAL.
C              THE NUMBER CAN BE TYPED WITH A DECIMAL POINT
C              (FOR EXAMPLE 1.23K OR 1.23E3  EQUALS  1230),
C              BUT  IS  STORED AS AN INTEGER IN DAREAD, AND
C              IS OUTPUT  AS ARGUMENT NEWVAL.   ANY DECIMAL
C              INTEGER WHICH THE COMPUTER CAN REPRESENT CAN
C              BE  EVALUATED.    THIS  INCLUDES,   ON  TWOS
C              COMPLEMENT  COMPUTERS, THE  LARGEST NEGATIVE
C              NUMBER THE ABSOLUTE VALUE OF WHICH CANNOT BE
C              STORED.   ON THE  PDP10,  A 36 BIT  COMPUTER
C              WITH TWOS COMPLEMENT  NOTATION, THE RANGE OF
C              DECIMAL  INTEGERS  IS  -34359738368  THROUGH
C              34359738367  (OCTAL NOTATION OF BIT PATTERNS
C              BEING  400000000000  THROUGH  377777777777).
C            = -1, ITEM IN  IBUFFR  ARRAY  IS  OCTAL.   THE
C              NUMBER  CAN  BE  TYPED  WITH A DECIMAL POINT
C              AND/OR  WITH  AN  EXPONENT.   HOWEVER,   THE
C              NUMBER   FOLLOWING   THE  LETTER  E  OF  THE
C              EXPONENT IS EVALUATED IN DECIMAL.  THE VALUE
C              OF  THE  OCTAL  NUMBER  IS  RETURNED  AS THE
C              ARGUMENT  NEWVAL.   IT  MUST  BE NOTED  THAT
C              NUMBERS EVALUATED AS NEGATIVE OCTAL INTEGERS
C              HAVE THE  NEGATIVE  OCTAL  INTEGER  AS THEIR
C              VALUE,  NOT AS  THEIR BIT  REPRESENTATION IN
C              COMPUTER STORAGE.   FOR EXAMPLE, ON A 36 BIT
C              TWOS COMPLEMENT  COMPUTER,  THE OCTAL NUMBER
C              -400000000000 (WHICH COULD  ALSO BE TYPED AS
C              -4E11 OR -4E+11 WHERE  THE 11 AFTER THE E IS
C              IN DECIMAL)  IS REPRESENTED  AS BIT  PATTERN
C              HAVING OCTAL  NOTATION  400000000000 AND THE
C              OCTAL NUMBER -377777777777 IS REPRESENTED BY
C              THE BIT PATTERN 400000000001.
C     SLACK  = THE   FRACTION   OF   THE   INCREMENT,    IF
C              KONTRL.GT.0,  BY WHICH THE RETURNED VALUE OF
C              THE ARGUMENT  NAMED VALNEW  CAN  EXCEED  THE
C              UPPPER  BOUND  AND STILL BE CONSIDERED TO BE
C              WITHIN  THE  SERIES.   SLACK  IS   NECESSARY
C              BECAUSE  OF  THE IMPRECISION OF CALCULATIONS
C              INVOLVING REAL NUMBERS.  FOR EXAMPLE, IF THE
C              USER   WISHED   TO  HAVE  THE  INCREMENT  BE
C              0.666.... BETWEEN A LOWER BOUND OF  3.0  AND
C              AN   UPPER  BOUND  OF  5.0,  HE  MIGHT  TYPE
C              3/.667/5 AND EXPECT THAT THE NUMBERS  3.000,
C              3.667,  4.333,  AND  5.000 WOULD BE INCLUDED
C              WITHIN  THE  SERIES,  WHILE,  ACTUALLY,  THE
C              NUMBER  NEAR  5.00 WOULD BE CALCULATED TO BE
C              5.001 AND WOULD  THEREFORE  BE  OUTSIDE  THE
C              SERIES.   ALTHOUGH SLACK CAN BE SET TO ZERO,
C              A VALUE OF ABOUT 0.01  IS  RECOMMENDED.   IN
C              THE  ABOVE  EXAMPLE,  SLACK=0.01 WOULD CAUSE
C              THE ACTUAL UPPER BOUND TO BE 5.00667 SO THAT
C              THE  NUMBER  CALCULATED NEAR THE UPPER BOUND
C              WOULD BE INCLUDED WITHIN THE SERIES.   SLACK
C              SHOULD  ALMOST  CERTAINLY  NEVER  EXCEED 0.5
C              SINCE LARGER VALUES WOULD OFTEN LEAD TO  THE
C              INCLUSION  OF  VALUES NOT MEANT BY THE USER.
C              SLACK IS IGNORED IF KONTRL.LE.0.
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT,  WHICH IS TO BE SEARCHED  FOR SERIES
C              SPECIFICATIONS.   IBUFFR THEN  CONTAINS  ONE
C              CHARACTER PER COMPUTER STORAGE LOCATION.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C
C     FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C     LOWBFR = INPUT CONTAINING THE  SUBSCRIPT  WITHIN  THE
C              IBUFFR   ARRAY   OF   THE  FIRST  (LEFTMOST)
C              CHARACTER WHICH CAN BE SCANNED FOR A  SERIES
C              SPECIFICATION.  LOWBFR IS RETURNED UNCHANGED
C              IF  THIS  CALL  TO   THIS   ROUTINE   MERELY
C              GENERATES  THE NEXT MEMBER OF A SERIES BEGUN
C              BY  A  PREVIOUS  CALL.   IF  A  NEW   SERIES
C              SPECIFICATION  IS  EVALUATED BY THIS CALL TO
C              THIS ROUTINE, THEN LOWBFR WILL  BE  RETURNED
C              POINTING  TO  THE  NEXT CHARACTER BEYOND THE
C              SERIES SPECIFICATION.  IF  A  SECOND  NUMBER
C              IMMEDIATELY   FOLLOWS   A  FIRST  WITHOUT  A
C              SEPARATING SLASH OR  ASTERISK,  THEN  LOWBFR
C              WILL  BE  RETURNED  POINTING  TO  THE  FIRST
C              CHARACTER OF THE SECOND NUMBER.  IF EITHER A
C              SPACE  OR  A  TAB CHARACTER FOLLOWS A SERIES
C              SPECIFICATION, THEN LOWBFR WILL BE  RETURNED
C              POINTING  TO THE SPACE OR TAB CHARACTER.  IF
C              THERE IS NOTHING AT OR TO RIGHT  OF  LOWBFR,
C              THEN   LOWBFR   WILL  BE  LEFT  POINTING  AT
C              MAXBFR+1   AND   KIND   WILL   BE   RETURNED
C              CONTAINING ONE.  LOWBFR AND MANY MUST BE SET
C              BY THE CALLING PROGRAM  BEFORE  ANYTHING  IS
C              PROCESSED  IN  THE  CURRENT  CONTENTS OF THE
C              IBUFFR  ARRAY,  BUT  THEN  SHOULD   NOT   BE
C              MODIFIED  BY  THE  CALLING PROGRAM UNTIL THE
C              ENTIRE CONTENTS OF THE IBUFFR ARRAY HAS BEEN
C              PROCESSED.
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF A NEW LOGICAL SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE  WHEN BEGINNING PROCESSING OF A LINE
C              OF TEXT NOT TIED TO THE PREVIOUS LINE BY  AN
C              AMPERSAND  AT  THE END OF THE PREVIOUS LINE,
C              OR WHEN PROCESSING THE TEXT TO THE RIGHT  OF
C              A  SEMICOLON.   MANY IS RETURNED SET TO ZERO
C              WHENEVER AN  END OF LINE  (KIND=1)  IS FOUND
C              WHICH IS NOT  TIED TO THE  FOLLOWING LINE BY
C              AN AMPERSAND,  AND  WHENEVER  A SEMICOLON IS
C              FOUND (KIND=2). MANY IS RETURNED INCREMENTED
C              BY 1 EACH TIME A NEW SPECIFICATION OF EITHER
C              A  SINGLE  NUMBER  OR  OF A SERIES IS FOUND,
C              EACH TIME AN ERRONEOUS SERIES  SPECIFICATION
C              IS  FOUND,  OR  EACH TIME AN INDICATION OF A
C              MISSING SERIES SPECIFICATION IS FOUND.  MANY
C              IS  RETURNED  UNCHANGED IF THIS CALL TO THIS
C              ROUTINE MERELY GENERATES THE NEXT MEMBER  OF
C              A SERIES ALREADY BEGUN BY A PREVIOUS CALL TO
C              THIS ROUTINE.  KIND IS  RETURNED  CONTAINING
C              THE  VALUE 3 AND MANY IS RETURNED CONTAINING
C              THE NEGATIVE OF THE NUMBER OF ITEMS FOUND IF
C              THE  NEXT  PRINTING  CHARACTER  FOLLOWING  A
C              COMMA IS AN AMPERSAND.  MANY SHOULD  NOT  BE
C              CHANGED   BY   THE  CALLING  PROGRAM  IF  AN
C              AMPERSAND (KIND BEING RETURNED=3)  IS  FOUND
C              INDICATING  THAT THE SUBSEQUENT CALL TO THIS
C              ROUTINE IS TO PROCESS TEXT WHICH  IS  TO  BE
C              TREATED  AS  THOUGH  IT APPEARED IN PLACE OF
C              THE AMPERSAND  AND  THE  CHARACTERS  TO  ITS
C              RIGHT.   THE EFFECT IS NOT QUITE THE SAME AS
C              IF THE USER HAD TYPED ALL OF THE TEXT  ON  A
C              SINGLE    LINE   SINCE   A   SINGLE   SERIES
C              SPECIFICATION CANNOT  BE  SPLIT  ACROSS  THE
C              LINE BOUNDARY.
C
C              IF MANY IS INPUT CONTAINING  ZERO,  THEN  AN
C              INITIAL  COMMA  IN  THE INPUT TEXT BUFFER IS
C              TAKEN TO INDICATE AN INITIAL  MISSING  ITEM,
C              AND  MANY IS THEN RETURNED CONTAINING 1.  IF
C              MANY IS INPUT GREATER  THAN  ZERO,  THEN  AN
C              INITIAL  COMMA  IS  IGNORED IF FOLLOWED BY A
C              SERIES  SPECIFICATION.   IF  MANY  IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C              A  SEMICOLON,  OR  BY  AN  EXCLAMATION POINT
C              INDICATES A MISSING ITEM.  IF MANY IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY  AN  AMPERSAND  WILL  CAUSE  THE
C              REMAINING  CHARACTERS  IN  THE  BUFFER TO BE
C              IGNORED,   AND   MANY   WILL   BE   RETURNED
C              CONTAINING  THE NEGATIVE OF ITS INPUT VALUE.
C              IF  MANY  IS  INPUT  NEGATIVE,  THEN  IT  IS
C              ASSUMED  THAT  THE  CONTENTS  OF THE CURRENT
C              BUFFER  CONTINUE  A  PREVIOUS   LINE   WHICH
C              TERMINATED  WITH  A  COMMA  FOLLOWED  BY  AN
C              AMPERSAND, AND MANY IS RETURNED GREATER THAN
C              ZERO.
C     KIND   = SHOULD BE  INPUT  CONTAINING  ZERO THE FIRST
C              TIME THIS  ROUTINE IS CALLED,  OR TO ABANDON
C              GENERATATION  OF VALUES WITHIN  A PARTICULAR
C              SERIES.   KIND  IS  RETURNED  DESCRIBING THE
C              KIND OF ITEM LOCATED IN THE IBUFFR ARRAY.
C            = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C              BY A LEADING EXCLAMATION POINT, WAS FOUND AT
C              OR TO RIGHT OF LOWBFR.   THE CALLING PROGRAM
C              SHOULD READ A NEW LINE INTO IBUFFR.  MANY IS
C              RETURNED SET TO ZERO.
C            = 2,  A  SEMICOLON  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.  LOWBFR IS RETURNED POINTING TO  THE
C              NEXT  CHARACTER  BEYOND  THE LOCATION OF THE
C              SEMICOLON.   IT  IS  ASSUMED   THE   CALLING
C              PROGRAM  WILL  TREAT  THE  APPEARANCE OF THE
C              SEMICOLON AS MARKING THE END OF A STATEMENT.
C              MANY IS RETURNED SET TO ZERO.
C            = 3, AN  AMPERSAND  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.   THE  TEXT  TO  THE  RIGHT  OF  THE
C              AMPERSAND IS TAKEN AS A COMMENT SO LOWBFR IS
C              RETURNED POINTING BEYOND THE  RIGHT  END  OF
C              THE  BUFFER.  IT IS ASSUMED THAT THE CALLING
C              PROGRAM WILL READ IN THE CONTENTS OF  A  NEW
C              BUFFER,  THEN  AGAIN  REQUEST  A  NEW SERIES
C              EVALUATION FROM THIS ROUTINE.   THE VALUE OF
C              MANY MUST NOT BE CHANGED BY  CALLING PROGRAM
C              PRIOR TO THIS FOLLOWING CALL.  THE EFFECT IS
C              NOT  QUITE THE SAME AS IF THE USER HAD TYPED
C              ALL OF THE TEXT ON A  SINGLE  LINE  SINCE  A
C              SERIES  SPECIFICATION CANNOT BE SPLIT ACROSS
C              A LINE BOUNDARY.
C            = 4, A NUMBER OR SERIES SPECIFICATION WAS  NOT
C              FOUND,  BUT  A COMMA  WAS  FOUND  INDICATING
C              A  MISSING  SERIES  SPECIFICATION.    EITHER
C              NEWVAL OR VALNEW IS RETURNED  CONTAINING THE
C              VALUE  ZERO  SO  KIND=4  CAN  BE  CONSIDERED
C              EQUIVALENT TO KIND=5  IF SUCH IS APPROPRIATE
C              TO THE APPLICATION FOR WHICH THIS ROUTINE IS
C              BEING USED.
C            = 5, THE NEXT NUMBER SPECIFIED BY THE CONTENTS
C              OF THE INPUT BUFFER IS BEING RETURNED AS THE
C              VALUE  OF  THE  ARGUMENT  NEWVAL OR  VALNEW.
C            = 6,  A  SERIES  WAS   SPECIFIED  IN  ASTERISK
C              NOTATION, BUT NO NUMBER APPEARED TO RIGHT OF
C              THE ASTERISK. VALNEW OR NEWVAL, WHICHEVER IS
C              APPROPRIATE,  IS  RETURNED WITH  VALUE ZERO.
C              NOTE THAT  IF A NUMBER DOES  NOT PRECEDE THE
C              ASTERISK,  THEN  KIND IS  RETURNED  WITH THE
C              VALUE 7 WHETHER OR  NOT A NUMBER FOLLOWS THE
C              ASTERISK.
C            = 7,  A  SERIES  WAS  SPECIFIED  IN   ASTERISK
C              NOTATION, BUT NO NUMBER APPEARED TO THE LEFT
C              OF THE ASTERISK OR THE NUMBER TO LEFT OF THE
C              ASTERISK WAS LESS  THAN 1  (OR LESS THAN 0.5
C              IF EVALUATED AS A REAL NUMBER AS THIS NUMBER
C              IS ROUNDED WHEN USED).   A NUMBER MAY OR MAY
C              NOT HAVE APPEARED TO RIGHT OF THE ASTERISK.
C            = 8, A SERIES SPECIFICATION  WAS  FOUND  WHICH
C              CONTAINED   TOO   MANY   NUMBERS,  TOO  MANY
C              ASTERISKS OR TOO  MANY  SLASHES.
C            = 9, FIRST PRINTING CHARACTER IN OR  TO  RIGHT
C              OF  LOWBFR  WAS  NOT A CHARACTER WHICH COULD
C              APPEAR IN A NUMBER OR NUMBER RANGE, AND  WAS
C              NOT A COMMA, SEMICOLON OR EXCLAMATION POINT.
C              LOWBFR  IS  RETURNED  POINTING  TO  THE NEXT
C              CHARACTER BEYOND THIS CHARACTER.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT
C
C     NEWVAL = RETURNED CONTAINING NEW VALUE IF KONTRL.LE.0
C              AND KIND RETURNED =5.
C     VALNEW = RETURNED CONTAINING NEW VALUE IF KONTRL.GT.0
C              AND KIND RETURNED =5.
C
C     INCVAL, LMTVAL, VALINC AND  VALLMT  MUST BE PRESERVED
C     FROM ONE CALL TO NEXT BUT NOT USED BY CALLING PROGRAM
C
      DIMENSION IBUFFR(MAXBFR)
C
      IF(KIND.EQ.6)GO TO 4
      IF(KIND.NE.5)GO TO 6
      IF(INCVAL.EQ.0)GO TO 4
C
C     GET NEXT NUMBER EXPRESSED IN SLASH NOTATION
      IF(KONTRL.GT.0)GO TO 2
      NEWVAL=NEWVAL+INCVAL
      IF(INCVAL.GT.0)GO TO 1
      IF(NEWVAL.GE.LMTVAL)GO TO 22
      GO TO 6
    1 IF(NEWVAL.LE.LMTVAL)GO TO 22
      GO TO 6
    2 VALOLD=VALNEW
      VALNEW=VALNEW+VALINC
      IF(VALINC.GT.0.0)GO TO 3
      IF(VALNEW.GE.VALOLD)GO TO 6
      IF(VALNEW.GE.(VALLMT+(SLACK*VALINC)))GO TO 22
      GO TO 6
    3 IF(VALNEW.LE.VALOLD)GO TO 6
      IF(VALNEW.LE.(VALLMT+(SLACK*VALINC)))GO TO 22
      GO TO 6
C
C     GET NEXT NUMBER EXPRESSED IN ASTERISK NOTATION
    4 IF(KONTRL.GT.0)GO TO 5
      LMTVAL=LMTVAL-1
      IF(LMTVAL.GT.0)GO TO 22
      GO TO 6
    5 VALLMT=VALLMT-1.0
      IF(VALLMT.GT.0.5)GO TO 22
C
C     GET NEW RANGE SPECIFICATION
    6 CALL DASPAN(KONTRL,-1,IBUFFR,MAXBFR,LOWBFR,
     1MANY,KIND,INIGOT,INCGOT,LMTGOT,NEWVAL,INCVAL,
     2LMTVAL,VALNEW,VALINC,VALLMT)
      GO TO(9,9,9,9,7,7,13,19,8,8),KIND
C
C     SINGLE NUMBER WITHOUT SLASH OR ASTERISK
    7 IF(KONTRL.GT.0)GO TO 12
      GO TO 10
    8 KIND=KIND-1
    9 IF(KONTRL.GT.0)GO TO 11
      NEWVAL=0
   10 LMTVAL=0
      GO TO 21
   11 VALNEW=0.0
   12 VALINC=0.0
      VALLMT=0.0
      GO TO 21
C
C     SERIES CONTAINING SLASH
   13 KIND=5
      IF(KONTRL.GT.0)GO TO 16
      IF(INIGOT.LE.0)NEWVAL=0
      IF(INCGOT.LE.0)INCVAL=1
      IF(INCVAL.EQ.0)INCVAL=1
      IF(LMTGOT.LE.0)LMTVAL=0
      IF(NEWVAL.GT.LMTVAL)GO TO 14
      IF(INCVAL.GT.0)GO TO 22
      GO TO 15
   14 IF(INCVAL.LT.0)GO TO 22
   15 INCVAL=-INCVAL
      GO TO 22
   16 INCVAL=1
      IF(INIGOT.LE.0)VALNEW=0.0
      IF(INCGOT.LE.0)VALINC=1.0
      IF(VALINC.EQ.0)VALINC=1.0
      IF(LMTGOT.LE.0)VALLMT=0.0
      IF(VALNEW.GT.VALLMT)GO TO 17
      IF(VALINC.GT.0)GO TO 22
      GO TO 18
   17 IF(VALINC.LT.0)GO TO 22
   18 VALINC=-VALINC
      GO TO 22
C
C     SERIES CONTAINING ASTERISK
   19 KIND=5
      IF(LMTGOT.LE.0)KIND=6
      IF(KONTRL.GT.0)GO TO 20
      IF(INIGOT.LE.0)NEWVAL=0
      IF(LMTGOT.LE.0)LMTVAL=0
      IF(NEWVAL.LE.0)KIND=7
      INCVAL=NEWVAL
      NEWVAL=LMTVAL
      LMTVAL=INCVAL
      GO TO 21
   20 IF(INIGOT.LE.0)VALNEW=0.0
      IF(LMTGOT.LE.0)VALLMT=0.0
      IF(VALNEW.LE.0.5)KIND=7
      VALINC=VALNEW
      VALNEW=VALLMT
      VALLMT=VALINC
      VALINC=0.0
   21 INCVAL=0
C
C     RETURN TO CALLING PROGRAM
   22 RETURN
C602332267874
      END
      SUBROUTINE DASPAN(KONTRL,KONECT,IBUFFR,MAXBFR,LOWBFR,
     1    MANY  ,KIND  ,INIGOT,INCGOT,LMTGOT,INIVAL,INCVAL,
     2    LMTVAL,VALINI,VALINC,VALLMT)
C     RENBR(/INTERPRETS FREE FORMAT RANGE SPECIFICATIONS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DASPAN EVALUATES RANGE SPECIFICATIONS  TYPED  BY  THE
C     USER  AND READ BY THE CALLING PROGRAM WITH A MULTIPLE
C     OF AN  A1  FORMAT.   SUCH  RANGE  SPECIFICATIONS  CAN
C     CONSIST OF A SINGLE NUMBER, OR OF 2 NUMBERS SEPARATED
C     BY AN ASTERISK, OR OF EITHER 2 OR 3 NUMBERS SEPARATED
C     BY SLASHES OR BY COLONS WHICH ARE TAKEN AS EQUIVALENT
C     TO SLASHES.    THE  ASTERISK  NOTATION  IS  MEANT  TO
C     INDICATE THAT THE VALUE TO THE RIGHT OF THE  ASTERISK
C     IS  TO  BE  REPEATED THE NUMBER OF TIMES INDICATED BY
C     THE NUMBER TO THE  LEFT  OF  THE  ASTERISK.   NUMBERS
C     SPECIFIED IN THE SLASH NOTATION CAN BE INTERPRETED AS
C     THE LOWER AND UPPER BOUNDS OF A RANGE  IF  2  NUMBERS
C     ARE  PRESENT,  OR  AS THE LOWER BOUND, THE INCREMENT,
C     AND THE UPPER BOUND, IF 3 NUMBERS ARE INCLUDED.
C
C     DASPAN REPORTS TO THE  CALLING  PROGRAM  WHETHER  THE
C     NUMBERS  ARE  PRESENT IN THE SERIES SPECIFICATION, AS
C     WELL  AS  THE  VALUES  OF  THOSE  NUMBERS  WHICH  ARE
C     PRESENT.   THE  CALLING  PROGRAM  WILL HAVE TO ASSIGN
C     DEFAULT VALUES FOR ANY  NUMBERS  WHICH  ARE  MISSING.
C     THE  RANGE  SPECIFICATION  /2/10  INDICATES  THAT THE
C     RANGE IS TO EXTEND FROM THE DEFAULT LOWER BOUND  WITH
C     AN  INCRMENT  OF  2  THROUGH  THE  UPPER BOUND OF 10.
C     EITHER RANGE SPECIFICATION 1/10 OR 1//10 IS TAKEN  TO
C     MEAN  THAT  THE  RANGE IS TO EXTEND FROM 1 THROUGH 10
C     WITH THE DEFAULT INCREMENT.  IF THE  NUMBERS  SPECIFY
C     THE VALUES OF A SUBSCRIPT OF AN ARRAY, THEN A MISSING
C     LOWER BOUND MIGHT  BE  TAKEN  TO  INDICATE  THAT  THE
C     SUBSCRIPT BEING VARIED STARTS AT ITS MINIMUM POSSIBLE
C     VALUE (USUALLY 1), WHILE A MISSING UPPER BOUND  MIGHT
C     INDICATE  THAT  THE  SUBSCRIPT IS TO TERMINATE AT ITS
C     MAXIMUM POSSIBLE VALUE.
C
C     TWO VERSIONS OF THE ROUTINE ARE SUPPLIED.  DASPAN CAN
C     EVALUATE  REAL  NUMBERS AS WELL AS INTEGERS INCLUDING
C     E, K AND M NOTATIONS FOR SPECIFYING EITHER OF  THESE.
C     IF  THE  CALLING PROGRAM DOES NOT OTHERWISE REFERENCE
C     THE  FREE  FORMAT  INPUT  ROUTINE  DAHEFT,   IF   THE
C     EVALUATION  OF  REAL  NUMBERS  IS  NOT NEEDED, AND IF
C     INTEGERS CAN BE SPECIFIED WITHOUT RESORTING TO THE E,
C     K  AND M NOTATIONS, THEN THE ROUTINE DAISPN SHOULD BE
C     USED INSTEAD OF DASPAN.  NUMBERS EVALUATED BY  DAISPN
C     MUST  CONSIST  ONLY  OF DIGITS FOLLOWING THE OPTIONAL
C     SIGN.  DAISPN TREATS THE CHARACTERS ., %, K AND M THE
C     SAME AS ANY OTHER DELIMITER CHARACTER.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY AND ARE
C     RETURNED UNCHANGED.
C
C     KONTRL = 1  OR  GREATER,  ITEM  IN  IBUFFR  ARRAY  IS
C              FLOATING  POINT.   IF POSSIBLE, THE FLOATING
C              POINT  NUMBER  WILL  BE  ACCUMULATED  AS  AN
C              INTEGER, THEN BE CONVERTED TO FLOATING POINT
C              AND SHIFTED IF NECESSARY.   KONTRL  IS  THEN
C              THE MAXIMUM NUMBER OF DIGITS IN THE INTEGER.
C              THE VALUE IS OUTPUT AS THE  ARGUMENT  VALUE.
C              IF  THE  ITEM  HAS  MORE THAN KONTRL DIGITS,
C              THEN  THE  ENTIRE  EVALUATION  IS  DONE   IN
C              FLOATING    POINT.     THE    ADVANTAGE   OF
C              CALCULATING THE  FLOATING  POINT  VALUES  IN
C              INTEGER  AS  LONG  AS  THE  PRECISION OF THE
C              COMPUTER  IS  NOT  OVERFLOWED  IS  THAT  THE
C              CALCULATION  OF  THE  PORTION  OF THE NUMBER
C              RIGHT OF THE DECIMAL POINT  IS  MORE  EXACT.
C              AS  AN EXAMPLE, IF KONTRL IS GREATER THAN OR
C              EQUAL TO 4, THEN THE  NUMBER  33.33  CAN  BE
C              STORED   AS   THE   INTEGER  3333,  THEN  BE
C              CONVERTED TO FLOATING POINT VALUE 3333.0 AND
C              DIVIDED   BY  100.0  TO  OBTAIN   THE  FINAL
C              ANSWER.  IF IT MAKES NO  DIFFERENCE  WHETHER
C              THE NUMBER TYPED AS 33.33 HAS VALUE 33.33 OR
C              33.32999...  THEN KONTRL CAN  BE  GIVEN  THE
C              VALUE 1.
C            = 0, ITEM IN IBUFFR ARRAY IS INTEGER  DECIMAL.
C              THE NUMBER CAN BE TYPED WITH A DECIMAL POINT
C              (FOR EXAMPLE 1.23K OR 1.23E3  EQUALS  1230),
C              BUT  IS  STORED AS AN INTEGER IN DAHEFT, AND
C              IS OUTPUT  AS ARGUMENT IVALUE.   ANY DECIMAL
C              INTEGER WHICH THE COMPUTER CAN REPRESENT CAN
C              BE  EVALUATED.    THIS  INCLUDES,   ON  TWOS
C              COMPLEMENT  COMPUTERS, THE  LARGEST NEGATIVE
C              NUMBER THE ABSOLUTE VALUE OF WHICH CANNOT BE
C              STORED.   ON THE  PDP10,  A 36 BIT  COMPUTER
C              WITH TWOS COMPLEMENT  NOTATION, THE RANGE OF
C              DECIMAL  INTEGERS  IS  -34359738368  THROUGH
C              34359738367  (OCTAL NOTATION OF BIT PATTERNS
C              BEING  400000000000  THROUGH  377777777777).
C            = -1, ITEM IN  IBUFFR  ARRAY  IS  OCTAL.   THE
C              NUMBER  CAN  BE  TYPED  WITH A DECIMAL POINT
C              AND/OR  WITH  AN  EXPONENT.   HOWEVER,   THE
C              NUMBER   FOLLOWING   THE  LETTER  E  OF  THE
C              EXPONENT IS EVALUATED IN DECIMAL.  THE VALUE
C              OF  THE  OCTAL  NUMBER  IS  RETURNED  AS THE
C              ARGUMENT  IVALUE.   IT  MUST  BE NOTED  THAT
C              NUMBERS EVALUATED AS NEGATIVE OCTAL INTEGERS
C              HAVE THE  NEGATIVE  OCTAL  INTEGER  AS THEIR
C              VALUE,  NOT AS  THEIR BIT  REPRESENTATION IN
C              COMPUTER STORAGE.   FOR EXAMPLE, ON A 36 BIT
C              TWOS COMPLEMENT  COMPUTER,  THE OCTAL NUMBER
C              -400000000000 (WHICH COULD  ALSO BE TYPED AS
C              -4E11 OR -4E+11 WHERE  THE 11 AFTER THE E IS
C              IN DECIMAL)  IS REPRESENTED  AS BIT  PATTERN
C              HAVING OCTAL  NOTATION  400000000000 AND THE
C              OCTAL NUMBER -377777777777 IS REPRESENTED BY
C              THE BIT PATTERN 400000000001.
C     KONECT = -1, ONCE A SLASH, AN ASTERISK OR A NUMBER IS
C              FOUND   IN  THE  IBUFFR  ARRAY,  THE  SERIES
C              SPECIFICATION WILL EXTEND TO THE NEXT  SPACE
C              OR  TAB CHARACTER, OR TO ANY CHARACTER OTHER
C              THAN A SLASH OR AN ASTERISK WHICH IMMEDITELY
C              FOLLOWS    A    NUMBER    IN    THE   SERIES
C              SPECIFICATION.  IF KONECT=-1,  THEN THE TEXT
C                   1/2+3/4 5/6+7/+8
C              WOULD CONTAIN THE RANGE SPECIFICATIONS 1  TO
C              2, 3 TO 4, 5 TO 6, AND 7 TO 8.
C            = 0, SPACES CAN APPEAR  BETWEEN THE NUMBERS OF
C              A SERIES IN ADDITION TO SLASHES OR ASTERISK.
C              THE SLASHES  OR THE  ASTERISK ARE,  HOWEVER,
C              REQUIRED.
C            = 1, SPACES AND/OR TAB  CHARACTERS CAN  APPEAR
C              BETWEEN  THE NUMBERS OF A SERIES IN ADDITION
C              TO OR IN PLACE OF SLASHES OR ASTERISKS.   IF
C              KONECT=1, THEN THE TEXT
C                   1 2 3,4/5 6,7 8/9,10 / 11 12
C              IS EXACTLY EQUIVALENT, EXCEPT FOR THE  VALUE
C              OF  KIND  RETURNED  FOR THE FIRST SERIES, TO
C              THE TEXT
C                   1/2/3,4/5/6,7/8/9,10/11/12
C              THE FIRST  SERIES  (1  2  3)  IN  THE  FIRST
C              EXAMPLE  WOULD  RETURN  KIND=6  INDICATING A
C              SERIES IN  WHICH  NEITHER  A  SLASH  NOR  AN
C              ASTERISK  APPEARED,  WHILE THE CORRESPONDING
C              SERIES SPECIFICATION IN THE  SECOND  EXAMPLE
C              WOULD RETURN KIND=7 INDICATING THAT AT LEAST
C              1  SLASH  WAS  ENCOUNTERED  IN  THE   SERIES
C              SPECIFICATION.
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT,  WHICH IS TO BE SEARCHED  FOR SERIES
C              SPECIFICATIONS.   IBUFFR THEN  CONTAINS  ONE
C              CHARACTER PER COMPUTER STORAGE LOCATION.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C
C     FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C     LOWBFR = INPUT CONTAINING THE  SUBSCRIPT  WITHIN  THE
C              IBUFFR   ARRAY   OF   THE  FIRST  (LEFTMOST)
C              CHARACTER WHICH CAN BE SCANNED FOR A  SERIES
C              SPECIFICATION.    LOWBFR  WILL  BE  RETURNED
C              POINTING TO THE NEXT  CHARACTER  BEYOND  THE
C              SERIES  SPECIFICATION.   IF  KONECT IS .LE.0
C              FORCING A SERIES  SPECIFICATION  TO  CONTAIN
C              EITHER  A  SLASH  OR AN ASTERISK BETWEEN THE
C              NUMBERS OF A SERIES, AND IF A SECOND  NUMBER
C              IMMEDIATELY   FOLLOWS   A  FIRST  WITHOUT  A
C              SEPARATING SLASH OR  ASTERISK,  THEN  LOWBFR
C              WILL  BE  RETURNED  POINTING  TO  THE  FIRST
C              CHARACTER OF THE SECOND NUMBER.   IF  KONECT
C              IS  -1  AND IF  EITHER  A  SPACE  OR  A  TAB
C              CHARACTER FOLLOWS  A  SERIES  SPECIFICATION,
C              THEN LOWBFR WILL BE RETURNED POINTING TO THE
C              SPACE OR TAB CHARACTER.  IF KONECT IS .GE.0,
C              ALLOWING SPACES AND TAB CHARACTERS TO APPEAR
C              WITHIN A SERIES SPECIFICATION,  THEN  LOWBFR
C              WILL  BE  RETURNED  POINTING  TO  THE  FIRST
C              CHARACTER TO THE RIGHT  OF  THE  SERIES  AND
C              WHICH IS NOT ITSELF A SPACE, A TAB CHRACTER,
C              A SLASH OR  AN  ASTERISK  AND  WHICH  CANNOT
C              APPEAR WITHIN A NUMBER.  IF THERE IS NOTHING
C              AT OR TO RIGHT OF LOWBFR, THEN  LOWBFR  WILL
C              BE  LEFT  POINTING AT MAXBFR+1 AND KIND WILL
C              BE RETURNED CONTAINING ONE.  LOWBFR AND MANY
C              MUST  BE  SET  BY THE CALLING PROGRAM BEFORE
C              ANYTHING  IS  PROCESSED   IN   THE   CURRENT
C              CONTENTS  OF  THE  IBUFFR  ARRAY,  BUT  THEN
C              SHOULD  NOT  BE  MODIFIED  BY  THE   CALLING
C              PROGRAM  UNTIL  THE  ENTIRE  CONTENTS OF THE
C              IBUFFR ARRAY HAS BEEN PROCESSED.
C     MANY   = SHOULD BE INPUT CONTAINING  ZERO  EACH  TIME
C              THIS  ROUTINE  IS CALLED TO BEGIN PROCESSING
C              OF A NEW LOGICAL SECTION  OF  TEXT,  AS  FOR
C              EXAMPLE  WHEN BEGINNING PROCESSING OF A LINE
C              OF TEXT NOT TIED TO THE PREVIOUS LINE BY  AN
C              AMPERSAND  AT  THE END OF THE PREVIOUS LINE,
C              OR WHEN PROCESSING THE TEXT TO THE RIGHT  OF
C              A  SEMICOLON.   MANY IS RETURNED SET TO ZERO
C              WHENEVER AN  END OF LINE  (KIND=1)  IS FOUND
C              WHICH IS NOT  TIED TO THE  FOLLOWING LINE BY
C              AN AMPERSAND,  AND  WHENEVER  A SEMICOLON IS
C              FOUND (KIND=2). MANY IS RETURNED INCREMENTED
C              BY 1 EACH TIME A  DESCRIPTION  OF  A  SERIES
C              SPECIFICATION  IS  RETURNED BY THIS ROUTINE,
C              EACH TIME AN ERRONEOUS SERIES  SPECIFICATION
C              IS  FOUND,  OR  EACH TIME AN INDICATION OF A
C              MISSING SERIES SPECIFICATION IS FOUND.  KIND
C              IS  RETURNED CONTAINING THE VALUE 3 AND MANY
C              IS RETURNED CONTAINING THE NEGATIVE  OF  THE
C              NUMBER  OF  ITEMS FOUND IF THE NEXT PRINTING
C              CHARACTER FOLLOWING A COMMA IS AN AMPERSAND.
C              MANY  SHOULD  NOT  BE CHANGED BY THE CALLING
C              PROGRAM  IF   AN   AMPERSAND   (KIND   BEING
C              RETURNED=3)  IS  FOUND  INDICATING  THAT THE
C              SUBSEQUENT  CALL  TO  THIS  ROUTINE  IS   TO
C              PROCESS  TEXT  WHICH  IS  TO  BE  TREATED AS
C              THOUGH IT APPEARED IN PLACE OF THE AMPERSAND
C              AND THE CHARACTERS TO ITS RIGHT.  THE EFFECT
C              IS NOT QUITE THE SAME AS  IF  THE  USER  HAD
C              TYPED ALL OF THE TEXT ON A SINGLE LINE SINCE
C              A  SINGLE  SERIES  SPECIFICATION  CANNOT  BE
C              SPLIT ACROSS THE LINE BOUNDARY.
C
C              IF MANY IS INPUT CONTAINING  ZERO,  THEN  AN
C              INITIAL  COMMA  IN  THE INPUT TEXT BUFFER IS
C              TAKEN TO INDICATE AN INITIAL  MISSING  ITEM,
C              AND  MANY IS THEN RETURNED CONTAINING 1.  IF
C              MANY IS INPUT GREATER  THAN  ZERO,  THEN  AN
C              INITIAL  COMMA  IS  IGNORED IF FOLLOWED BY A
C              SERIES  SPECIFICATION.   IF  MANY  IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C              A  SEMICOLON,  OR  BY  AN  EXCLAMATION POINT
C              INDICATES A MISSING ITEM.  IF MANY IS  INPUT
C              GREATER  THAN  ZERO,  THEN  AN INITIAL COMMA
C              FOLLOWED BY  AN  AMPERSAND  WILL  CAUSE  THE
C              REMAINING  CHARACTERS  IN  THE  BUFFER TO BE
C              IGNORED,   AND   MANY   WILL   BE   RETURNED
C              CONTAINING  THE NEGATIVE OF ITS INPUT VALUE.
C              IF  MANY  IS  INPUT  NEGATIVE,  THEN  IT  IS
C              ASSUMED  THAT  THE  CONTENTS  OF THE CURRENT
C              BUFFER  CONTINUE  A  PREVIOUS   LINE   WHICH
C              TERMINATED  WITH  A  COMMA  FOLLOWED  BY  AN
C              AMPERSAND, AND MANY IS RETURNED GREATER THAN
C              ZERO.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT
C
C     KIND   = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C              IN THE IBUFFR ARRAY.
C            = 1, EITHER NO PRINTING  CHARACTERS OR ELSE AN
C              EXCLAMATION  POINT  AS  THE  FIRST  PRINTING
C              CHARACTER (MARKING THE REST OF THE LINE AS A
C              COMMENT)  WAS FOUND  AT OR TO THE  RIGHT  OF
C              LOWBFR.   THE  CALLING PROGRAM SHOULD READ A
C              NEW LINE INTO IBUFFR.   MANY, INIGOT, INCGOT
C              AND LMTGOT ARE ALL RETURNED WITH VALUE ZERO.
C            = 2,  A  SEMICOLON  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.  LOWBFR IS RETURNED POINTING TO  THE
C              NEXT  CHARACTER  BEYOND  THE LOCATION OF THE
C              SEMICOLON.   IT  IS  ASSUMED   THE   CALLING
C              PROGRAM  WILL  TREAT  THE  APPEARANCE OF THE
C              SEMICOLON AS MARKING THE END OF A STATEMENT.
C              MANY IS RETURNED WITH THE VALUE ZERO.
C            = 3, AN  AMPERSAND  WAS  FOUND  AS  THE  FIRST
C              PRINTING  CHARACTER  AT  OR  TO THE RIGHT OF
C              LOWBFR.   THE  TEXT  TO  THE  RIGHT  OF  THE
C              AMPERSAND IS TAKEN AS A COMMENT SO LOWBFR IS
C              RETURNED POINTING BEYOND THE  RIGHT  END  OF
C              THE  BUFFER.  IT IS ASSUMED THAT THE CALLING
C              PROGRAM WILL READ IN THE CONTENTS OF  A  NEW
C              BUFFER,  THEN  AGAIN  REQUEST  A  NEW SERIES
C              EVALUATION FROM THIS ROUTINE.   THE VALUE OF
C              MANY MUST NOT BE CHANGED BY  CALLING PROGRAM
C              PRIOR TO THIS FOLLOWING CALL.  THE EFFECT IS
C              NOT  QUITE THE SAME AS IF THE USER HAD TYPED
C              ALL OF THE TEXT ON A  SINGLE  LINE  SINCE  A
C              SERIES  SPECIFICATION CANNOT BE SPLIT ACROSS
C              A LINE BOUNDARY.
C            = 4, A NUMBER OR SERIES SPECIFICATION WAS  NOT
C              FOUND BUT INITIAL COMMA WAS FOUND INDICATING
C              A  MISSING  SERIES  SPECIFICATION.   INIGOT,
C              INCGOT AND LMTGOT ARE EACH RETURNED WITH THE
C              VALUE  ZERO  SO  KIND=4  CAN  BE  CONSIDERED
C              EQUIVALENT  TO KIND=5 IF SUCH IS APPROPRIATE
C              TO THE APPLICATION FOR WHICH THIS ROUTINE IS
C              BEING USED.
C            = 5, A SINGLE NUMBER WITH NEITHER A SLASH  NOR
C              AN  ASTERISK  WAS FOUND IN THE INPUT BUFFER.
C              BOTH  INIGOT   AND   LMTGOT   ARE   RETURNED
C              CONTAINING 1, AND THE VALUE OF THE NUMBER IS
C              RETURNED EITHER IN BOTH INIVAL AND LMTVAL OR
C              IN  BOTH  VALINI  AND  VALLMT,  WHICHEVER IS
C              APPROPRIATE.  INCGOT IS RETURNED  CONTAINING
C              ZERO.
C            = 6, EITHER 2 OR 3  NUMBERS  WERE  FOUND,  BUT
C              WITHOUT  SLASHES OR ASTERISKS.  THE VALUE OF
C              THE  LEFT   NUMBER  IS  RETURNED  IN  EITHER
C              INIVAL  OR  VALINI,  OF THE RIGHT  IN EITHER
C              LMTVAL OR  VALLMT,  AND  OF  THE MIDDLE,  IF
C              PRESENT,   IN   EITHER   INCVAL  OR  VALINC,
C              WHICHEVER IS APPROPRIATE.  INIGOT AND LMTGOT
C              ARE  EACH  RETURNED CONTAINING 1.  INCGOT IS
C              RETURNED CONTAINING 1 ONLY IF 3 NUMBERS WERE
C              FOUND.   KONECT  WOULD HAVE TO BE INPUT AS 1
C              FOR KIND TO BE RETURNED AS 6.
C            = 7, A SERIES SPECIFICATION CONTAINING ONE  OR
C              MORE SLASHES WAS FOUND.  THE LOCATION OF THE
C              SLASH OR SLASHES RELATIVE TO THE NUMBERS, IF
C              ANY,   IN   THE   SERIES   SPECIFICATION  IS
C              INDICATED BY THE RETURNED VALUES OF  INIGOT,
C              INCGOT AND LMTGOT.
C            = 8,  A  SERIES  SPECIFICATION  CONTAINING   A
C              SINGLE   ASTERISK   WAS  FOUND.   INCGOT  IS
C              RETURNED CONTAINING ZERO.  THE  LOCATION  OF
C              THE  ASTERISK  RELATIVE  TO  THE NUMBERS, IF
C              ANY,  IN   THE   SERIES   SPECIFICATION   IS
C              INDICATED  BY  THE RETURNED VALUES OF INIGOT
C              AND LMTGOT.
C            = 9, A SERIES SPECIFICATION  WAS  FOUND  WHICH
C              INCLUDED  TOO MANY NUMBERS, TOO MANY SLASHES
C              OR TOO MANY ASTERISKS.  INIGOT,  INCGOT  AND
C              LMTGOT ARE EACH RETURNED CONTAINING ZERO.
C            = 10, FIRST PRINTING CHARACTER IN OR TO  RIGHT
C              OF  LOWBFR  WAS  NOT A CHARACTER WHICH COULD
C              APPEAR IN A NUMBER OR NUMBER RANGE, AND  WAS
C              NOT A COMMA, SEMICOLON OR EXCLAMATION POINT.
C              LOWBFR  IS  RETURNED  POINTING  TO  THE NEXT
C              CHARACTER BEYOND THIS CHARACTER.
C     INIGOT = 0, RETURNED IF THE CONTENTS OF THE BUFFER DO
C              NOT  SPECIFY THE START OF THE RANGE.  INIVAL
C              OR  VALINI,  WHICHEVER  IS  APPROPRIATE,  IS
C              RETURNED UNDEFINED, BUT PROBABLY CHANGED.
C            = 1, RETURNED IF THE CONTENTS  OF  THE  BUFFER
C              SPECIFY  THE  START OF THE RANGE.  INIVAL OR
C              VALINI,   WHICHEVER   IS   APPROPRIATE,   IS
C              RETURNED CONTAINING THIS STARTING NUMBER.
C     INCGOT = 0, RETURNED IF THE CONTENTS OF THE BUFFER DO
C              NOT   SPECIFY  AN  INCREMENT  BY  WHICH  THE
C              STARTING VALUE IS  TO  BE  VARIED  UNTIL  IT
C              REACHES THE ENDING VALUE.  INCVAL OR VALINC,
C              WHICHEVER  IS   APPROPRIATE,   IS   RETURNED
C              UNDEFINED, BUT PROBABLY CHANGED.
C            = 1, RETURNED IF THE CONTENTS  OF  THE  BUFFER
C              SPECIFY  AN  INCREMENT BY WHICH THE STARTING
C              VALUE IS TO BE VARIED UNTIL IT  REACHES  THE
C              ENDING  VALUE.   INCVAL OR VALINC, WHICHEVER
C              IS APPROPRIATE, IS RETURNED CONTAINING  THIS
C              INCREMENT.
C     LMTGOT = 0, RETURNED IF THE CONTENTS OF THE BUFFER DO
C              NOT  SPECIFY  A NUMBER AT WHICH THE RANGE IS
C              TO END.   LMTVAL  OR  VALLMT,  WHICHEVER  IS
C              APPROPRIATE,   IS  RETURNED  UNDEFINED,  BUT
C              PROBABLY CHANGED.
C            = 1, RETURNED IF THE CONTENTS  OF  THE  BUFFER
C              SPECIFY  A  NUMBER  AT WHICH THE RANGE IS TO
C              END.   LMTVAL  OR   VALLMT,   WHICHEVER   IS
C              APPROPRIATE,  IS  RETURNED  CONTAINING  THIS
C              ENDING VALUE.
C     INIVAL = RETURNED CONTAINING THE START OF  THE  RANGE
C              IF   THIS   IS  SPECIFIED  AND  IF  THIS  IS
C              EVALUATED AS AN INTEGER (KONTRL INPUT  .LE.0
C              AND INIGOT RETURNED = 1)
C     INCVAL = RETURNED CONTAINING THE INCREMENT IF THIS IS
C              SPECIFIED  AND  IF  THIS  IS EVALUATED AS AN
C              INTEGER  (KONTRL  INPUT  .LE.0  AND   INCGOT
C              RETURNED = 1)
C     LMTVAL = RETURNED CONTAINING THE END OF THE RANGE  IF
C              THIS  IS  SPECIFIED AND IF THIS IS EVALUATED
C              AS AN INTEGER (KONTRL INPUT .LE.0 AND LMTGOT
C              RETURNED = 1)
C     VALINI = RETURNED CONTAINING THE START OF  THE  RANGE
C              IF   THIS   IS  SPECIFIED  AND  IF  THIS  IS
C              EVALUATED AS A FLOATING POINT NUMBER (KONTRL
C              INPUT .GT.0 AND INIGOT RETURNED = 1)
C     VALINC = RETURNED CONTAINING THE INCREMENT IF THIS IS
C              SPECIFIED  AND  IF  THIS  IS  EVALUATED AS A
C              FLOATING POINT NUMBER  (KONTRL  INPUT  .GT.0
C              AND INCGOT RETURNED = 1)
C     VALLMT = RETURNED CONTAINING THE END OF THE RANGE  IF
C              THIS  IS  SPECIFIED AND IF THIS IS EVALUATED
C              AS A FLOATING  POINT  NUMBER  (KONTRL  INPUT
C              .GT.0 AND LMTGOT RETURNED = 1)
C
C     EVALUATION  OF  RANGE  SPECIFICATIONS          LMTVAL
C     SHOWN  BELOW WOULD  PRODUCE  ARGUMENT        INCVAL !
C     VALUES TO THEIR RIGHT.  "U" INDICATES      INIVAL ! !
C     THAT THE ARGUMENT IS UNDEFINED.        LMTGOT   ! ! !
C                                          INCGOT !   ! ! !
C                                        INIGOT ! !   ! ! !
C     EMPTY  OR  /      OR  //     OR  *      0 0 0   U U U
C     ///    OR  5///9  OR  5 2 2 9           0 0 0   U U U
C     /9     OR  //9    OR  *9                0 0 1   U U 9
C     /2/                                     0 1 0   U 2 U
C     /2/9   OR  /2 9                         0 1 1   U 2 9
C     5/     OR  5//    OR  5*                1 0 0   5 U U
C     5                                       1 0 1   5 U 5
C     5/9    OR  5//9   OR  5 9    OR  5*9    1 0 1   5 U 9
C     5/2/   OR  5 2/                         1 1 0   5 2 U
C     5/2/9  OR  5 2/9  OR  5/2 9  OR  5 2 9  1 1 1   5 2 9
C
      DIMENSION IBUFFR(MAXBFR),IDIGIT(13)
      DATA IDIGIT/
     11H+,1H-,1H.,1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA ISLASH,ICOLON,ISTAR,KOMENT,IEND,IAND,KOMMA,
     1ISPACE,ITAB/1H/,1H:,1H*,1H!,1H;,1H&,1H,,1H ,1H	/
      IRADIX=13
      IF(KONTRL.LT.0)IRADIX=11
      ISTATE=0
      KOUNT=0
      INIGOT=1
      KNTSEP=0
      LMTGOT=1
      KIND=1
      ITEST=2
      IF(MANY.GE.0)GO TO 1
      KIND=4
      MANY=-MANY
    1 IF(KONTRL.GT.0)GO TO 2
      INCVAL=0
      LMTVAL=0
      GO TO 4
    2 VALINC=0.
      VALLMT=0.
      GO TO 4
C
C     TEST IF NEXT CHARACTER CAN BE IN SERIES SPECIFICATION
    3 LOWBFR=LOWBFR+1
    4 IF(LOWBFR.GT.MAXBFR)GO TO 22
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.ISPACE)GO TO 13
      IF(LETTER.EQ.ITAB)GO TO 13
      IF(LETTER.EQ.ISLASH)GO TO 11
      IF(LETTER.EQ.ICOLON)GO TO 11
      IF(LETTER.EQ.ISTAR)GO TO 10
      IF(LETTER.EQ.KOMENT)GO TO 20
      IF(LETTER.EQ.IEND)GO TO 14
      IF(LETTER.EQ.KOMMA)GO TO 9
      IF(LETTER.EQ.IAND)GO TO 15
      IF(KONECT.GT.0)GO TO 5
      IF(ISTATE.GT.0)GO TO 22
    5 IF(KONTRL.LT.-1)GO TO 7
      DO 6 I=1,IRADIX
      IF(LETTER.EQ.IDIGIT(I))GO TO 17
    6 CONTINUE
    7 IF(KIND.EQ.4)GO TO 8
      IF(KIND.NE.1)GO TO 22
    8 LOWBFR=LOWBFR+1
      KIND=10
      GO TO 22
C
C     TEST IF DELIMITER CHARACTER CAN PRECEDE A SERIES
    9 IF(KIND.NE.1)GO TO 22
      KIND=4
      IF(MANY.EQ.0)GO TO 23
      GO TO 3
C
C     ASTERISK FOUND
   10 IF(KIND.EQ.7)ITEST=0
      IF(ITEST.GT.0)ITEST=1
      KIND=8
      GO TO 12
C
C     SLASH FOUND
   11 IF(KIND.EQ.8)ITEST=0
      KIND=7
   12 IF(KOUNT.EQ.0)INIGOT=0
      LMTGOT=0
      KNTSEP=KNTSEP+1
      ISTATE=-1
      GO TO 3
C
C     SPACE FOUND
   13 IF(ISTATE.EQ.0)GO TO 3
      IF(KONECT.GE.0)GO TO 3
      GO TO 22
C
C     SEMICOLON FOUND
   14 IF(KIND.NE.1)GO TO 22
      LOWBFR=LOWBFR+1
      KIND=2
      GO TO 22
C
C     AMPERSAND FOUND
   15 IF(KIND.EQ.1)GO TO 16
      IF(KIND.NE.4)GO TO 22
      MANY=-MANY
   16 KIND=3
      GO TO 21
C
C     EVALUATE NUMBER AND PLACE INTO PUSH-DOWN STACK
   17 IF(KIND.LE.5)KIND=KOUNT+5
      KOUNT=KOUNT+1
      IF(ISTATE.LT.0)KNTSEP=KNTSEP-1
      ISTATE=1
      LMTGOT=1
      IF(KONTRL.GT.0)GO TO 18
      INIVAL=INCVAL
      INCVAL=LMTVAL
      GO TO 19
   18 VALINI=VALINC
      VALINC=VALLMT
C     IDUMMY PRESERVES VARIABLE LOCAL TO THIS ROUTINE
   19 CALL DAHEFT(KONTRL,1,0,IBUFFR,MAXBFR,
     1LOWBFR,IDUMMY,ISHIFT,JSHIFT,KSHIFT,LSHIFT,LMTVAL,
     2VALLMT)
      GO TO 4
C
C     TEST IF TOO MANY ITEMS WERE FOUND IN SPECIFICATION
   20 IF(KIND.NE.1)GO TO 22
   21 LOWBFR=MAXBFR+1
   22 IF((KOUNT+KNTSEP-INIGOT).LE.ITEST)GO TO 23
      KIND=9
      GO TO 24
C
C     CONVERT PUSH-DOWN STACK INTO RANGE DESCRIPTION
   23 IF(KOUNT.GE.3)GO TO 30
      IF(KOUNT.EQ.2)GO TO 25
      IF(KOUNT.EQ.1)GO TO 27
   24 INIGOT=0
      LMTGOT=0
      GO TO 33
   25 IF(INIGOT.EQ.0)GO TO 30
      IF(KONTRL.GT.0)GO TO 26
      INIVAL=INCVAL
      GO TO 28
   26 VALINI=VALINC
      GO TO 28
   27 IF(INIGOT.NE.0)GO TO 31
   28 IF(LMTGOT.NE.0)GO TO 33
      IF(KONTRL.GT.0)GO TO 29
      INCVAL=LMTVAL
      GO TO 30
   29 VALINC=VALLMT
   30 INCGOT=1
      GO TO 34
   31 IF(KONTRL.GT.0)GO TO 32
      INIVAL=LMTVAL
      GO TO 33
   32 VALINI=VALLMT
   33 INCGOT=0
C
C     EVERYTHING IS IN ITS PLACE, RETURN TO CALLING ROUTINE
   34 IF(KIND.GT.3)MANY=MANY+1
      IF(KIND.LT.3)MANY=0
   35 RETURN
C
C     KNTSEP = NUMBER OF SLASHES AND ASTERISKS NOT FOLLOWED
C              BY A NUMBER.
C     ISTATE = 1, WITHIN NUMBER
C            = 0, SPACE
C            = -1, SLASH FOUND
C     ITEST  = MAXIMUM NUMBER OF SLASHES OR ASTERISKS
C              ALLOWED IN A SINGLE SERIES SPECIFICATION.
C     JSIGN  = -1, MINUS SIGN AT START OF NUMBER
C            = 0, NO SIGN AT START OF NUMBER
C            = 1, PLUS SIGN AT START OF NUMBER
C     KOUNT  = NUMBER OF NUMBERS ALREADY FOUND
C
C770127366001:!;&
      END
      SUBROUTINE DASHOW(KONTRL,MINDEC,MAXDEC,MINSIG,MAXSIG,
     1    IDECML,IVALUE,VALUE ,MAXBFR,KOUNT ,IBUFFR,IERR  )
C     RENBR(/REPRESENT INTEGER OR REAL NUMBER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO REPRESENT INTEGERS OR  REAL  NUMBERS  LEFT
C     JUSTIFIED AND WITHOUT EXTRA RIGHTMOST BLANKS
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT  AND  ARE
C     RETURNED UNCHANGED.
C
C     KONTRL = -1,  REPRESENT  INTEGER   VALUE   INPUT   AS
C              ARGUMENT NAMED IVALUE AS OCTAL NUMBER.
C            = 0, REPRESENT INTEGER VALUE INPUT AS ARGUMENT
C              NAMED IVALUE AS DECIMAL NUMBER.
C            = 1 OR GREATER, REPRESENT REAL VALUE INPUT  AS
C              ARGUMENT  NAMED  VALUE  WITH  NO  MORE  THAN
C              MAXDEC NOR LESS THAN MINDEC DIGITS TO  RIGHT
C              OF  DECIMAL  POINT  AND  WITH  NO  MORE THAN
C              MAXSIG  NOR  LESS  THAN  MINSIG  SIGNIFICANT
C              DIGITS.   IF  VALUE  CANNOT  BE  REPRESENTED
C              USING  SPECIFIED  NUMBERS   OF   DIGITS   IN
C              FLOATING  POINT  FORM  (WITHOUT E EXPONENT),
C              THEN  VALUE  IS   INSTEAD   REPRESENTED   IN
C              SCIENTIFIC  NOTATION  (WITH  E EXPONENT) AND
C              WITH IDECML DIGITS TO RIGHT OF DECIMAL POINT
C              IN  REPRESENTATION OF VALUE WHICH EITHER HAS
C              VALUE  ZERO,  OR  WHICH  HAS  BEEN  MODIFIED
C              THOUGH  MULTIPLICATION BY POWER OF TEN SO AS
C              TO FALL WITHIN RANGE 1.0 THROUGH 9.999...
C     MINDEC = 0, THERE IS NO  LOWER  LIMIT  TO  NUMBER  OF
C              DIGITS  WHICH  MUST  BE  SHOWN  TO  RIGHT OF
C              DECIMAL  POINT  OF  NUMBER  REPRESENTED   IN
C              FLOATING POINT FORM.
C            = GREATER THAN ZERO, MINDEC IS MINIMUM  NUMBER
C              OF  DIGITS  WHICH  CAN  BE SHOWN TO RIGHT OF
C              DECIMAL  POINT  OF  NUMBER  REPRESENTED   IN
C              FLOATING  POINT  FORM  IF RIGHTMOST OF THESE
C              DIGITS IS  NONZERO.   IF  IT  WOULD  NOT  BE
C              POSSIBLE  TO INCLUDE AT LEAST THIS NUMBER OF
C              DIGITS TO RIGHT OF DECIMAL POINT, THEN VALUE
C              WILL  BE  REPRESENTED IN SCIENTIFIC NOTATION
C              INSTEAD.  AFTER DETERMINING THAT IT WOULD BE
C              POSSIBLE TO REPRESENT AT LEAST MINDEC DIGITS
C              TO RIGHT OF DECIMAL POINT, THEN  EACH  DIGIT
C              WHICH IS TO RIGHT OF DECIMAL POINT AND WHICH
C              DOES NOT HAVE NONZERO DIGIT TO ITS RIGHT  IS
C              SUPPRESSED  AND  EVEN DECIMAL POINT WILL NOT
C              BE SHOWN IF THERE ARE NO NONZERO  DIGITS  TO
C              RIGHT OF DECIMAL POINT.
C     MAXDEC = 0, REPRESENT ONLY DIGITS WHICH ARE  TO  LEFT
C              OF  DECIMAL  POINT  OF NUMBER REPRESENTED IN
C              FLOATING POINT FORM.
C            = GREATER THAN ZERO, MAXDEC IS MAXIMUM  NUMBER
C              OF  DIGITS  WHICH  CAN  BE SHOWN TO RIGHT OF
C              DECIMAL  POINT  OF  NUMBER  REPRESENTED   IN
C              FLOATING POINT FORM.
C     MINSIG = MINIMUM NUMBER OF SIGNIFICANT  DIGITS  WHICH
C              CAN   BE  SHOWN  IN  NUMBER  REPRESENTED  IN
C              FLOATING POINT FORM IF  RIGHTMOST  OF  THESE
C              DIGITS IS NONZERO.  IF VALUE BEING DISPLAYED
C              HAS VALUE ZERO, THEN MINSIG IS IGNORED.
C     MAXSIG = 0, REPRESENT VALUE INPUT AS  ARGUMENT  NAMED
C              VALUE   IN   SCIENTIFIC   NOTATION  (WITH  E
C              EXPONENT).
C            = GREATER THAN ZERO, MAXSIG IS MAXIMUM  NUMBER
C              OF  DIGITS  WHICH  CAN  BE  SHOWN  IN NUMBER
C              REPRESENTED IN FLOATING POINT FORM, STARTING
C              WITH LEFTMOST NONZERO DIGIT, COUNTING IT AND
C              ALL DIGITS TO ITS RIGHT.  NUMBER  OF  DIGITS
C              DISPLAYED  TO  RIGHT  OF  DECIMAL  POINT  IS
C              REDUCED  IF  NECESSARY  SO  THAT  NUMBER  OF
C              DIGITS    STARTING   AT   LEFTMOST   NONZERO
C              DISPLAYED DIGIT  AND  COUNTING  IT  AND  ALL
C              DIGITS  DISPLAYED  TO  ITS  RIGHT  DOES  NOT
C              EXCEED MAXSIG.  IF MAXSIG WOULD BE LESS THAN
C              NUMBER  OF  DIGITS  LEFT OF DECIMAL POINT IN
C              REPRESENTATION OF VALUE, THEN VALUE WILL  BE
C              REPRESENTED IN SCIENTIFIC NOTATION.
C     IDECML = SAME AS MAXDEC EXCEPT  THAT  IDECML  APPLIES
C              ONLY   TO  VALUES  DISPLAYED  IN  SCIENTIFIC
C              NOTATION.   NOTE  THAT  IF  VALUE  IS  BEING
C              REPRESENTED  IN  SCIENTIFIC  NOTATION,  THEN
C              NONZERO DIGIT WILL BE USED LEFT  OF  DECIMAL
C              POINT   UNLESS   VALUE   IS   ITSELF   ZERO.
C              THEREFORE,  MAXIMUM  NUMBER  OF  SIGNIFICANT
C              DIGITS  WHICH CAN BE DISPLAYED IN SCIENTIFIC
C              NOTATION IS IDECML+1.
C     IVALUE = INPUT  CONTAINING  INTEGER   VALUE   TO   BE
C              REPRESENTED  IF KONTRL IS LESS THAN OR EQUAL
C              TO ZERO.
C     VALUE  = INPUT   CONTAINING   REAL   VALUE   TO    BE
C              REPRESENTED IF KONTRL IS GREATER THAN ZERO.
C     MAXBFR = SUBSCRIPT OF RIGHTMOST  LOCATION  IN  IBUFFR
C              ARRAY  WHICH CAN BE USED BY THIS ROUTINE FOR
C              RETURN OF CHARACTERS  IN  REPRESENTATION  OF
C              NUMBER.   REPRESENTATION  OF NUMBER WILL USE
C              FEWER LOCATIONS IN IBUFFR ARRAY IF POSSIBLE.
C
C     FOLLOWING ARGUMENT IS USED FOR BOTH INPUT AND OUTPUT.
C
C     KOUNT  = INPUT  CONTAINING  SUBSCRIPT  OF   RIGHTMOST
C              (HIGHEST   SUBSCRIPT   VALUE)  IBUFFR  ARRAY
C              LOCATION WHICH IS CURRENTLY IN USE AND WHICH
C              MUST BE PRESERVED.  REPRESENTATION OF NUMBER
C              WILL BE RETURNED STARTING IN IBUFFR(KOUNT+1)
C              AND   EXTENDING  THROUGH  IBUFFR(MAXBFR)  IF
C              NECESSARY.
C            = RETURNED CONTAINING SUBSCRIPT  OF  RIGHTMOST
C              IBUFFR  ARRAY LOCATION IN WHICH CHARACTER OF
C              REPRESENTATION  OF   NUMBER   IS   RETURNED.
C              PORTION   OF   IBUFFR   ARRAY  TO  RIGHT  OF
C              REPRESENTATION   AND    EXTENDING    THROUGH
C              IBUFFR(MAXBFR)  IS  RETURNED  UNDEFINED, BUT
C              POSSIBLY CHANGED.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT.
C
C     IBUFFR = ARRAY  IN  WHICH   CHARACTERS   WHICH   FORM
C              REPRESENTATION  OF  NUMBER  ARE  RETURNED AS
C              THOUGH  READ  BY  MULTIPLE  OF   A1   FORMAT
C              SPECIFICATION   OR   AS  THOUGH  DEFINED  BY
C              SEVERAL 1H FIELDS.   LEFTMOST  CHARACTER  OF
C              REPRESENTATION      IS      RETURNED      IN
C              IBUFFR(KOUNT+1).
C     IERR   = -1, RETURNED  IF  FIELD  WAS  TOO  SHORT  TO
C              CONTAIN  REPRESENTATION OF NUMBER.  FIELD IS
C              RETURNED CONTAINING ASTERISKS, AND KOUNT  IS
C              RETURNED SET EQUAL TO MAXBFR.
C            = 0, RETURNED IF KONTRL IS LESS THAN OR  EQUAL
C              TO ZERO AND INTEGER VALUE COULD BE SHOWN, OR
C              IF KONTRL IS  GREATER  THAN  ZERO  AND  REAL
C              VALUE  WAS  REPRESENTED  IN  FLOATING  POINT
C              FORM.
C            = 1 OR GREATER, RETURNED IF  KONTRL  IS  INPUT
C              GREATER  THAN ZERO AND VALUE WAS REPRESENTED
C              IN SCIENTIFIC NOTATION.  IERR IS  NUMBER  OF
C              DIGITS  WHICH  WOULD  BE  SHOWN  TO  LEFT OF
C              EXPONENT IF RIGHTMOST  OF  THESE  DIGITS  IS
C              NONZERO.    ZEROS  WHICH  ARE  TO  RIGHT  OF
C              DECIMAL POINT AND WHICH DO NOT HAVE  NONZERO
C              DIGIT  TO  THEIR RIGHT ARE NOT SHOWN BUT ARE
C              INCLUDED IN VALUE OF IERR.
C
      DIMENSION IBUFFR(MAXBFR)
      DATA ISTAR/1H*/
      LFTCOL=KOUNT
      IF(KONTRL.GT.0)GO TO 2
C
C     REPRESENT INTEGER
      IRADIX=10
      IF(KONTRL.LT.0)IRADIX=8
      CALL DANUMB(0,IVALUE,IRADIX,IBUFFR,KOUNT,LFTCOL,
     1MAXBFR)
      IERR=0
      IF(KOUNT.GT.LFTCOL)GO TO 3
      IERR=-1
    1 IF(KOUNT.GE.MAXBFR)GO TO 3
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=ISTAR
      GO TO 1
C
C     REPRESENT REAL NUMBER
    2 LOWDEC=MINDEC
      IF(LOWDEC.LE.0)LOWDEC=-1
      NOTATN=0
      IF(MAXSIG.LE.0)NOTATN=-1
      IWIDTH=MAXBFR-LFTCOL
      CALL DARITE(VALUE ,-1,NOTATN,0,0,
     1-3,0,IWIDTH,LOWDEC,MAXDEC,MINSIG,MAXSIG,
     2-1,0,IDECML,0,0,-1,LFTCOL,
     3MAXBFR,IBUFFR,KOUNT,IERR)
C
C     RETURN TO CALLING PROGRAM
    3 RETURN
C227857143604
      END
      SUBROUTINE DARITE(VALUE ,JSTIFY,NOTATN,IPART ,ISIGN ,
     1    KLIP  ,IFILL ,IWIDTH,MINDEC,MAXDEC,MINSIG,MAXSIG,
     2    INIZRO,MARGIN,IDECML,IEXPNT,IFORMT,IZERO ,LFTCOL,
     3    MAXBFR,IBUFFR,KOUNT ,IERR  )
C     RENBR(/FREE FORMAT NUMERIC OUTPUT ROUTINE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO REPRESENT A  NUMBER  SO  THAT  IT  CAN  BE
C     WRITTEN  WITH A FORTRAN FORMAT STATEMENT CONTAINING A
C     MULTIPLE A1 ALPHAMERIC SPECIFICATION.  THE NUMBER CAN
C     BE REPRESENTED EITHER WITH A USER SPECIFIED NUMBER OF
C     DIGITS RIGHT OF THE DECIMAL POINT AND WITH A  MAXIMUM
C     NUMBER   OF  SIGNIFICANT  DIGITS,  OR  IN  SCIENTIFIC
C     NOTATION AS  A  NUMBER  IN  THE  RANGE  1.000...   TO
C     9.999...   WITH  A  FOLLOWING  EXPONENT.  IF FLOATING
C     POINT NOTATION HAS BEEN  REQUESTED,  BUT  THE  NUMBER
C     CANNOT FIT INTO THE SUPPLIED FIELD WITH THE SPECIFIED
C     NUMBER OF DIGITS RIGHT OF THE DECIMAL POINT, THEN THE
C     NUMBER  OF  DIGITS RIGHT OF THE DECIMAL POINT WILL BE
C     DECREASED, AND IF THE NUMBER WILL STILL NOT FIT, THEN
C     SCIENTIFIC NOTATION WILL BE USED.  IF THE NUMBER WILL
C     NOT FIT INTO THE FIELD EVEN IN  SCIENTIFIC  NOTATION,
C     THEN THE FIELD WILL BE FILLED WITH ASTERISKS.
C
C     THE FOLLOWING ARE INPUT ARGUMENTS LEFT UNCHANGED
C
C     VALUE  = THE NUMBER TO BE REPRESENTED
C     JSTIFY = -1, LEFT JUSTIFY NUMBER IN  FIELD  OF  WIDTH
C              IWIDTH
C            = 0, CENTER NUMBER  IN FIELD OF  WIDTH IWIDTH.
C            = 1, RIGHT JUSTIFY NUMBER IN  FIELD  OF  WIDTH
C              IWIDTH.
C     NOTATN = -1,  REPRESENT IN ARRAY  IBUFFR THE VALUE IN
C              SCIENTIFIC  NOTATION.   VALUE  1234 WOULD BE
C              REPRESENTED IN IBUFFR AS 1.234E3
C            = 0, DISPLAY  IN IBUFFR THE VALUE  IN FLOATING
C              POINT  FORM.   THE VALUE  1234.56  WOULD  BE
C              DISPLAYED AS IT IS  WRITTEN IF THE NUMBER OF
C              DIGITS RIGHT  OF THE DECIMAL  POINT IS 2 AND
C              IF AT LEAST 6 SIGNIFICANT  DIGITS IN A FIELD
C              OF AT LEAST 7 CHARACTERS ARE ALLOWED.
C            = 1, MULTIPLY VALUE BY 100 AND INSERT  PERCENT
C              SIGN  FOLLOWING  DIGITS  OF  NUMBER.  IWIDTH
C              MUST INCLUDE ROOM FOR PERCENT SIGN.   MINDEC
C              AND MAXDEC  REFER TO THE  DISPLAYED  DECIMAL
C              POINT.  TO PRINT TENTHS OF A PERCENT, MINDEC
C              AND MAXDEC  WOULD BOTH BE GIVEN  THE VALUE 1
C            = 2, IF NUMBER IS IN RANGE  1000  TO  1000000,
C              DIVIDE  VALUE BY 1000 AND INSERT K FOLLOWING
C              DIGITS.  IF NUMBER IS  1000000  OR  GREATER,
C              DIVIDE   VALUE   BY  1000000  AND  INSERT  M
C              FOLLOWING DIGITS.  IWIDTH MUST INCLUDE  ROOM
C              FOR  CHARACTER  K OR M.   MINDEC  AND MAXDEC
C              REFER TO  DISPLAYED  DECIMAL POINT.   MINDEC
C              AND MAXDEC  BOTH SET  AT 2  WOULD  REPRESENT
C              VALUE 1234 AS 1.23K.
C            = 3, SAME AS NOTATN=2  EXCEPT THAT  MINDEC AND
C              MAXDEC  BOTH REFER  TO THE DECIMAL  POINT IN
C              THE ORIGINAL  VALUE,  NOT  TO THE  DISPLAYED
C              DECIMAL  POINT.   IF A K  OR M  IS DISPLAYED
C              RIGHT OF THE NUMBER,  THEN MINDEC AND MAXDEC
C              VALUES OF -1 ARE  EQUIVALENT TO VALUES OF 0.
C              MINDEC=-2 INDICATES  THAT THERE  IS NO LOWER
C              LIMIT TO  THE NUMBER OF  DIGITS DISPLAYED TO
C              RIGHT OF THE DISPLAYED  DECIMAL POINT AND IS
C              PROBABLY THE APPROPRIATE  VALUE UNLESS IT IS
C              ABSOLUTELY  NECESSARY TO  DISPLAY THE DIGITS
C              WHICH WOULD BE RIGHT OF THE DECIMAL POINT IN
C              THE ORIGINAL  VALUE,  AS FOR EXAMPLE  IF THE
C              AMOUNTS ARE  DOLLARS  AND MUST  BE DISPLAYED
C              ALWAYS INCLUDING THE CENTS DIGITS.
C     IPART  = -1, IF THE VALUE  IS REPRESENTED IN FLOATING
C              POINT, COMPLETELY  REPRESENT THIS VALUE.  IF
C              THE VALUE IS REPRESENTED IN SCIENTIFIC NOTA-
C              TION, REPRESENT ONLY  THE NORMALIZED PORTION
C              OF THE VALUE WITHOUT  THE EXPONENT, IT BEING
C              THIS NORMALIZED  VALUE (IN THE  RANGE OF 1.0
C              TO 9.9...) WHICH IS LEFT JUSTIFIED, CENTERED
C              OR RIGHT JUSTIFIED ACCORDING TO THE VALUE OF
C              JSTIFY.    IWIDTH  MUST,  HOWEVER,   CONTAIN
C              SUFFICIENT  ROOM  FOR EITHER THE  NORMALIZED
C              VALUE OR  THE EXPONENT,  WHICHEVER  REQUIRES
C              THE MOST CHARACTERS TO REPRESENT.
C            = 0, COMPLETELY REPRESENT THE VALUE REGARDLESS
C              OF WHETHER IN  FLOATING POINT  OR SCIENTIFIC
C              NOTATION.
C            = 1,  IF THE VALUE  IS REPRESENTED IN FLOATING
C              POINT,  INSERT NOTHING  (EXCEPT THE POSSIBLE
C              TRAILING  SPACES  INDICATED  BY IFILL)  INTO
C              IBUFFR.   IF  THE  VALUE  IS  REPRESENTED IN
C              SCIENTIFIC NOTATION, REPRESENT ONLY EXPONENT
C              PORTION,  IT  BEING  THIS  EXPONENT  PORTION
C              WHICH IS LEFT  JUSITIFED, CENTERED  OR RIGHT
C              JUSTIFIED ACCORDING  TO THE VALUE OF JSTIFY.
C              IWIDTH  MUST,  HOWEVER,  CONTAIN  SUFFICIENT
C              ROOM FOR EITHER THE  NORMALIZED VALUE OR THE
C              EXPONENT, WHICHEVER  REQUIRES THE MOST CHAR-
C              ACTERS TO REPRESENT.
C     ISIGN  = -1, IF THE VALUE IS GREATER THAN  ZERO,  AND
C              IF  IPART.LE.0,  THEN PLACE PLUS SIGN TO ITS
C              LEFT.  IF THE VALUE IS EQUAL TO ZERO, DO NOT
C              ADD EXTRA SPACE WHERE THE PLUS OR MINUS SIGN
C              WOULD OTHERWISE BE.
C            = 0, IF THE VALUE IS  GREATER THAN OR EQUAL TO
C              ZERO, DO NOT ADD EXTRA SPACE WHERE THE MINUS
C              SIGN WOULD OTHERWISE BE.
C            = 1, IF THE VALUE IS GREATER  THAN OR EQUAL TO
C              ZERO,  AND IF  IPART.LE.0,  THEN AT  LEAST 1
C              SPACE WILL BE PLACED  AT THE LEFT END OF THE
C              REPRESENTATION  OF  THE  VALUE  EVEN  IF THE
C              NUMBER OF DIGITS IN THE REPRESENTION MUST BE
C              REDUCED TO MAKE ROOM FOR THIS SPACE.
C            = 2, IF THE VALUE IS GREATER THAN ZERO, AND IF
C              IPART.LE.0,  THEN  PLACE  PLUS  SIGN  TO ITS
C              LEFT.  IF THE VALUE IS EQUAL TO ZERO, AND IF
C              IPART.LE.0,  THEN  PLACE AT LEAST 1 SPACE AT
C              THE LEFT END OF THE  REPRESENTATION  OF  THE
C              VALUE  EVEN  IF  THE NUMBER OF DIGITS IN THE
C              REPRESENTATION MUST BE REDUCED TO MAKE  ROOM
C              FOR THIS SPACE.
C     KLIP   = -3, SUPPRESS  PRINTING OF ALL  ZEROES TO THE
C              RIGHT OF THE DECIMAL POINT  AND WHICH DO NOT
C              HAVE A  NON-ZERO  DIGIT TO THEIR  RIGHT.  IF
C              NO NON-ZERO  DIGITS APPEAR  RIGHT OF DECIMAL
C              POINT, THEN DO NOT  REPRESENT DECIMAL POINT.
C              IF CENTERING OR RIGHT JUSTIFYING,  IT IS THE
C              NUMBER AFTER  REMOVAL OF  ZEROES AND DECIMAL
C              WHICH IS CENTERED OR RIGHT JUSTIFIED.
C            = -2, SUPPRESS  PRINTING OF ALL  ZEROES TO THE
C              RIGHT OF THE DECIMAL POINT  AND WHICH DO NOT
C              HAVE A NON-ZERO  DIGIT TO  THEIR RIGHT.   IF
C              CENTERING OR  RIGHT JUSTIFYING NUMBER, IT IS
C              NUMBER  AFTER  REMOVAL  OF ZEROES  WHICH  IS
C              CENTERED OR RIGHT JUSTIFIED.
C            = -1, SUPPRESS  PRINTING OF  ALL ZEROES  WHICH
C              ARE BEYOND THE FIRST DIGIT AFTER THE DECIMAL
C              POINT AND WHICH DO NOT HAVE A NON-ZERO DIGIT
C              TO  THEIR  RIGHT.   IF  CENTERING  OR  RIGHT
C              JUSTIFYING, IT IS THE NUMBER  AFTER  REMOVAL
C              OF  THE  ZEROES  THAT  IS  CENTERED OR RIGHT
C              JUSTIFIED.
C            = 0, REPRESENT  AS  ZEROES  ALL  ZEROES  WHICH
C              ARE BEYOND THE FIRST DIGIT AFTER THE DECIMAL
C              POINT.
C            = 1, CONVERT  TO SPACES ALL  ZEROES  WHICH ARE
C              BEYOND  THE FIRST  DIGIT  AFTER THE  DECIMAL
C              POINT AND WHICH DO NOT HAVE A NON-ZERO DIGIT
C              TO  THEIR  RIGHT.  REMAINING CHARACTERS WILL
C              BE IN THE SAME POSITIONS AS  IF  THE  ZEROES
C              WHERE NONZEROES.  IF NOTATN.GT.0, SPACES CAN
C              APPEAR BETWEEN THE  NONSPACE  CHARACTERS  OF
C              THE NUMBER AND THE FOLLOWING PERCENT SIGN OR
C              K OR M SINCE THE LOCATION OF THESE  PRINTING
C              CHARACTERS  IS NOT CHANGED BY THE CONVERSION
C              OF THE TRAILING ZEROES TO SPACES.
C            = 2, SAME AS KLIP=1, EXCEPT THAT ALL ZEROES TO
C              THE RIGHT OF DECIMAL POINT WHICH DO NOT HAVE
C              NON-ZERO DIGIT TO THEIR RIGHT ARE SUPPRESSED
C            = 3, SAME AS KLIP=2, EXCEPT THAT  IF THERE ARE
C              NO NON-ZERO DIGITS DISPLAYED TO THE RIGHT OF
C              DECIMAL POINT, THEN THE DECIMAL POINT IS NOT
C              DISPLAYED.
C
C              FOR EXAMPLE, THE REPRESENATIONS OF THE VALUE
C              12.34 IN FLOATING POINT WITH MAXDEC=4 AND IN
C              SCIENTIFIC  NOTATION WITH IDECML=5  WOULD BE
C
C                   FOR KLIP.LT.0    12.34       1.234E1
C                       KLIP=0     12.3400     1.23400E1
C                       KLIP.GT.0  12.34       1.234  E1
C
C              IF NOTATN=2 VALUE 123E3 WOULD BE REPRESENTED
C
C                   FOR KLIP=-3       123K        1.23E5
C                       KLIP=-2      123.K        1.23E5
C                       KLIP=-1     123.0K        1.23E5
C                       KLIP=0   123.0000K     1.23000E5
C                       KLIP=1   123.0   K     1.23   E5
C                       KLIP=2   123.    K     1.23   E5
C                       KLIP=3   123     K     1.23   E5
C
C     IFILL  = 0, DO NOT  FILL  PORTION  OF FIELD  RIGHT OF
C              NONSPACE REPRESENTAION OF VALUE WITH SPACES.
C              KOUNT WILL BE LEFT POINTING AT THE RIGHTMOST
C              NONSPACE  CHARACTER IN THE  REPRESENATION OF
C              THE VALUE.  THE VALUE OF IFILL HAS NO EFFECT
C              ON THE NONSPACE CHARACTERS  IN THE REPRESEN-
C              TATION  OF THE  VALUE.   IF IFILL=0,  AND IF
C              IPART.LE.0,  THEN THE  CHARACTERS ORIGINALLY
C              IN THE  IBUFFR  ARRAY  TO THE  RIGHT  OF THE
C              NONSPACE  PORTION  OF THE  REPRESENTATION OF
C              THE VALUE ARE LEFT INTACT.   (THE REASON WHY
C              IPART.GT.0  IS  AN  EXCEPTION  IS  THAT  THE
C              NORMALIZED  PORTION  OF THE  NUMBER  MUST BE
C              TEMPORARILY STORED  IN IBUFFR  EVEN IF IT IS
C              NOT GOING TO  BE REPRESENTED  SINCE EXPONENT
C              CHANGE DUE TO ROUNDING MUST BE CHECKED FOR.)
C            = 1,  FILL  THE FIELD  RIGHT  OF THE  NONSPACE
C              PORTION  OF THE  REPRESENTATION OF THE VALUE
C              WITH SPACES.   KOUNT WILL  BE LEFT  POINTING
C              AT LFTCOL+IWIDTH.
C     IWIDTH = THE NUMBER OF CHARACTERS TO BE IN THE  FIELD
C              INTO  WHICH THE VALUE IS CODED.  IWIDTH MUST
C              INCLUDE ROOM FOR EXPONENT, SIGN AND  DECIMAL
C              POINT  IF  THESE  ARE NECESSARY TO REPRESENT
C              VALUE.
C     LFTCOL = THE SUBSCRIPT OF THE IBUFFR ARRAY  ENTRY  TO
C              THE  IMMEDIATE  LEFT OF FIELD INTO WHICH THE
C              NUMBER IS TO BE CODED.  USUALLY, LFTCOL WILL
C              BE NUMBER OF CHARACTERS ALREADY IN IBUFFR.
C     MAXBFR = DIMENSION OF IBUFFR ARRAY.
C
C     THE FOLLOWING ARGUMENTS  CONTROL  FORMAT  OF  NUMBERS
C     DISPLAYED  IN  FLOATING FORM (WITHOUT E EXPONENT), OR
C     DISPLAYED WITH FOLLOWING K, M OR PERCENT SIGN.  THESE
C     ARGUMENTS DO  NOT CONTROL  THE FORMAT  OF NUMBERS  IN
C     SCIENTIFIC NOTATION  (EITHER WITH  DISPLAYED EXPONENT
C     OR WITH SUPPRESSED ZERO EXPONENT).
C
C     MINDEC = MINIMUM NUMBER OF  DIGITS RIGHT OF DISPLAYED
C              DECIMAL POINT IN NUMBERS WHICH ARE DISPLAYED
C              IN FLOATING FORM.
C            = -1, IT  IS NOT  NECESSARY  THAT  THE DECIMAL
C              POINT  BE DISPLAYED.   THERE  IS NO  MINIMUM
C              LIMIT TO  THE NUMBER OF DIGITS  RIGHT OF THE
C              DECIMAL POINT.
C            = EQUAL TO OR GREATER THAN ZERO, MINDEC IS THE
C              MINIMUM  NUMBER  OF  DIGITS   WHICH  CAN  BE
C              DISPLAYED  RIGHT  OF THE DECIMAL  POINT IN A
C              FLOATING POINT NUMBER.   IF LESS THAN MINDEC
C              DIGITS WOULD  BE DISPLAYED RIGHT  OF DECIMAL
C              POINT, THEN THE VALUE WILL BE REPRESENTED IN
C              SCIENTIFIC NOTATION INSTEAD.
C     MAXDEC = MAXIMUM NUMBER OF  DIGITS RIGHT OF DISPLAYED
C              DECIMAL POINT IN NUMBERS WHICH ARE DISPLAYED
C              IN FLOATING FORM.
C            = -2,  REPRESENT  AS  MANY  DIGITS  RIGHT   OF
C              DECIMAL  POINT  AS  FIELD WILL HOLD (UP THRU
C              NUMBER OF DIGITS SPECIFIED BY MAXSIG).
C            = -1, REPRESENT ONLY DIGITS  LEFT  OF  DECIMAL
C              POINT.  THE DECIMAL POINT ITSELF WILL NOT BE
C              REPRESENTED.  IF MORE THAN IWIDTH OR  MAXSIG
C              DIGITS  WOULD  APPEAR LEFT OF DECIMAL POINT,
C              NUMBER WILL BE REPRESENTED IN EXPONENT FORM.
C            = .GE.0, REPRESENT NUMBER WITH  MAXDEC  DIGITS
C              RIGHT  OF DECIMAL POINT.  IF THIS REPRESENT-
C              ATION OF NUMBER WILL NOT FIT INTO FIELD SIZE
C              INDICATED  BY  IWIDTH OR MAXSIG, THEN REDUCE
C              NUMBER  OF  DIGITS  REPRESENTED   RIGHT   OF
C              DECIMAL  POINT  SO  THAT NUMBER WILL FIT, OR
C              REPRESENT NUMBER IN EXPONENT FORM  IF  THERE
C              ARE  MORE  THAN IWIDTH OR MAXSIG DIGITS LEFT
C              OF DECIMAL POINT.
C     MINSIG = MINIMUM NUMBER  OF SIGNIFICANT  DIGITS TO BE
C              REPRESENTED IN A VALUE DISPLAYED IN FLOATING
C              POINT.   IF  LESS  THAN  MINSIG  SIGNIFICANT
C              DIGITS WOULD  BE DISPLAYED,  THE NUMBER WILL
C              BE REPRESENTED IN SCIENTFIC NOTATION.
C     MAXSIG = SELECTS MAXIMUM NUMBER OF SIGNIFICANT DIGITS
C              DISPLAYED  IN NUMBER REPRESENTED IN FLOATING
C              POINT FORM.
C            = .LE.0, ALLOW AS MANY DIGITS  AS  FIELD  WILL
C              HOLD
C            = .GT.0, MAXSIG IS MAXIMUM  NUMBER  OF  DIGITS
C              WHICH  CAN  BE  DISPLAYED  STARTING WITH THE
C              LEFTMOST NONZERO DIGIT, COUNTING IT AND  ALL
C              DIGITS   TO  ITS  RIGHT.   MAXSIG  DOES  NOT
C              INCLUDE THE DECIMAL POINT, DOES NOT  INCLUDE
C              THE MINUS SIGN IF THE VALUE IS NEGATIVE, AND
C              DOES NOT INCLUDE THE PERCENT SIGN, K OR M IF
C              NOTATN.GT.0.  THE NUMBER OF DIGITS DISPLAYED
C              RIGHT OF THE DECIMAL  POINT  IS  REDUCED  IF
C              NECESSARY  SO  THAT  THE  NUMBER  OF  DIGITS
C              STARTING AT THE LEFTMOST  NONZERO  DISPLAYED
C              DIGIT   AND   COUNTING  IT  AND  ALL  DIGITS
C              DISPLAYED  TO  ITS  RIGHT  DOES  NOT  EXCEED
C              MAXSIG.   IF  MAXSIG  IS LESS THAN NUMBER OF
C              DIGITS LEFT OF DECIMAL  POINT  IN  DISPLAYED
C              NUMBER,  THEN  NUMBER  WILL  BE DISPLAYED IN
C              SCIENTIFIC NOTATION.
C     INIZRO = 0, IF THE NUMBER  IS REPRESENTED IN FLOATING
C              POINT FORM AND HAS  ABSOLUTE VALUE LESS THAN
C              1.0, THEN A ZERO IS DISPLAYED TO THE LEFT OF
C              DECIMAL POINT.
C            = 1, IF THE NUMBER  IS REPRESENTED IN FLOATING
C              POINT FORM AND HAS  ABSOLUTE VALUE LESS THAN
C              1.0, THEN A ZERO IS NOT DISPLAYED TO LEFT OF
C              DECIMAL POINT.
C            = -1,  SAME AS INIZRO=1  EXCEPT THAT A ZERO IS
C              DISPLAYED  LEFT OF  THE DECIMAL  POINT IF NO
C              DIGITS WOULD OTHERWISE BE DISPLAYED.
C     MARGIN = 0, IF THE NUMBER IS REPRESENTED IN  FLOATING
C              POINT  FORM,  AND  IF A K, M OR PERCENT SIGN
C              DOESN'T FOLLOW REPRESENTATION OF THE  VALUE,
C              THEN  DO NOT ADD AN EXTRA SPACE WHERE THE K,
C              M OR PERCENT SIGN WOULD OTHERWISE BE.
C            = GREATER THAN ZERO, IS NUMBER  OF  CHARACTERS
C              IN THE FIELD CONTAINING SPACES AND/OR THE K,
C              M OR PERCENT SIGN TO  RIGHT  OF  A  FLOATING
C              POINT  NUMBER.   MARGIN  IS  USED TO FORCE A
C              FLOATING POINT NUMBER TO HAVE ITS  RIGHTMOST
C              DIGIT  AT THE SAME POSITION AS THE RIGHTMOST
C              DIGIT  OF  THE  NORMALIZED  PORTION   OF   A
C              SCIENTIFIC   NOTATION   NUMBER.    FOR  THIS
C              PURPOSE, IEXPNT WOULD BE 1 LESS THAN MARGIN.
C              IF  MARGIN  IS  GREATER THAN 1 AND A K, M OR
C              PERCENT SIGN MUST BE PLACED TO RIGHT OF  THE
C              NUMBER,  THEN  THE  K,  M OR PERCENT SIGN IS
C              PLACED AT THE LEFT OF THE  FIELD  OF  SPACES
C              WHERE  THE E OF A SCIENTIFIC NOTATION NUMBER
C              WOULD APPEAR AND  THE  FIELD  THEN  CONTAINS
C              MARGIN-1  SPACES TO THE RIGHT OF THE K, M OR
C              PERCENT SIGN.  MARGIN WOULD HAVE THE VALUE 1
C              IF  IT  IS  MERELY DESIRED TO FORCE A SINGLE
C              SPACE TO RIGHT OF THE NUMBER IF A  K,  M  OR
C              PERCENT SIGN DOES NOT APPEAR TO ITS RIGHT.
C
C     THE FOLLOWING ARGUMENTS  CONTROL  FORMAT  OF  NUMBERS
C     IN SCIENTIFIC NOTATION EITHER WITH DISPLAYED EXPONENT
C     OR WITH SUPPRESSED ZERO EXPONENT (IZERO.LE.0).
C
C     IDECML = SAME  AS  MAXDEC  EXCEPT  APPLIES  ONLY   TO
C              NUMBERS  DISPLAYED  IN  SCIENTIFIC NOTATION.
C              NOTE THAT IF NUMBER IS  BEING  DISPLAYED  IN
C              SCIENTIFIC  NOTATION,  THEN  A NONZERO DIGIT
C              WILL BE  USED  LEFT  OF  THE  DECIMAL  POINT
C              UNLESS THE VALUE IS ITSELF ZERO.  THEREFORE,
C              IF IDECML.GE.0, THEN THE MAXIMUM  NUMBER  OF
C              SIGNIFICANT DIGITS WHICH CAN BE DISPLAYED IN
C              SCIENTIFIC NOTATION IS IDECML+1.
C     IEXPNT = MINIMUM NUMBER OF DIGITS IN THE EXPONENT  IF
C              VALUE IS REPRESENTED IN SCIENTIFIC NOTATION.
C              IF FEWER THAN IEXPNT DIGITS  ARE  NEEDED  IN
C              EXPONENT, THESE ARE JUSTIFIED IN AN EXPONENT
C              FIELD OF IEXPNT WIDTH  WITH EITHER SPACES OR
C              ZEROES AS FILL ACCORDING TO VALUE OF IFORMT.
C              IEXPNT INCLUDES  ROOM FOR SIGN  (IF NEGATIVE
C              EXPONENT) BUT DOES NOT  INCLUDE ROOM FOR THE
C              INITIAL LETTER E.
C     IFORMT = 0, IF IEXPNT  IS GREATER THAN  THE NUMBER OF
C              CHARACTERS NEEDED TO REPRESENT THE EXPONENT,
C              LEFT JUSTIFY  THE EXPONENT  WITHIN  EXPONENT
C              FIELD.
C            = 1, IF IEXPNT  IS GREATER THAN  THE NUMBER OF
C              CHARACTERS NEEDED TO REPRESENT THE EXPONENT,
C              RIGHT  JUSTIFY  THE DIGITS  OF THE  EXPONENT
C              WITHIN THE EXPONENT FIELD.   IF THE EXPONENT
C              IS NEGATIVE, PLACE  THE SIGN  RIGHT OF THE E
C              AT THE START  OF THE EXPONENT.   ZEROES, NOT
C              SPACES,  ARE USED  TO FILL  THE REST  OF THE
C              EXPONENT FIELD.
C            = 2, SAME AS IFORMT=1  EXCEPT THAT SPACES, NOT
C              ZEROES ARE USED TO FILL  BETWEEN THE SIGN IF
C              ANY AND THE DIGITS OF THE EXPONENT.
C            = 3, SAME AS IFORMT=2 EXCEPT THAT THE SIGN IF
C              ANY IS  PLACED  IMMEDIATELY  TO THE  LEFT OF
C              THE DIGITS OF THE EXPONENT INSTEAD OF TO THE
C              RIGHT OF THE E AT THE START OF THE EXPONENT.
C
C              FOR EXAMPLE, IF IEXPNT IS 4,  THEN THE VALUE
C              1.2E-3 WOULD BE REPRESENTED
C
C                   FOR IFORMT=0     1.2E-3
C                       IFORMT=1     1.2E-003
C                       IFORMT=2     1.2E-  3
C                       IFORMT=3     1.2E  -3
C
C     IZERO  = -1, IF  THE VALUE  IS BEING  REPRESENTED  IN
C              SCIENTIFIC NOTATION AND  HAS A ZERO EXPONENT
C              (VALUE OF THE NUMBER IS ZERO OR IS IN EITHER
C              RANGE -9.99... TO -1.00...  OR RANGE 1.00...
C              TO 9.99...),  THEN THE REPRESENTATION OF THE
C              NUMBER WILL NOT INCLUDE AN EXPONENT FIELD.
C            = 0, IF  THE VALUE  IS  BEING  REPRESENTED  IN
C              SCIENTIFIC NOTATION AND  HAS A ZERO EXPONENT
C              (VALUE OF THE NUMBER IS ZERO OR IS IN EITHER
C              RANGE -9.99... TO -1.00...  OR RANGE 1.00...
C              TO 9.99...), THEN THE  EXPONENT FIELD  IS OF
C              THE SAME SIZE AS IF THE EXPONENT WAS ONE BUT
C              THE EXPONENT FIELD IS FILLED WITH SPACES.
C            = 1,  IF THE  VALUE  IS  BEING  REPRESENTED IN
C              SCIENTIFIC  NOTATION, THEN  EXPONENT WILL BE
C              DISPLAYED EVEN IF THIS EXPONENT IS ZERO.
C
C              FOR EXAMPLE, IF IEXPNT IS 4,  THEN THE VALUE
C              1.2 WOULD BE REPRESENTED
C
C                   FOR IZERO=-1         1.2
C                       IZERO=0     1.2
C                       IZERO=1     1.2E   0
C
C     THE FOLLOWING ARE OUTPUT ARGUMENTS
C
C     IBUFFR = ARRAY INTO WHICH THE NUMBER IS TO  BE  CODED
C              AND  WHICH CAN THEN BE PRINTED WITH MULTIPLE
C              OF AN A1 FORMAT.
C     KOUNT  = RETURNED POINTING TO THE RIGHTMOST CHARACTER
C              INSERTED  INTO  THE IBUFFR ARRAY.  THIS WILL
C              EQUAL LFTCOL+IWIDTH  WHILE IFILL=1.
C     IERR   = -1 RETURNED IF THE  FIELD  WAS  FILLED  WITH
C              ASTERISKS  DUE  TO  FIELD  OVERFLOW  EVEN IN
C              SCIENTIFIC NOTATION.
C            = 0 RETURNED IF VALUE  WAS  REPRESENTED  AS  A
C              FLOATING   POINT   NUMBER  WITH  OR  WITHOUT
C              FOLLOWING PERCENT SIGN, K OR M.
C            = 1  OR   GREATER   RETURNED   IF   VALUE  WAS
C              REPRESENTED IN SCIENTIFIC NOTATION.  IERR IS
C              NUMBER OF DIGITS  LEFT OF  EXPONENT PRIOR TO
C              SUPPRESSION  OF RIGHTHAND  ZEROES BY NONZERO
C              VALUE OF KLIP.
C
      DIMENSION IBUFFR(MAXBFR),IDIGIT(11),LETTER(3)
C
C     11TH NONDIGIT ITEM IN IDIGIT ACTS AS A FENCE IN CASE
C     OF ROUNDING ERROR WHEN SHIFTING DIGITS OUT OF VALUE
      DATA IDIGIT
     1/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H*/
      DATA LETTER/1H%,1HK,1HM/
      DATA JEXPNT,ISTAR,IPLUS,IMINUS,IDOT,JZERO,IBLANK/
     11HE,1H*,1H+,1H-,1H.,1H0,1H /
      NOTE=NOTATN
      IFZERO=INIZRO
      JWIDTH=IWIDTH
      IF(JWIDTH.GT.(MAXBFR-LFTCOL))JWIDTH=MAXBFR-LFTCOL
    1 IOFSET=0
    2 LTREND=LFTCOL+JWIDTH
C
C     FIND ABSOLUTE VALUE OF NUMBER TO REPRESENT
      ABSVLU=VALUE
      MINUS=0
      IF(ABSVLU.LT.0.0)GO TO 5
      IF(ABSVLU.EQ.0.0)GO TO 3
      IF(ISIGN.EQ.0)GO TO 7
      IF(ISIGN.EQ.1)GO TO 4
      MINUS=2
      GO TO 6
    3 MAXEXP=-1
      IF(ISIGN.LE.0)GO TO 11
      MINUS=1
      LTREND=LTREND-1
      GO TO 11
    4 MINUS=1
      GO TO 6
    5 ABSVLU=-ABSVLU
      MINUS=-1
    6 LTREND=LTREND-1
C
C     NORMALIZE THE ABSOLUTE VALUE
C     MAXEXP = ABSULUTE VALUE OF MAXIMUM EXPONENT
C            = LEFT =-1 IF UNDERFLOW OR OVERFLOW
    7 MAXEXP=100
      KEXPNT=IOFSET
    8 IF(ABSVLU.LT.10.0)GO TO 9
      ABSVLU=ABSVLU/10.0
      KEXPNT=KEXPNT+1
      IF(KEXPNT.LE.IOFSET)GO TO 12
      GO TO 10
    9 IF(ABSVLU.GE.1.0)GO TO 12
      IF(KEXPNT.GT.IOFSET)GO TO 12
      ABSVLU=ABSVLU*10.0
      KEXPNT=KEXPNT-1
   10 MAXEXP=MAXEXP-1
      IF(MAXEXP.GE.0)GO TO 8
      ABSVLU=0.0
   11 KEXPNT=0
C
C     ADJUST EXPONENT IF PERCENT, K OR M NOTATION
C     INOTE  = SUBSCRIPT IN LETTER ARRAY OF PERCENT SIGN,
C              K OR M TO BE ADDED AT RIGHT OF NUMBER
C     KDECML = NUMBER OF DIGITS TO SHIFT
   12 IRIGHT=0
      IF(NOTE.LT.0)GO TO 25
      IMINDE=MINDEC
      IMAXDE=MAXDEC
      IF(NOTE.EQ.0)GO TO 16
      IF(NOTE.NE.1)GO TO 13
      INOTE=1
      KDECML=-2
      GO TO 15
   13 IF(KEXPNT.LT.3)GO TO 16
      IF(KEXPNT.GE.6)GO TO 14
      INOTE=2
      KDECML=3
      GO TO 15
   14 INOTE=3
      KDECML=6
   15 IF(MARGIN.GT.0)IRIGHT=MARGIN-1
      LTREND=LTREND-1
      GO TO 17
   16 IF(MARGIN.LE.0)GO TO 19
      INOTE=-1
      IRIGHT=MARGIN
      KDECML=0
   17 LTREND=LTREND-IRIGHT
      IF(MAXEXP.LT.0)GO TO 20
      KEXPNT=KEXPNT-KDECML
      IF(NOTATN.LT.3)GO TO 20
      IF(KDECML.LE.0)GO TO 20
      IF(IMINDE.LT.-1)GO TO 18
      IMINDE=KDECML
      IF(MINDEC.GE.0)IMINDE=MINDEC+IMINDE
   18 IF(IMAXDE.LT.-1)GO TO 20
      IMAXDE=KDECML
      IF(MAXDEC.GE.0)IMAXDE=MAXDEC+IMAXDE
      GO TO 20
   19 INOTE=0
C
C     DECIDE FORMAT IF NUMBER NOT IN SCIENTIFIC NOTATION
C     JPOINT = LOCATION IN IBUFFR OF FINAL PRINTING DIGIT
C     LWIDE  = NUMBER OF DIGITS TO PRINT RIGHT OF DECIMAL
C              POINT
C            = -1, INCLUDE NEITHER DECIMAL POINT NOR DIGITS
C              WHICH WOULD BE RIGHT OF DECIMAL POINT
C     MWIDE  = NUMBER OF CHARACTERS NEEDED FOR EXPONENT
C            = 0, DON'T INCLUDE EXPONENT
   20 JPOINT=LFTCOL
      LEXPNT=KEXPNT+1
      IF(IFZERO.EQ.0)GO TO 22
      IF(MAXEXP.LT.0)GO TO 21
      IF(KEXPNT.GE.0)GO TO 22
      KEXPNT=KEXPNT+1
   21 JPOINT=JPOINT-1
   22 IF(KEXPNT.GT.0)JPOINT=JPOINT+KEXPNT
      LWIDE=LTREND-JPOINT-2
      IF(LWIDE.LT.-1)GO TO 44
      MWIDE=0
      IF(IMAXDE.LT.-1)GO TO 23
      IF(LWIDE.GT.IMAXDE)LWIDE=IMAXDE
   23 IF(MAXEXP.LT.0)GO TO 24
      IF(MAXSIG.LE.0)GO TO 24
      I=MAXSIG-LEXPNT
      IF(I.LT.0)GO TO 44
      IF(LWIDE.GT.I)LWIDE=I
   24 IF(LWIDE.LT.IMINDE)GO TO 44
      GO TO 32
C
C     DECIDE FORMAT IF NUMBER IN SCIENTIFIC NOTATION
   25 MWIDE=2
      LWIDE=LTREND-LFTCOL-2
      IF(KEXPNT.NE.0)GO TO 26
      IF(IZERO.LT.0)GO TO 30
   26 I=KEXPNT
      IF(I.GE.0)GO TO 27
      MWIDE=MWIDE+1
      I=-I
   27 IF(I.LT.10)GO TO 28
      MWIDE=MWIDE+1
      I=I/10
      GO TO 27
   28 NWIDE=MWIDE
      IF(MWIDE.LE.IEXPNT)MWIDE=IEXPNT+1
      IF(IPART.EQ.0)GO TO 29
      IF(MWIDE.LE.JWIDTH)GO TO 30
   29 LWIDE=LWIDE-MWIDE
   30 IF(LWIDE.LT.-1)GO TO 85
      JPOINT=LFTCOL
      IF(IDECML.LT.-1)GO TO 31
      IF(LWIDE.GT.IDECML)LWIDE=IDECML
   31 IERR=LWIDE+1
      IF(IERR.LE.0)IERR=1
   32 IF(LWIDE.GT.0)JPOINT=JPOINT+LWIDE
      JPOINT=JPOINT+1
C
C     SHIFT OUT THE DIGITS
      I=LFTCOL
      J=IOFSET
      IF(MWIDE.NE.0)GO TO 33
      IF(KEXPNT.LT.0)J=J-KEXPNT
   33 LAST=ABSVLU
      IF(J.GT.0)LAST=0
      IF(I.GE.JPOINT)GO TO 34
      I=I+1
      IBUFFR(I)=IDIGIT(LAST+1)
      J=J-1
      IF(J.GE.0)GO TO 33
      ABSVLU=ABSVLU-FLOAT(LAST)
      IF(ABSVLU.LT.0.0)ABSVLU=0.0
      ABSVLU=10.0*ABSVLU
      GO TO 33
C
C     ROUND
   34 I=LFTCOL
   35 I=I+1
      IF(I.GT.JPOINT)GO TO 36
      IF(IBUFFR(I).NE.IDIGIT(11))GO TO 35
      GO TO 39
   36 IF(LAST.LE.4)GO TO 42
      LAST=0
   37 I=I-1
      IF(I.LE.LFTCOL)GO TO 41
      J=1
   38 IF(IBUFFR(I).EQ.IDIGIT(J))GO TO 40
      J=J+1
      IF(J.LT.10)GO TO 38
   39 IBUFFR(I)=JZERO
      GO TO 37
   40 IBUFFR(I)=IDIGIT(J+1)
      IF((LFTCOL-KEXPNT).GE.I)LEXPNT=LEXPNT+1
      GO TO 35
   41 IOFSET=IOFSET+1
      GO TO 2
C
C     TEST IF HAVE ENOUGH SIGNIFICANT DIGITS
C     (ROUNDING CAN INCREASE NUMBER SO MUST DO NOW)
   42 IF(MWIDE.NE.0)GO TO 45
      IF(MAXEXP.LT.0)GO TO 45
      I=LEXPNT
      IF(LWIDE.GT.0)I=I+LWIDE
      IF(I.LT.0)I=0
      IF(MAXSIG.LE.0)GO TO 43
      IF(I.GT.MAXSIG)GO TO 41
   43 IF(I.GE.MINSIG)GO TO 45
C
C     FLOATING POINT WILL NOT FIT SO FORCE SCIENTIFIC
   44 NOTE=-1
      GO TO 1
C
C     INSERT PERIOD AND/OR TRIM OFF RIGHTMOST ZEROES
   45 JRIGHT=IRIGHT
      J=JPOINT
      IF(LWIDE.GE.0)JPOINT=JPOINT+1
      I=JPOINT
      L=KLIP
   46 IF(LWIDE.GE.0)GO TO 47
      IF(J.LE.LFTCOL)GO TO 57
      GO TO 49
   47 LWIDE=LWIDE-1
      IF(LWIDE.GE.0)GO TO 48
      J=J+1
      IF(L.LE.-3)GO TO 53
      IF(L.GE.3)GO TO 50
      IBUFFR(I)=IDOT
      GO TO 56
   48 IF(J.LE.LFTCOL)GO TO 56
   49 IF(L.EQ.0)GO TO 55
      IF(IBUFFR(J).NE.JZERO)GO TO 55
      IF(LWIDE.LT.0)GO TO 55
      IF(KLIP.LE.-2)GO TO 53
      IF(KLIP.GE.2)GO TO 50
      IF(LWIDE.LE.0)GO TO 55
      IF(KLIP.LT.0)GO TO 53
   50 IF(MWIDE.NE.0)GO TO 51
      IF(INOTE.GT.0)GO TO 54
      GO TO 52
   51 IF(IPART.NE.0)GO TO 52
      IF(IZERO.GT.0)GO TO 54
      IF(KEXPNT.NE.0)GO TO 54
   52 IRIGHT=IRIGHT+1
   53 JPOINT=JPOINT-1
      GO TO 56
   54 IBUFFR(I)=IBLANK
      GO TO 56
   55 IBUFFR(I)=IBUFFR(J)
      IFZERO=0
      L=0
   56 I=I-1
      J=J-1
      GO TO 46
C
C     INSURE THAT SHOW AT LEAST 1 DIGIT IF INIZRO.LT.0
   57 IF(IFZERO.EQ.0)GO TO 58
      IF(IFZERO.GT.0)GO TO 82
      IFZERO=0
      GO TO 1
C
C     INSERT EXPONENT
   58 IF(IPART.LE.0)GO TO 59
      IRIGHT=JRIGHT
      JPOINT=LFTCOL
      INOTE=0
      MINUS=0
   59 LTREND=LFTCOL+JWIDTH
      IF(MWIDE.EQ.0)GO TO 69
      IF(IPART.LT.0)GO TO 70
      IF(KEXPNT.NE.0)GO TO 60
      IF(IZERO.LT.0)GO TO 70
      IF(IZERO.EQ.0)GO TO 68
   60 K=JPOINT+1
      IBUFFR(K)=JEXPNT
      L=0
      IF(KEXPNT.GE.0)GO TO 62
      KEXPNT=-KEXPNT
      IF(IFORMT.EQ.3)GO TO 61
      K=K+1
      IBUFFR(K)=IMINUS
      GO TO 62
   61 L=1
   62 IF(IFORMT.NE.0)GO TO 63
      JPOINT=JPOINT+NWIDE
      IRIGHT=IRIGHT+MWIDE-NWIDE
      GO TO 64
   63 JPOINT=JPOINT+MWIDE
   64 I=JPOINT
   65 J=KEXPNT
      KEXPNT=KEXPNT/10
      J=J-(10*KEXPNT)+1
      IBUFFR(I)=IDIGIT(J)
      IF(J.NE.1)GO TO 67
      IF(I.EQ.JPOINT)GO TO 67
      IF(KEXPNT.NE.0)GO TO 67
      IF(IFORMT.EQ.1)GO TO 67
      IF(L.EQ.0)GO TO 66
      L=0
      IBUFFR(I)=IMINUS
      GO TO 67
   66 IBUFFR(I)=IBLANK
   67 I=I-1
      IF(I.GT.K)GO TO 65
      GO TO 70
C
C     BLANK OUT A ZERO EXPONENT
   68 IRIGHT=IRIGHT+MWIDE
      GO TO 70
C
C     INSERT PERCENT SIGN, K OR M
   69 IERR=0
      IF(INOTE.LE.0)GO TO 70
      JPOINT=JPOINT+1
      IBUFFR(JPOINT)=LETTER(INOTE)
C
C     JUSTIFY THE NUMBER
   70 IF(JPOINT.EQ.LFTCOL)GO TO 83
      J=LTREND-JPOINT-IRIGHT
      IF(MINUS.EQ.0)GO TO 71
      IF(J.LE.1)GO TO 76
      IF(JSTIFY.GE.0)GO TO 72
      J=1
      GO TO 76
   71 IF(JSTIFY.LT.0)GO TO 83
   72 IF(JSTIFY.NE.0)GO TO 75
      IF(MINUS.LT.0)GO TO 73
      IF(MINUS.NE.2)GO TO 74
   73 J=J+1
   74 IF(JWIDTH.EQ.(2*(JWIDTH/2)))J=J+1
      J=J/2
   75 IF(J.LE.0)GO TO 83
   76 I=JPOINT
      J=J+JPOINT
      JPOINT=J
   77 IF(I.LE.LFTCOL)GO TO 78
      IBUFFR(J)=IBUFFR(I)
      J=J-1
      I=I-1
      GO TO 77
   78 IF(MINUS.LT.0)GO TO 79
      IF(MINUS.NE.2)GO TO 81
      IBUFFR(J)=IPLUS
      GO TO 80
   79 IBUFFR(J)=IMINUS
   80 J=J-1
   81 IF(J.LE.LFTCOL)GO TO 83
      IBUFFR(J)=IBLANK
      GO TO 80
C
C     FILL OUT REST OF FIELD WITH BLANKS
   82 JPOINT=LFTCOL
      LTREND=LFTCOL+JWIDTH
   83 IF(IFILL.LE.0)GO TO 87
   84 IF(JPOINT.GE.LTREND)GO TO 87
      JPOINT=JPOINT+1
      IBUFFR(JPOINT)=IBLANK
      GO TO 84
C
C     FILL FIELD WITH ASTERISKS IF NUMBER CANNOT FIT
   85 JPOINT=LFTCOL
      LTREND=LFTCOL+JWIDTH
      IERR=-1
   86 IF(JPOINT.GE.LTREND)GO TO 87
      JPOINT=JPOINT+1
      IBUFFR(JPOINT)=ISTAR
      GO TO 86
C
C     RETURN TO CALLING PROGRAM
   87 KOUNT=JPOINT
      RETURN
C762754596768%
      END
      SUBROUTINE DAROME(KONTRL,NUMBER,LETTER,KOUNT,LFTCOL,
     1MAX)
C     RENBR(/ROMAN NUMERAL GENERATOR)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERISTY
C
C     KONTRL = 0, LEFT JUSTIFIES AT LFTCOL OR AT KOUNT+1
C              IF KOUNT IS GREATER THAN LFTCOL.
C            = 1, RIGHT JUSTIFIES AT LFTCOL.
C     NUMBER = NUMBER TO BE REPRESENTED.
C     LETTER = ARRAY TO RECIEVE ALPHAMERIC CODES.
C     KOUNT  = INPUT CONTAINING THE NUMBER OF LOCATIONS
C              IN LETTER ARRAY ALREADY IN USE AND TO BE
C              PRESERVED.  OUTPUT CONTAINING NUMBER OF
C              LOCATIONS IN USE INCLUDING THOSE USED
C              FOR THE ROMAN NUMERAL.  KOUNT IS RETURNED
C              UNCHANGED IF AN ERROR TOOK PLACE
C              (EITHER A NUMBER OUTSIDE RANGE WHICH CAN
C              BE REPRESENTED, OR INSUFFICIENT ROOM).
C     LFTCOL = LOCATION OF NEW NUMBER.
C            = CHARACTERS LEFT OF NUMBER IF KONTRL = 0.
C            = POSITION OF RIGHT DIGIT IF KONTRL = 1.
C     MAX    = DIMENSION OF LETTER ARRAY.
C
      DIMENSION LETTER(MAX),IROME(7)
      DATA IROME/1HI,1HV,1HX,1HL,1HC,1HD,1HM/
      DATA IBLANK/1H /
C
C     DISECT NUMBER
      IF(NUMBER.GT.3999)GO TO 15
C     REMOVE FOLLOWING STATEMENT TO SHOW ZERO AS SPACES
      IF(NUMBER.LE.0)GO TO 15
      N=KOUNT+1
      I=NUMBER
      K=-1
    1 M=KOUNT
      IF(I.LT.0)GO TO 15
      IF(I.EQ.0)GO TO 5
      J=I
      I=I/10
      J=J-10*I
      K=K+2
      L=0
      IF(J.LE.3)GO TO 4
      L=K+1
      J=J-5
      IF(J.NE.4)GO TO 2
      L=L+1
      J=-1
C
C     INSERT INITIAL ONE'S CHARACTER
    2 IF(J.NE.-1)GO TO 3
      IF(KOUNT.GE.MAX)GO TO 14
      KOUNT=KOUNT+1
      LETTER(KOUNT)=IROME(K)
C
C     INSERT FIVE'S OR TEN'S CHARACTER
    3 IF(L.EQ.0)GO TO 4
      IF(KOUNT.GE.MAX)GO TO 14
      KOUNT=KOUNT+1
      LETTER(KOUNT)=IROME(L)
C
C     INSERT UP TO 3 ONE'S CHARACTERS
    4 IF(J.LE.0)GO TO 9
      IF(KOUNT.GE.MAX)GO TO 14
      KOUNT=KOUNT+1
      LETTER(KOUNT)=IROME(K)
      J=J-1
      GO TO 4
C
C     ADJUST MARGINS AND INSERT FILLER BLANKS IF NEEDED
    5 IF(KONTRL.EQ.0)GO TO 6
      IF(KOUNT.GT.LFTCOL)GO TO 14
      KOUNT=LFTCOL
      GO TO 7
    6 KOUNT=KOUNT+LFTCOL-N+1
      IF(LFTCOL.LT.(N-1))KOUNT=M+1
    7 IF(KOUNT.EQ.M)GO TO 15
      IF(KOUNT.GT.MAX)GO TO 14
      J=M+1
      DO 8 I=J,KOUNT
    8 LETTER(I)=IBLANK
      I=-1
C
C     SHIFT NEW NUMERALS INTO LEFT END OF ARRAY.
C     THIS IS A GENERAL PROCEDURE TO SWAP ADJACENT
C     SECTIONS WITHIN AN ARRAY.  THE LOWER SECTION
C     EXTENDS FROM N THROUGH M.  THE UPPER SECION
C     EXTENDS FROM M+1 THROUGH KOUNT.
    9 IF(N.GT.M)GO TO 1
      IF(M.EQ.KOUNT)GO TO 1
      II=0
      JJ=KOUNT
   10 J=N+JJ-M-1
      KK=LETTER(JJ)
   11 II=II+1
      L=LETTER(J)
      LETTER(J)=KK
      KK=L
      IF(J.GT.M)GO TO 12
      J=J+KOUNT-M
      GO TO 11
   12 IF(J.EQ.JJ)GO TO 13
      J=N+J-M-1
      GO TO 11
   13 IF(II.EQ.(KOUNT-N+1))GO TO 1
      JJ=JJ-1
      GO TO 10
C
C     RETURN TO CALLING PROGRAM
   14 KOUNT=N-1
   15 RETURN
C336670692127
      END
      SUBROUTINE DALEAD(INITYP,NXTTYP,ITRAIL,KWRDLO,KWRDHI,
     1    KWORD ,KCNTLO,KCNTHI,KCOUNT,NUMTYP,LWRDLO,LWRDHI,
     2    LWORD ,LCNTLO,LCNTHI,LCOUNT,IBUFFR,MAXBFR,LOWBFR,
     3    KIND  ,KOMAND,KWRDID,KCNTID,LOCAL ,LWRDID,LCNTID,
     4    INITAL,IVALUE,VALUE ,IFLOAT)
C     RENBR(/RETURN COMMAND AND NUMERIC OR WORD ARGUMENT)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO IDENTIFY A COMMAND WORD  AND  A  FOLLOWING
C     ASSOCIATED WORD, ASSOCIATED NUMBER OR ASSOCIATED TEXT
C     STRING WHICH IS MARKED AT BOTH ENDS BY APOSTROPHES.
C
C     THE FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY,  AND
C     ARE RETURNED UNCHANGED.
C
C     INITYP = IF REPRESENTATION OF NUMBER IS FOUND OUTSIDE
C              RANGE  OF  COMMAND,  THEN  INITYP  SPECIFIES
C              WHETHER VALUE IS TO BE RETURNED  AS  INTEGER
C              ARGUMENT  IVALUE  OR AS REAL ARGUMENT VALUE.
C              NUMBER  CAN  BE  TYPED  WITH  DECIMAL  POINT
C              AND/OR   EXPONENT  REGARDLESS  OF  VALUE  OF
C              INITYP.
C            = -2, IF REPRESENTATION  OF  NUMBER  IS  FOUND
C              OUTSIDE RANGE OF COMMAND, THEN IT IS TREATED
C              AS UNKNOWN SEQUENCE OF CHARACTERS, AND  KIND
C              IS RETURNED CONTAINING VALUE 7.
C            = -1, VALUE IS CALCULATED AS OCTAL INTEGER AND
C              RETURNED   AS   ARGUMENT  IVALUE.   HOWEVER,
C              NUMBER FOLLOWING LETTER  E  OF  EXPONENT  IS
C              EVALUATED IN DECIMAL.
C            = 0, VALUE IS CALCULATED  AS  DECIMAL  INTEGER
C              AND IS RETURNED AS ARGUMENT IVALUE.
C            = 1 OR GREATER,  VALUE  IS  RETURNED  AS  REAL
C              ARGUMENT  VALUE.   IF  POSSIBLE, REAL NUMBER
C              WILL BE  ACCUMULATED  AS  INTEGER,  THEN  BE
C              CONVERTED  TO REAL AND SHIFTED AS NECESSARY.
C              INITYP  IS  MAXIMUM  NUMBER  OF  DIGITS   IN
C              INTEGER.
C     NXTTYP = IF REPRESENTATION OF NUMBER IS FOUND  WITHIN
C              RANGE  OF  COMMAND,  THEN  NXTTYP  SPECIFIES
C              WHETHER VALUE IS TO BE RETURNED  AS  INTEGER
C              ARGUMENT  IVALUE  OR AS REAL ARGUMENT VALUE.
C              NUMBER  CAN  BE  TYPED  WITH  DECIMAL  POINT
C              AND/OR   EXPONENT  REGARDLESS  OF  VALUE  OF
C              NXTTYP.
C            = -3, WHETHER NUMBER IS INTERPRETED  AS  OCTAL
C              INTEGER  OR AS DECIMAL INTEGER OR AS DECIMAL
C              REAL,  AND  WHETHER  VALUE  IS  RETURNED  IN
C              ARGUMENT  IVALUE  OR  VALUE  IS SPECIFIED BY
C              NUMTYP ARRAY ENTRY HAVING SAME SUBSCRIPT  AS
C              KCOUNT  ARRAY  ENTRY  CONTAINING  NUMBER  OF
C              CHARACTERS IN COMMAND.  CALLING PROGRAM MUST
C              NOT  CHANGE  VALUE  OF  KCNTID  RETURNED  BY
C              PREVIOUS CALL TO THIS ROUTINE IF  NXTTYP  IS
C              SET TO -3.
C            = -2, IF REPRESENTATION  OF  NUMBER  IS  FOUND
C              WITHIN  RANGE OF COMMAND, THEN IT IS TREATED
C              AS UNKNOWN SEQUENCE OF CHARACTERS, AND  KIND
C              IS   RETURNED   CONTAINING  VALUE  7  OR  14
C              DEPENDING  UPON  WHETHER  COMMAND  WORD  WAS
C              FOUND BY CURRENT CALL TO THIS ROUTINE.
C            = -1, VALUE IS CALCULATED AS OCTAL INTEGER AND
C              RETURNED   AS   ARGUMENT  IVALUE.   HOWEVER,
C              NUMBER FOLLOWING LETTER  E  OF  EXPONENT  IS
C              EVALUATED IN DECIMAL.
C            = 0, VALUE IS CALCULATED  AS  DECIMAL  INTEGER
C              AND IS RETURNED AS ARGUMENT IVALUE.
C            = 1 OR GREATER,  VALUE  IS  RETURNED  AS  REAL
C              ARGUMENT  VALUE.   IF  POSSIBLE, REAL NUMBER
C              WILL BE  ACCUMULATED  AS  INTEGER,  THEN  BE
C              CONVERTED  TO REAL AND SHIFTED AS NECESSARY.
C              NXTTYP  IS  MAXIMUM  NUMBER  OF  DIGITS   IN
C              INTEGER.
C     ITRAIL = SELECTS  WHETHER   EXPONENTS   ARE   TO   BE
C              RECOGNIZED.   IF  NOT, THEN EACH NUMBER WILL
C              TERMINATE PRIOR TO EXPONENT, AND LOWBFR WILL
C              BE  RETURNED  POINTING  TO  LETTER  STARTING
C              EXPONENT.
C            = -1, EXPONENTS EXPRESSED IN E NOTATION ARE TO
C              BE  RECOGNIZED, BUT PERCENT SIGN AND LETTERS
C              K AND M ARE TO BE TREATED SAME AS ANY  OTHER
C              ALPHABETIC CHARACTERS.
C            = 0,  NO  EXPONENTS  ARE   TO  BE  RECOGNIZED.
C              NUMBERS  WILL BE TERMINATED PRIOR TO PERCENT
C              SIGNS OR TO LETTERS E OR K OR M.
C            = 1, PERCENT  SIGNS,  LETTERS  K  AND  M,  AND
C              EXPONENTS EXPRESSED IN E NOTATION ARE ALL TO
C              BE RECOGNIZED.
C     KWRDLO = SUBSCRIPT  OF  LOCATION   IN   KWORD   ARRAY
C              CONTAINING  FIRST CHARACTER OF FIRST COMMAND
C              WORD WHICH CAN BE RECOGNIZED.
C     KWRDHI = SUBSCRIPT  OF  LOCATION   IN   KWORD   ARRAY
C              CONTAINING  FINAL CHARACTER OF FINAL COMMAND
C              WORD WHICH CAN BE RECOGNIZED.
C     KWORD  = ARRAY CONTAINING CHARACTERS OF COMMAND WORDS
C              WHICH  CAN  BE  RECOGNIZED,  1 CHARACTER PER
C              ARRAY LOCATION AS THOUGH READ BY MULTIPLE OF
C              A1 FORMAT OR DEFINED BY SEVERAL 1H FIELDS.
C     KCNTLO = SUBSCRIPT  OF  LOCATION  IN   KCOUNT   ARRAY
C              CONTAINING  NUMBER  OF  CHARACTERS  IN FIRST
C              COMMAND WORD WHICH CAN  BE  RECOGNIZED.   IF
C              KCNTLO  IS  GREATER  THAN  KCNTHI,  THEN  NO
C              COMMAND WORDS  CAN  BE  RECOGNIZED,  CAUSING
C              KIND  TO  ALWAYS BE RETURNED CONTAINING 7 OR
C              LESS.
C     KCNTHI = SUBSCRIPT  OF  LOCATION  IN   KCOUNT   ARRAY
C              CONTAINING  NUMBER  OF  CHARACTERS  IN FINAL
C              COMMAND WORD WHICH CAN BE RECOGNIZED.
C     KCOUNT = ARRAY CONTAINING IN LOCATIONS KCOUNT(KCNTLO)
C              THROUGH AND INCLUDING KCOUNT(KCNTHI) NUMBERS
C              OF CHARACTERS IN  EACH  OF  SEVERAL  COMMAND
C              WORDS  WHICH  CAN  BE  RECOGNIZED.  NEGATIVE
C              ENTRY  IN  KCOUNT  ARRAY  CAUSES  NUMBER  OF
C              CHARACTERS  INDICATED  BY  ABSOLUTE VALUE OF
C              NEGATIVE NUMBER TO BE SKIPPED OVER IN  KWORD
C              ARRAY WITHOUT FORMING RECOGNIZABLE WORD.
C     NUMTYP = SPECIFIES  MANNER   IN   WHICH   NUMBER   IS
C              EVALUATED  IF  NUMBER  IS  WITHIN  RANGE  OF
C              COMMAND AND IF NXTTYP=-3.  WHETHER NUMBER IS
C              INTERPRETED  AS  OCTAL INTEGER OR AS DECIMAL
C              INTEGER OR  AS  DECIMAL  REAL,  AND  WHETHER
C              VALUE  IS  RETURNED  IN  ARGUMENT  IVALUE OR
C              VALUE IS SPECIFIED  BY  NUMTYP  ARRAY  ENTRY
C              HAVING  SAME SUBSCRIPT AS KCOUNT ARRAY ENTRY
C              CONTAINING NUMBER OF CHARACTERS IN  COMMAND.
C              IF  NXTTYP  IS  GREATER THAN -3, THEN NUMTYP
C              ARRAY  IS  IGNORED.   VALUES  OF  INDIVIDUAL
C              ENTRIES  WITHIN  NUMTYP  ARRAY  ARE  DEFINED
C              SIMILARLY   TO   THOSE   OF   NONDIMENSIONED
C              ARGUMENT  NXTTYP  (OTHER THAN NXTTYP=-3) AND
C              ARE AS FOLLOW
C            = -2, IF REPRESENTATION  OF  NUMBER  IS  FOUND
C              WITHIN  RANGE OF COMMAND, THEN IT IS TREATED
C              AS UNKNOWN SEQUENCE OF CHARACTERS, AND  KIND
C              IS   RETURNED   CONTAINING  VALUE  7  OR  14
C              DEPENDING  UPON  WHETHER  COMMAND  WORD  WAS
C              FOUND BY CURRENT CALL TO THIS ROUTINE.
C            = -1, VALUE IS CALCULATED AS OCTAL INTEGER AND
C              RETURNED   AS   ARGUMENT  IVALUE.   HOWEVER,
C              NUMBER FOLLOWING LETTER  E  OF  EXPONENT  IS
C              EVALUATED IN DECIMAL.
C            = 0, VALUE IS CALCULATED  AS  DECIMAL  INTEGER
C              AND IS RETURNED AS ARGUMENT IVALUE.
C            = 1 OR GREATER,  VALUE  IS  RETURNED  AS  REAL
C              ARGUMENT  VALUE.   IF  POSSIBLE, REAL NUMBER
C              WILL BE  ACCUMULATED  AS  INTEGER,  THEN  BE
C              CONVERTED  TO REAL AND SHIFTED AS NECESSARY.
C              NUMTYP(KCNTID) IS MAXIMUM NUMBER  OF  DIGITS
C              IN INTEGER.
C     LWRDLO = SUBSCRIPT  OF  LOCATION   IN   LWORD   ARRAY
C              CONTAINING    FIRST   CHARACTER   OF   FIRST
C              ASSOCIATED WORD WHICH CAN BE RECOGNIZED.
C     LWRDHI = SUBSCRIPT  OF  LOCATION   IN   LWORD   ARRAY
C              CONTAINING    FINAL   CHARACTER   OF   FINAL
C              ASSOCIATED WORD WHICH CAN BE RECOGNIZED.
C     LWORD  = ARRAY CONTAINING  CHARACTERS  OF  ASSOCIATED
C              WORDS  WHICH  CAN BE RECOGNIZED, 1 CHARACTER
C              PER  ARRAY  LOCATION  AS  THOUGH   READ   BY
C              MULTIPLE  OF A1 FORMAT OR DEFINED BY SEVERAL
C              1H FIELDS.
C     LCNTLO = SUBSCRIPT  OF  LOCATION  IN   LCOUNT   ARRAY
C              CONTAINING  NUMBER  OF  CHARACTERS  IN FIRST
C              ASSOCIATED WORD WHICH CAN BE RECOGNIZED.  IF
C              LCNTLO  IS  GREATER  THAN  LCNTHI,  THEN  NO
C              ASSOCIATED WORDS CAN BE RECOGNIZED  SO  THAT
C              KIND  CANNOT  BE  RETURNED  WITH  EITHER  OF
C              VALUES 4 OR 11.
C     LCNTHI = SUBSCRIPT  OF  LOCATION  IN   LCOUNT   ARRAY
C              CONTAINING  NUMBER  OF  CHARACTERS  IN FINAL
C              ASSOCIATED WORD WHICH CAN BE RECOGNIZED.
C     LCOUNT = ARRAY CONTAINING IN LOCATIONS LCOUNT(LCNTLO)
C              THROUGH AND INCLUDING LCOUNT(LCNTHI) NUMBERS
C              OF CHARACTERS IN EACH OF SEVERAL  ASSOCIATED
C              WORDS  WHICH  CAN  BE  RECOGNIZED.  NEGATIVE
C              ENTRY  IN  LCOUNT  ARRAY  CAUSES  NUMBER  OF
C              CHARACTERS  INDICATED  BY  ABSOLUTE VALUE OF
C              NEGATIVE NUMBER TO BE SKIPPED OVER IN  LWORD
C              ARRAY WITHOUT FORMING RECOGNIZABLE WORD.
C     IBUFFR = INPUT BUFFER  ARRAY,  CONTAINING  CHARACTERS
C              TYPED  BY  USER  AND  READ BY MULTIPLE OF A1
C              FORMAT, WHICH IS TO BE  SEARCHED  FOR  KNOWN
C              COMMAND   WORDS,   KNOWN  ASSOCIATED  WORDS,
C              NUMBERS AND  QUOTED  TEXT  STRINGS.   IBUFFR
C              THEN   CONTAINS  1  CHARACTER  PER  COMPUTER
C              STORAGE LOCATION.
C     MAXBFR = SUBSCRIPT OF FINAL (RIGHTMOST)  LOCATION  IN
C              IBUFFR ARRAY WHICH CAN BE SEARCHED FOR KNOWN
C              WORDS, NUMBERS AND QUOTED TEXT STRINGS.
C
C     THE  FOLLOWING  ARGUMENTS  MUST  BE  SET  BY  CALLING
C     PROGRAM BEFORE THIS ROUTINE IS FIRST CALLED, THEN ARE
C     RETURNED BY THIS ROUTINE CONTAINING INFORMATION TO BE
C     USED  BY  CALLING  PROGRAM AND, USUALLY, TO BE PASSED
C     UNCHANGED TO SUBSEQUENT CALL TO THIS ROUTINE.
C
C     LOWBFR = SHOULD BE INPUT CONTAINING SUBSCRIPT  WITHIN
C              IBUFFR  ARRAY  OF FIRST (LEFTMOST) CHARACTER
C              WHICH CAN BE SCANNED  FOR  KNOWN  WORDS  AND
C              NUMBERS  AND QUOTED TEXT STRINGS.  LOWBFR IS
C              RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY   LOCATION   TO   RIGHT  OF  RIGHTMOST
C              CHARACTER OF RIGHTMOST IDENTIFIED ITEM.
C     KIND   = INPUT CONTAINING 0, THIS ROUTINE HAS NOT YET
C              BEEN  CALLED  DURING  EXECUTION  OF  CURRENT
C              LOGICAL SECTION OF  CALLING  PROGRAM.   THIS
C              ROUTINE  IS  TO BEGIN EVALUATION OF CONTENTS
C              OF INPUT TEXT BUFFER, NOT CONTINUE RANGE  OF
C              COMMAND  WORD IDENTIFIED BY PREVIOUS CALL TO
C              THIS ROUTINE.  THE FOLLOWING VALUES OF  KIND
C              ARE  RETURNED  TO CALLING PROGRAM DESCRIBING
C              TYPE OF ITEM  OR  ITEMS  LOCATED  IN  IBUFFR
C              ARRAY.   EXCEPT WHERE MENTIONED BELOW, THESE
C              VALUES  ARE  USUALLY  PASSED  UNCHANGED   TO
C              SUBSEQUENT CALL TO THIS ROUTINE.
C            = 1, EITHER INPUT BUFFER WAS  EMPTY,  OR  ELSE
C              NEXT  PRINTING  CHARACTER  AT OR TO RIGHT OF
C              IBUFFR(LOWBFR),   IGNORING    COMMAS,    WAS
C              EXCLAMATION   POINT.    LOWBFR  IS  RETURNED
C              POINTING  BEYOND  END  OF  BUFFER.   IT   IS
C              EXPECTED  THAT CALLING PROGRAM WILL READ NEW
C              TEXT INTO INPUT BUFFER AND RESET  LOWBFR  TO
C              POINT  TO  FIRST  CHARACTER IN BUFFER BEFORE
C              AGAIN CALLING THIS ROUTINE.  UNLESS KIND  IS
C              CHANGED  TO 3 BY CALLING PROGRAM, SUBSEQUENT
C              CALL TO  THIS  ROUTINE  WILL  RETURN  KOMAND
C              ZEROED   IF   NEW   COMMAND   WORD   IS  NOT
C              IDENTIFIED.
C            = 2, NEXT PRINTING CHARACTER AT OR TO RIGHT OF
C              IBUFFR(LOWBFR),    IGNORING    COMMAS,   WAS
C              SEMICOLON.  LOWBFR IS RETURNED  POINTING  TO
C              CHARACTER   TO   RIGHT  OF  SEMICOLON.   THE
C              SUBSEQUENT CALL TO THIS ROUTINE WILL  RETURN
C              KOMAND  ZEROED  IF  NEW  COMMAND WORD IS NOT
C              IDENTIFIED.
C            = 3, NEXT PRINTING CHARACTER AT OR TO RIGHT OF
C              IBUFFR(LOWBFR),    IGNORING    COMMAS,   WAS
C              AMPERSAND.  LOWBFR  IS  RETURNED  CONTAINING
C              MAXBFR+1.    IT  IS  EXPECTED  THAT  CALLING
C              PROGRAM WILL READ NEW TEXT INTO INPUT BUFFER
C              AND RESET LOWBFR TO POINT TO FIRST CHARACTER
C              IN BUFFER BEFORE AGAIN CALLING THIS ROUTINE.
C              UNLESS  KIND  IS  CHANGED  TO  1  BY CALLING
C              PROGRAM, SUBSEQUENT  CALL  TO  THIS  ROUTINE
C              WILL  RETURN  VALUES  OF  KOMAND, KWRDID AND
C              KCNTID UNCHANGED IF NEW COMMAND WORD IS  NOT
C              IDENTIFIED.
C            = 4, NEXT PRINTING CHARACTERS AT OR  TO  RIGHT
C              OF  IBUFFR(LOWBFR),  IGNORING  COMMAS EXCEPT
C              FOR THEIR USE AS WORD  SEPARATORS,  UNIQUELY
C              IDENTIFIED  ASSOCIATED  WORD  IN  DICTIONARY
C              CONTAINED  IN  LWORD  AND   LCOUNT   ARRAYS.
C              INITAL  IS  RETURNED CONTAINING SUBSCRIPT OF
C              IBUFFR ARRAY LOCATION WHICH  CONTAINS  FIRST
C              CHARACTER OF ASSOCIATED WORD OR ABBREVIATION
C              OF  ASSOCIATED  WORD.   LOWBFR  IS  RETURNED
C              POINTING  TO  CHARACTER  TO RIGHT OF WORD OR
C              WORD ABBREVIATION.  THE SUBSEQUENT  CALL  TO
C              THIS  ROUTINE  WILL RETURN VALUES OF KOMAND,
C              KWRDID AND KCNTID UNCHANGED IF  NEW  COMMAND
C              WORD IS NOT IDENTIFIED.
C            = 5, NEXT PRINTING CHARACTERS AT OR  TO  RIGHT
C              OF  IBUFFR(LOWBFR),  IGNORING  COMMAS EXCEPT
C              FOR THEIR USE AS NUMBER  SEPARATORS,  FORMED
C              NUMBER.   THE VALUE OF NUMBER IS RETURNED IN
C              ARGUMENT IVALUE IF RETURNED AS INTEGER OR IN
C              ARGUMENT  VALUE IF RETURNED  AS REAL NUMBER.
C              INITAL IS RETURNED  CONTAINING SUBSCRIPT  OF
C              IBUFFR ARRAY  LOCATION WHICH  CONTAINS FIRST
C              CHARACTER  OF  NUMBER.   LOWBFR  IS RETURNED
C              POINTING TO CHARACTER TO  RIGHT  OF  NUMBER.
C              THE  SUBSEQUENT  CALL  TO  THIS ROUTINE WILL
C              RETURN VALUES OF KOMAND, KWRDID  AND  KCNTID
C              UNCHANGED   IF   NEW  COMMAND  WORD  IS  NOT
C              IDENTIFIED.
C            = 6, NEXT PRINTING CHARACTER AT OR TO RIGHT OF
C              IBUFFR(LOWBFR), IGNORING LEADING COMMAS, WAS
C              APOSTROPHE WHICH IS POINTED TO  BY  RETURNED
C              VALUE   OF   INITAL.    LOWBFR  IS  RETURNED
C              POINTING TO CHARACTER TO RIGHT OF  RIGHTMOST
C              CHARACTER  WITHIN  QUOTED  TEXT  STRING.  IF
C              QUOTED TEXT  STRING  IS  NOT  TERMINATED  BY
C              UNPAIRED APOSTROPHE, THEN LOWBFR IS RETURNED
C              POINTING TO CHARACTER TO RIGHT OF  RIGHTMOST
C              PRINTING  CHARACTER  IN  BUFFER.   IF QUOTED
C              TEXT  STRING  IS  TERMINATED   BY   UNPAIRED
C              APOSTROPHE,  THEN THIS APOSTROPHE IS CHANGED
C              TO SPACE POINTED TO  BY  RETURNED  VALUE  OF
C              LOWBFR.   IF PAIR OF ADJACENT APOSTROPHES IS
C              FOUND  WITHIN  QUOTED  TEXT   STRING,   THEN
C              PORTION  OF  QUOTED  TEXT STRING TO RIGHT OF
C              PAIR  OF  APOSTROPHES  IS  MOVED   TO   LEFT
C              OVERWRITING  SECOND  APOSTROPHE OF PAIR, AND
C              LOWBFR IS RETURNED POINTING TO CHARACTER  TO
C              RIGHT  OF RIGHTMOST CHARACTER OF QUOTED TEXT
C              STRING IN ITS NEW  LOCATION.   THE  LOCATION
C              VACATED  BY  RIGHTMOST  CHARACTER  IS FILLED
C              WITH SPACE AFTER SHIFT IS COMPLETE.
C            = 7, NEXT PRINTING CHARACTERS AT OR  TO  RIGHT
C              OF  IBUFFR(LOWBFR),  IGNORING  COMMAS EXCEPT
C              FOR  THEIR   USE   AS   CHARACTER   SEQUENCE
C              SEPARATORS,  FORMED  UNKNOWN SEQUENCE.  THIS
C              VALUE OF KIND IS RETURNED ALSO  IF  WORD  OR
C              WORD  ABBREVIATION IS NOT UNIQUE ACROSS BOTH
C              DICTIONARIES, OR  IF  COMMAND  WORD  OR  ITS
C              ABBREVIATION   OR  ASSOCIATED  WORD  OR  ITS
C              ABBREVIATION IS FOLLOWED  BY  ANY  CHARACTER
C              OTHER  THAN  SPACE,  TAB, COMMA, APOSTROPHE,
C              SEMICOLON, EXCLAMATION POINT  OR  AMPERSAND.
C              INITAL  IS  RETURNED CONTAINING SUBSCRIPT OF
C              IBUFFR ARRAY LOCATION WHICH  CONTAINS  FIRST
C              CHARACTER  OF UNKNOWN SEQUENCE OR OF WORD OR
C              ABBREVIATION WHICH IS  FOLLOWED  BY  UNKNOWN
C              SEQUENCE.   LOWBFR  IS  RETURNED POINTING TO
C              FOLLOWING  SPACE,  TAB,  COMMA,  APOSTROPHE,
C              SEMICOLON, EXCLAMATION POINT OR AMPERSAND OR
C              BEYOND  END  OF  LINE  IF  UNKNOWN  PRINTING
C              CHARACTERS  EXTEND THROUGH END OF LINE.  THE
C              SUBSEQUENT CALL TO THIS ROUTINE WILL  RETURN
C              VALUES   OF   KOMAND,   KWRDID   AND  KCNTID
C              UNCHANGED  IF  NEW  COMMAND  WORD   IS   NOT
C              IDENTIFIED.
C            = 8 THROUGH 14, SAME AS KIND VALUES 1  THROUGH
C              7  RESPECTIVELY  EXCEPT THAT COMMAND WORD OR
C              ABBREVATION WAS RECOGNIZED PRIOR TO  END  OF
C              LINE  (8),  SEMICOLON  (9),  AMPERSAND (10),
C              ASSOCIATED WORD (11),  NUMBER  (12),  QUOTED
C              TEXT STRING (13) OR UNKNOWN SEQUENCE (14).
C            = 8, COMMAND WORD EXTENDED  THROUGH  RIGHTMOST
C              PRINTING  CHARACTERS  IN  LINE, OR ELSE NEXT
C              PRINTING CHARACTER TO RIGHT OF COMMAND WORD,
C              IGNORING COMMAS EXCEPT FOR THEIR USE AS WORD
C              SEPARATORS, WAS EXCLAMATION  POINT.   UNLESS
C              KIND  IS  CHANGED  TO 10 BY CALLING PROGRAM,
C              SUBSEQUENT CALL TO THIS ROUTINE WILL  RETURN
C              KOMAND ZEROED UNLESS NEW COMMAND IS FOUND.
C            = 10, NEXT  PRINTING  CHARACTER  TO  RIGHT  OF
C              COMMAND  WORD,  IGNORING  COMMAS  EXCEPT FOR
C              THEIR USE AS WORD SEPARATORS, WAS AMPERSAND.
C              THE  CALLING  PROGRAM  SHOULD  READ NEW TEXT
C              INTO INPUT BUFFER  AND  SUBSEQUENT  CALL  TO
C              THIS    ROUTINE    IS   THEN   TO   CONTINUE
C              INTERPRETATION OF NEW TEXT  AS  THOUGH  THIS
C              COMMAND   WORD  APPEARED  AT  START  OF  NEW
C              CONTENTS OF BUFFER.  UNLESS KIND IS  CHANGED
C              TO  8 BY CALLING PROGRAM, SUBSEQUENT CALL TO
C              THIS ROUTINE WILL RETURN KOMAND, KWRDID  AND
C              KCNTID   UNCHANGED   AND  WILL  RETURN  KIND
C              GREATER THAN 7.
C            = 15, IGNORING COMMAS EXCEPT FOR THEIR USE  AS
C              WORD   TERMINATORS,   COMMAND  WORD  OR  ITS
C              ABBREVIATION WAS FOLLOWED BY  SPACES  AND/OR
C              TABS   AND/OR  COMMAS  AND  THEN  BY  SECOND
C              COMMAND WORD OR ITS ABBREVIATION.  THE FIRST
C              COMMAND  IS IDENTIFIED BY RETURNED VALUES OF
C              KOMAND,  KWRDID  AND  KCNTID.    LOWBFR   IS
C              RETURNED  POINTING  TO  FIRST  CHARACTER  OF
C              SECOND COMMAND WORD WHICH WILL  IN  TURN  BE
C              IDENTIFIED   BY   SUBSEQUENT  CALL  TO  THIS
C              ROUTINE.  IF KIND WAS INPUT CONTAINING VALUE
C              10,  THEN  SECOND  COMMAND WORD IS OF COURSE
C              ACTUALLY FIRST TO APPEAR IN CURRENT CONTENTS
C              OF BUFFER.
C
C     THE  FOLLOWING  ARGUMENTS  ARE  RETURNED  TO  CALLING
C     PROGRAM   IDENTIFYING  COMMAND  WORD  FOUND  BY  THIS
C     ROUTINE OR WHICH IS STILL  IN  EFFECT  FROM  PREVIOUS
C     CALL TO THIS ROUTINE.
C
C     KOMAND = RETURNED  CONTAINING  SEQUENCE   NUMBER   OF
C              CURRENT  COMMAND  WORD  AMONG  ALL  POSSIBLE
C              COMMAND WORDS.  THE SEQUENCE NUMBER DOES NOT
C              INCLUDE  LETTERS  SKIPPED  OVER  BY VALUE OF
C              KWRDLO BEING GREATER THAN 1,  AND  DOES  NOT
C              INCLUDE  LETTERS  SKIPPED  OVER  BY NEGATIVE
C              VALUES ENCOUNTERED IN KCOUNT ARRAY.   KOMAND
C              IS  NUMBER  OF  VALUES IN KCOUNT ARRAY WHICH
C              ARE   GREATER   THAN   ZERO   STARTING    AT
C              KCOUNT(KCNTLO)  UP  TO  AND INCLUDING KCOUNT
C              ARRAY  LOCATION  WHICH  CONTAINS  NUMBER  OF
C              LETTERS    IN    COMMAND   WORD   WHICH   IS
C              SUCCESSFULLY MATCHED.   KOMAND  IS  RETURNED
C              CONTAINING  ZERO IF KIND IS INPUT CONTAINING
C              0, 1, 2, 8 OR 9  INDICATING  THAT  RANGE  OF
C              PREVIOUS COMMAND IS BEING TERMINATED, AND IF
C              KIND IS RETURNED LESS THAN  OR  EQUAL  TO  7
C              INDICATING  THAT  NO  NEW COMMAND WAS FOUND.
C              KOMAND IS  RETURNED  UNCHANGED  IF  KIND  IS
C              INPUT CONTAINING VALUE OTHER THAN 0, 1, 2, 8
C              OR 9, AND IF KIND IS RETURNED LESS  THAN  OR
C              EQUAL TO 7.
C     KWRDID = RETURNED CONTAINING SUBSCRIPT OF KWORD ARRAY
C              LOCATION  WHICH  CONTAINS FIRST CHARACTER OF
C              MATCHED COMMAND WORD.   KWRDID  IS  RETURNED
C              UNCHANGED  IF COMMAND IDENTIFIED BY PREVIOUS
C              CALL TO THIS ROUTINE IS STILL IN EFFECT.
C     KCNTID = RETURNED  CONTAINING  SUBSCRIPT  OF   KCOUNT
C              ARRAY  LOCATION  WHICH  CONTAINS  NUMBER  OF
C              CHARACTERS IN MATCHED COMMAND WORD.   KCNTID
C              IS  RETURNED UNCHANGED IF COMMAND IDENTIFIED
C              BY PREVIOUS CALL TO THIS ROUTINE IS STILL IN
C              EFFECT.
C
C     THE  FOLLOWING  ARGUMENTS  ARE  RETURNED  TO  CALLING
C     PROGRAM  IDENTIFYING ASSOCIATED WORD FOUND IF KIND IS
C     RETURNED CONTAINING EITHER 4 OR 11.  THESE  ARGUMENTS
C     ARE  RETURNED  UNCHANGED IF KIND IS RETURNED WITH ANY
C     VALUE OTHER THAN 4 OR 11.
C
C     LOCAL  = RETURNED  CONTAINING  SEQUENCE   NUMBER   OF
C              ASSOCIATED    WORD    AMONG   ALL   POSSIBLE
C              ASSOCIATED WORDS.  THE SEQUENCE NUMBER  DOES
C              NOT INCLUDE LETTERS SKIPPED OVER BY VALUE OF
C              LWRDLO BEING GREATER THAN 1,  AND  DOES  NOT
C              INCLUDE  LETTERS  SKIPPED  OVER  BY NEGATIVE
C              VALUES ENCOUNTERED IN LCOUNT  ARRAY.   LOCAL
C              IS  NUMBER  OF  VALUES IN LCOUNT ARRAY WHICH
C              ARE   GREATER   THAN   ZERO   STARTING    AT
C              LCOUNT(LCNTLO)  UP  TO  AND INCLUDING LCOUNT
C              ARRAY  LOCATION  WHICH  CONTAINS  NUMBER  OF
C              LETTERS   IN   ASSOCIATED   WORD   WHICH  IS
C              SUCCESSFULLY MATCHED.
C     LWRDID = RETURNED CONTAINING SUBSCRIPT OF LWORD ARRAY
C              LOCATION  WHICH  CONTAINS FIRST CHARACTER OF
C              MATCHED ASSOCIATED WORD.
C     LCNTID = RETURNED  CONTAINING  SUBSCRIPT  OF   LCOUNT
C              ARRAY  LOCATION  WHICH  CONTAINS  NUMBER  OF
C              CHARACTERS IN MATCHED ASSOCIATED WORD.
C
C     THE FOLLOWING ARGUMENTS ARE  USED  ONLY  FOR  OUTPUT.
C     THEIR INPUT VALUES ARE IGNORED.
C
C     INITAL = RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY    LOCATION   WHICH   CONTAINS   FIRST
C              CHARACTER OF ASSOCIATED WORD (KIND  RETURNED
C              AS  4  OR 11), OF NUMBER (KIND RETURNED AS 5
C              OR 12), OR OF UNKNOWN SEQUENCE OF CHARACTERS
C              (KIND  RETURNED AS 7 OR 14).  IF QUOTED TEXT
C              STRING IS FOUND (KIND RETURNED CONTAINING  6
C              OR  13), THEN INITAL IS RETURNED POINTING TO
C              APOSTROPHE AT LEFT END OF STRING.
C     IVALUE = RETURNED CONTAINING VALUE IF NUMBER IS FOUND
C              (KIND BEING RETURNED CONTAINING 5 OR 12) AND
C              IF NUMBER IS  EVALUATED AS  OCTAL INTEGER OR
C              AS DECIMAL INTEGER.
C     VALUE  = RETURNED CONTAINING VALUE IF NUMBER IS FOUND
C              (KIND BEING RETURNED CONTAINING 5 OR 12) AND
C              IF NUMBER IS EVALUATED AS DECIMAL REAL.
C     IFLOAT = SPECIFIES HOW NUMBER WAS EVALUATED.   IFLOAT
C              IS RETURNED SET EQUAL TO INITYP IF NUMBER IS
C              OUTSIDE RANGE OF COMMAND, OR  SET  EQUAL  TO
C              NXTTYP  IF NUMBER IS WITHIN RANGE OF COMMAND
C              AND NXTTYP HAS VALUE GREATER THAN -3, OR SET
C              EQUAL  TO  ENTRY IN NUMTYP ARRAY HAVING SAME
C              SUBSCRIPT  AS  KCOUNT  ARRAY   ENTRY   WHICH
C              SPECIFIES NUMBER OF CHARACTERS IN COMMAND IF
C              NXTTYP=-3.  IFLOAT  IS  RETURNED  UNDEFINED,
C              BUT  PROBABLY  CHANGED,  IF KIND IS RETURNED
C              WITH VALUE OTHER THAN 5 OR 12.
C            = -1, NUMBER WAS EVALUATED  AS  OCTAL  INTEGER
C              AND ITS VALUE IS RETURNED IN IVALUE.
C            = 0, NUMBER WAS EVALUATED AS  DECIMAL  INTEGER
C              AND ITS VALUE IS RETURNED IN IVALUE.
C            = 1  OR  GREATER,  NUMBER  WAS  EVALUATED   AS
C              DECIMAL  REAL  AND  ITS VALUE IS RETURNED IN
C              ARGUMENT NAMED VALUE.
C
      DIMENSION KWORD(KWRDHI),KCOUNT(KCNTHI),
     1NUMTYP(KCNTHI),LWORD(LWRDHI),LCOUNT(LCNTHI),
     2IBUFFR(MAXBFR)
      DATA KOMENT,IEND,IAND,KOMMA,IQUOTE,IBLANK,ITAB/
     11H!,1H;,1H&,1H,,1H',1H ,1H	/
C
C     SET INITIAL CONSTANTS
      IF(KIND.EQ.10)GO TO 15
      IF(KIND.LE.2)GO TO 1
      IF(KIND.EQ.8)GO TO 1
      IF(KIND.NE.9)GO TO 2
    1 KOMAND=0
    2 KIND=1
      GO TO 4
C
C     LOOK FOR NEXT NONBLANK CHARACTERS
    3 LOWBFR=LOWBFR+1
    4 IF(LOWBFR.GT.MAXBFR)GO TO 26
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 3
      IF(LETTER.EQ.ITAB)GO TO 3
      IF(LETTER.EQ.KOMMA)GO TO 3
      IF(LETTER.EQ.IEND)GO TO 25
      IF(LETTER.EQ.IAND)GO TO 23
      IF(LETTER.EQ.KOMENT)GO TO 24
      INITAL=LOWBFR
      IF(LETTER.EQ.IQUOTE)GO TO 18
      LEGAL=0
C
C     TEST IF PRINTING CHARACTERS FORM A COMMAND WORD
      CALL DAVERB(KWRDLO,KWRDHI,KWORD,KCNTLO,KCNTHI,
     1KCOUNT,IBUFFR,MAXBFR,LOWBFR,ITYPE,IMATCH,IWRDID,
     2ICNTID,LCNBFR)
C
C     TEST IF PRINTING CHARACTERS FORM AN ARGUMENT WORD
      JPOINT=INITAL
      CALL DAVERB(LWRDLO,LWRDHI,LWORD,LCNTLO,LCNTHI,
     1LCOUNT,IBUFFR,MAXBFR,JPOINT,JTYPE,JMATCH,JWRDID,
     2JCNTID,LCNBFR)
C
C     IF WORD MATCHES FROM BOTH DICTIONARIES, DECIDE ACTION
      IF(LOWBFR.LT.JPOINT)GO TO 6
      IF(LOWBFR.GT.JPOINT)GO TO 5
      IF(ITYPE.LE.2)GO TO 8
      IF(ITYPE.EQ.JTYPE)GO TO 12
      IF(JTYPE.EQ.3)GO TO 7
      IF(ITYPE.NE.3)GO TO 12
    5 IF(ITYPE.NE.5)LEGAL=-1
      GO TO 12
    6 LOWBFR=JPOINT
    7 IF(JTYPE.NE.5)LEGAL=1
      GO TO 12
C
C     CHECK FOR NUMBER
    8 IF(KOMAND.LE.0)GO TO 10
      IF(NXTTYP.GE.-2)GO TO 9
      IFLOAT=NUMTYP(KCNTID)
      GO TO 11
    9 IFLOAT=NXTTYP
      GO TO 11
   10 IFLOAT=INITYP
   11 CALL DAHEFT(IFLOAT,ITRAIL,0,IBUFFR,MAXBFR,
     1LOWBFR,ITYPE,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE)
      IF(ITYPE.LE.2)GO TO 12
      KIND=KIND+4
      GO TO 26
C
C     CHECK FOLLOWING CHARACTERS
   12 IF(LOWBFR.GT.MAXBFR)GO TO 13
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 13
      IF(LETTER.EQ.ITAB)GO TO 13
      IF(LETTER.EQ.KOMMA)GO TO 13
      IF(LETTER.EQ.IEND)GO TO 13
      IF(LETTER.EQ.IAND)GO TO 13
      IF(LETTER.EQ.KOMENT)GO TO 13
      IF(LETTER.EQ.IQUOTE)GO TO 13
      LOWBFR=LOWBFR+1
      LEGAL=0
      GO TO 12
   13 IF(LEGAL.LT.0)GO TO 14
      IF(LEGAL.GT.0)GO TO 17
      KIND=KIND+6
      GO TO 26
   14 IF(KIND.NE.1)GO TO 16
      KOMAND=IMATCH
      KCNTID=ICNTID
      KWRDID=IWRDID
   15 KIND=8
      GO TO 4
   16 KIND=15
      LOWBFR=INITAL
      GO TO 26
   17 LOCAL=JMATCH
      LCNTID=JCNTID
      LWRDID=JWRDID
      KIND=KIND+3
      GO TO 26
C
C     APOSTROPHE FOUND
   18 KIND=KIND+5
      I=LOWBFR
      J=LOWBFR
   19 IF(I.GE.MAXBFR)GO TO 20
      I=I+1
      J=J+1
      IBUFFR(J)=IBUFFR(I)
      IF(IBUFFR(I).EQ.IBLANK)GO TO 19
      IF(IBUFFR(I).EQ.ITAB)GO TO 19
      LOWBFR=J
      IF(IBUFFR(I).NE.IQUOTE)GO TO 19
      IF(I.GE.MAXBFR)GO TO 22
      IF(IBUFFR(I+1).NE.IQUOTE)GO TO 22
      I=I+1
      GO TO 19
   20 LOWBFR=LOWBFR+1
   21 IF(J.GE.I)GO TO 26
      J=J+1
   22 IBUFFR(J)=IBLANK
      GO TO 21
C
C     AMPERSAND FOUND
   23 KIND=KIND+2
   24 LOWBFR=MAXBFR+1
      GO TO 26
C
C     SEMICOLON FOUND
   25 KIND=KIND+1
      LOWBFR=LOWBFR+1
C
C     RETURN TO CALLING PROGRAM
   26 RETURN
C842625025196!;&'
      END
      SUBROUTINE DATEAM(KONTNU,KONTRL,ITRAIL,NUMMAX,MAXBFR,
     1    IBUFFR,LOWBFR,NUMKNT,KIND  ,NUMVAL,VALNUM)
C     RENBR(/EVALUATE SEVERAL NUMBERS IN SINGLE LINE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     A SINGLE CALL TO DATEAM INTERPRETS AN ARRAY  READ  BY
C     THE  CALLING  PROGRAM WITH A MULTIPLE OF AN A1 FORMAT
C     AND RETURNS ALL OF THE  VALUES  REPRESENTED  IN  THIS
C     ARRAY.   IF  MORE VALUES ARE FOUND THAN CAN BE STORED
C     IN THE ARRAY PROVIDED FOR RETURNING THESE  VALUES  TO
C     THE  CALLING  PROGRAM,  THEN  DATEAM CAN INDICATE THE
C     FIRST CHARACTER OF THE FIRST  EXTRA  NUMBER,  OR  CAN
C     SCAN ACROSS AND POSSIBLY COUNT THE EXCESS NUMBERS.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY  AND  ARE
C     RETURNED UNCHANGED.
C
C     KONTNU = -1, IF MORE VALUES ARE  FOUND  THAN  CAN  BE
C              RETURNED  IN  NUMVAL  OR  VALNUM ARRAY, THEN
C              KIND IS RETURNED CONTAINING 5 AND LOWBFR  IS
C              RETURNED POINTING TO LEFT CHARACTER OF FIRST
C              EXCESS NUMBER.
C            = 0, IF MORE VALUES  ARE  FOUND  THAN  CAN  BE
C              RETURNED  IN  NUMVAL  OR  VALNUM ARRAY, THEN
C              EXCESS VALUES ARE INTERPRETED AND LOWBFR  IS
C              RETURNED  POINTING  BEYOND FINAL NUMBER, BUT
C              NUMKNT IS NOT INCREMENTED FOR  THESE  EXCESS
C              VALUES AND EXCESS VALUES ARE NOT RETURNED TO
C              CALLING PROGRAM.
C            = 1, IF MORE VALUES  ARE  FOUND  THAN  CAN  BE
C              RETURNED  IN  NUMVAL  OR  VALNUM ARRAY, THEN
C              EXCESS VALUES  ARE  INTERPRETED,  LOWBFR  IS
C              RETURNED  POINTING  BEYOND FINAL NUMBER, AND
C              NUMKNT IS INCREMENTED FOR EACH VALUE  FOUND,
C              BUT   EXCESS  VALUES  ARE  NOT  RETURNED  TO
C              CALLING PROGRAM.
C     KONTRL = IF REPRESENTATION OF NUMBER IS FOUND, KONTRL
C              SPECIFIES WHETHER VALUE IS TO BE RETURNED IN
C              INTEGER ARRAY WHICH IS NAMED  NUMVAL  OR  IN
C              REAL  ARRAY  WHICH  IS NAMED VALNUM.  NUMBER
C              CAN  BE  TYPED  WITH  DECIMAL  POINT  AND/OR
C              EXPONENT REGARDLESS OF VALUE OF KONTRL.
C            = -1, VALUE IS CALCULATED AS OCTAL INTEGER AND
C              IS   RETURNED  IN  NUMVAL  ARRAY.   HOWEVER,
C              NUMBER FOLLOWING LETTER  E  OF  EXPONENT  IS
C              EVALUATED IN DECIMAL.
C            = 0, VALUE IS CALCULATED  AS  DECIMAL  INTEGER
C              AND IS RETURNED IN NUMVAL ARRAY.
C            = 1 OR GREATER, VALUE IS  RETURNED  IN  VALNUM
C              ARRAY.   IF  POSSIBLE,  REAL  NUMBER WILL BE
C              ACCUMULATED AS INTEGER, THEN BE CONVERTED TO
C              REAL  AND  SHIFTED  AS NECESSARY.  KONTRL IS
C              MAXIMUM NUMBER OF DIGITS IN INTEGER.
C     ITRAIL = SELECTS  WHETHER   EXPONENTS   ARE   TO   BE
C              RECOGNIZED.   IF  EXPONENTS  ARE  NOT  TO BE
C              RECOGNIZED  BUT  EXPONENT  IS  FOUND,   THEN
C              EVALUATION  OF CONTENTS OF INPUT TEXT BUFFER
C              WILL BE TERMINATED  PRIOR  TO  EXPONENT  AND
C              FIRST  CHARACTER OF EXPONENT WILL BE TREATED
C              SAME  AS  ANY   OTHER   UNKNOWN   ALPHABETIC
C              CHARACTER.   WHEN  SUCH UNKNOWN CHARACTER IS
C              FOUND, KIND IS  RETURNED  CONTAINING  4  AND
C              LOWBFR   IS  RETURNED  POINTING  TO  UNKNOWN
C              CHARACTER.
C            = -1, EXPONENTS EXPRESSED IN E NOTATION ARE TO
C              BE  RECOGNIZED, BUT PERCENT SIGN AND LETTERS
C              K AND M ARE TO BE TREATED SAME AS ANY  OTHER
C              ALPHABETIC CHARACTERS.
C            = 0,  NO  EXPONENTS  ARE   TO  BE  RECOGNIZED.
C              EVALUATION   WILL  BE  TERMINATED  PRIOR  TO
C              PERCENT SIGNS OR TO LETTERS E OR K OR M.
C            = 1, PERCENT  SIGNS,  LETTERS  K  AND  M,  AND
C              EXPONENTS EXPRESSED IN E NOTATION ARE ALL TO
C              BE RECOGNIZED.
C     NUMMAX = HIGHEST SUBSCRIPT OF NUMVAL OR VALNUM  ARRAY
C              LOCATIONS  INTO  WHICH  CAN BE PLACED VALUES
C              REPRESENTED BY CHARACTERS IN IBUFFR ARRAY.
C     MAXBFR = SUBSCRIPT   OF   IBUFFR    ARRAY    LOCATION
C              CONTAINING   RIGHTMOST  (HIGHEST  SUBSCRIPT)
C              CHARACTER IN LINE OF TEXT BEING INTERPRETED.
C              MAXBFR WOULD NORMALLY BE DIMENSION OF IBUFFR
C              ARRAY.
C     IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS  OF
C              LINE   OF   TEXT   TO  BE  INTERPRETED,  ONE
C              CHARACTER PER ARRAY  LOCATION,  AS  READ  BY
C              MULTIPLE OF A1 FORMAT.
C
C     FOLLOWING ARGUMENTS ARE USED BOTH FOR INPUT  TO  THIS
C     ROUTINE AND FOR OUTPUT TO CALLING PROGRAM.
C
C     LOWBFR = INPUT CONTAINING SUBSCRIPT OF  IBUFFR  ARRAY
C              LOCATION  WHICH  CONTAINS  LEFTMOST  (LOWEST
C              SUBSCRIPT)  CHARACTER   WHICH   IS   TO   BE
C              INTERPRETED  BY  THIS  ROUTINE.   LOWBFR  IS
C              RETURNED POINTING TO LEFTMOST CHARACTER  NOT
C              YET  IDENTIFIED  BY THIS ROUTINE.  LOWBFR IS
C              RETURNED  CONTAINING  SUBSCRIPT  OF   IBUFFR
C              ARRAY  LOCATION CONTAINING UNKNOWN CHARACTER
C              (KIND  BEING  RETURNED  CONTAINING   4)   OR
C              CONTAINING  CHARACTER  TO RIGHT OF SEMICOLON
C              (KIND  BEING  RETURNED  CONTAINING  2).   IF
C              KONTNU  IS  SET TO -1 AND IF MORE VALUES ARE
C              FOUND  THAN  CAN  BE  STORED  IN   AVAILABLE
C              PORTION  OF  NUMVAL  OR  VALNUM  ARRAY, THEN
C              LOWBFR IS RETURNED CONTAINING  SUBSCRIPT  OF
C              IBUFFR  ARRAY  LOCATION WHICH CONTAINS FIRST
C              CHARACTER OF FIRST VALUE WHICH COULD NOT  BE
C              STORED.   IF  AMPERSAND OR EXCLAMATION POINT
C              IS FOUND OR IF ALL CHARACTERS IN INPUT  TEXT
C              BUFFER HAVE BEEN INTERPRETED, THEN LOWBFR IS
C              RETURNED  POINTING  BEYOND  RIGHT   END   OF
C              BUFFER.
C     NUMKNT = INPUT  CONTAINING   SUBSCRIPT   OF   HIGHEST
C              LOCATION  IN NUMVAL OR VALNUM ARRAY WHICH IS
C              CURRENTLY IN USE AND WHICH MUST THEREFORE BE
C              RETURNED  UNCHANGED.   FIRST  VALUE FOUND BY
C              THIS   ROUTINE    WILL    BE    STORED    IN
C              NUMVAL(NUMKNT+1) OR IN VALNUM(NUMKNT+1).  IF
C              KONTNU IS LESS THAN OR EQUAL TO ZERO, OR  IF
C              KONTNU IS GREATER THAN ZERO BUT NO MORE THAN
C              NUMMAX-NUMKNT VALUES ARE FOUND, THEN  NUMKNT
C              IS  RETURNED CONTAINING SUBSCRIPT OF HIGHEST
C              LOCATION IN NUMVAL OR VALNUM ARRAY WHICH WAS
C              USED  BY  THIS ROUTINE FOR STORAGE OF VALUES
C              REPRESENTED BY TEXT  IN  IBUFFR  ARRAY.   IF
C              KONTNU  IS  GREATER THAN ZERO, BUT MORE THAN
C              NUMMAX-NUMKNT   VALUES   ARE   FOUND,   THEN
C              LOCATIONS     ABOVE     NUMVAL(NUMMAX)    OR
C              VALNUM(NUMMAX) ARE RETURNED  UNCHANGED,  BUT
C              NUMKNT  IS  RETURNED  INCREMENTED  AS THOUGH
C              THESE EXCESS VALUES HAD BEEN STORED.
C
C     FOLLOWING ARGUMENTS  ARE  USED  ONLY  FOR  OUTPUT  TO
C     CALLING PROGRAM.  THEIR INPUT VALUES ARE IGNORED.
C
C     KIND   = RETURNED DESCRIBING REASON FOR  TRANSFER  OF
C              CONTROL  BACK TO CALLING PROGRAM.  KIND DOES
C              NOT INDICATE WHETHER ANY  VALUES  HAVE  BEEN
C              STORED IN NUMVAL OR VALNUM ARRAY.
C            = 1, ALL CHARACTERS  CURRENTLY  WITHIN  IBUFFR
C              ARRAY  HAVE BEEN INTERPETED.  IF EXCLAMATION
C              POINT WAS FOUND, THEN CHARACTERS TO RIGHT OF
C              EXCLAMATION  POINT  HAVE  BEEN  IGNORED  AND
C              LOWBFR IS RETURNED CONTAINING MAXBFR+1.
C            = 2, SEMICOLON WAS FOUND.  LOWBFR IS  RETURNED
C              POINTING TO CHARACTER TO RIGHT OF SEMICOLON.
C              IF  SEMICOLONS  ARE  TO  BE  CONSIDERED   AS
C              EQUIVALENT  TO  SPACES, THEN CALLING PROGRAM
C              SHOULD AGAIN CALL THIS ROUTINE WITHOUT FIRST
C              CHANGING VALUES OF ANY OF ARGUMENTS.
C            = 3, AMPERSAND WAS FOUND.  CHARACTERS TO RIGHT
C              OF AMPERSAND HAVE BEEN IGNORED AND LOWBFR IS
C              RETURNED CONTAINING MAXBFR+1.  IF  AMPERSAND
C              INDICATES  THAT TEXT REPRESENTING ADDITIONAL
C              VALUES IS TO BE  READ  BY  CALLING  PROGRAM,
C              THEN  LOWBFR  SHOULD  BE  RESET  TO POINT TO
C              START OF NEW TEXT  BEFORE  THIS  ROUTINE  IS
C              CALLED AGAIN.
C            = 4, UNKNOWN CHARACTER WAS FOUND.   LOWBFR  IS
C              RETURNED   CONTAINING  SUBSCRIPT  OF  IBUFFR
C              ARRAY  LOCATION  CONTAINING   THIS   UNKNOWN
C              CHARACTER.   IF  UNKNOWN  CHARACTER IS TO BE
C              CONSIDERED  AS  EQUIVALENT  TO  SPACE,  THEN
C              LOWBFR  MUST  BE  INCREMENTED  BY ONE BEFORE
C              THIS ROUTINE IS CALLED AGAIN.
C            = 5, KONTNU CONTAINS -1 AND  VALUE  WAS  FOUND
C              WHICH  COULD  NOT  BE  STORED  IN  AVAILABLE
C              PORTION OF NUMVAL OR VALNUM  ARRAY.   LOWBFR
C              IS  RETURNED  POINTING TO LEFTMOST CHARACTER
C              IN  REPRESENTATION   OF   NUMBER.    CALLING
C              PROGRAM   MUST  SUPPLY  ADDITONAL  SPACE  IN
C              NUMVAL OR VALNUM ARRAY OR  ELSE  MUST  RESET
C              KONTNU  TO  BE  ZERO OR GREATER BEFORE AGAIN
C              CALLING THIS ROUTINE  TO  PROCESS  REMAINING
C              TEXT IN IBUFFR ARRAY.
C     NUMVAL = ARRAY INTO WHICH ARE STORED  INTEGER  VALUES
C              REPRESENTED  BY  TEXT  IN  IBUFFR  ARRAY  IF
C              KONTRL IS LESS THAN OR EQUAL TO ZERO.
C     VALNUM = ARRAY INTO  WHICH  ARE  STORED  REAL  VALUES
C              REPRESENTED  BY  TEXT  IN  IBUFFR  ARRAY  IF
C              KONTRL IS GREATER THAN ZERO.
C
      DIMENSION NUMVAL(NUMMAX),VALNUM(NUMMAX),
     1IBUFFR(MAXBFR)
      DATA KOMMA,KOMENT,IAND,IEND/1H,,1H!,1H&,1H;/
C
C     OBTAIN NEXT NUMBER
    1 INITAL=LOWBFR
      CALL DAHEFT(KONTRL,ITRAIL,0,IBUFFR,MAXBFR,
     1LOWBFR,ITYPE,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE)
      GO TO (11,2,6),ITYPE
C
C     UNKNOWN CHARACTER FOUND
    2 LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.KOMMA)GO TO 3
      IF(LETTER.EQ.IEND)GO TO 4
      IF(LETTER.EQ.IAND)GO TO 5
      IF(LETTER.EQ.KOMENT)GO TO 10
      KIND=4
      GO TO 12
C
C     SKIP OVER COMMA AND CONTINUE
    3 LOWBFR=LOWBFR+1
      GO TO 1
C
C     SEMICOLON FOUND
    4 KIND=2
      LOWBFR=LOWBFR+1
      GO TO 12
C
C     AMPERSAND FOUND
    5 KIND=3
      LOWBFR=MAXBFR+1
      GO TO 12
C
C     INSERT NEW VALUE INTO THE LIST
    6 IF(NUMKNT.GE.NUMMAX)GO TO 8
      NUMKNT=NUMKNT+1
      IF(KONTRL.GT.0)GO TO 7
      NUMVAL(NUMKNT)=IVALUE
      GO TO 1
    7 VALNUM(NUMKNT)=VALUE
      GO TO 1
C
C     TOO MANY VALUES FOUND
    8 IF(KONTNU.LT.0)GO TO 9
      IF(KONTNU.GT.0)NUMKNT=NUMKNT+1
      GO TO 1
    9 KIND=5
      LOWBFR=INITAL
      GO TO 12
C
C     INPUT BUFFER IS EMPTY
   10 LOWBFR=MAXBFR+1
   11 KIND=1
C
C     RETURN TO CALLING PROGRAM
   12 RETURN
C293727231057!&;
      END
      SUBROUTINE DAJOIN(ITRAIL,IBUFFR,MAXBFR,LOWBFR,KIND  ,
     1    VALUE ,DIVISR,ISHIFT,JSHIFT)
C     RENBR(/EVALUATE FRACTIONS AND MIXED NUMBERS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE EVALUATES THE WHOLE  NUMBERS,  FRACTIONS
C     AND  MIXED  NUMBERS  CONTAINED IN A LINE OF TEXT READ
C     WITH A MULTIPLE OF AN A1 FORMAT.  IF THE FRACTION  OR
C     MIXED  NUMBER  IS  TO  BE MULTIPLED BY 10.0 RAISED TO
C     SOME POWER, THEN THIS EXPONENT  MUST  APPEAR  TO  THE
C     IMMEDATE  RIGHT  OF  THE DENOMINATOR OF THE FRACTION.
C     THE TEXT CONTENTS 1 1/2K OR 1.5K OR  3/2K  WOULD  ALL
C     REPRESENT THE VALUE 1500.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT  AND  ARE
C     RETURNED UNCHANGED.
C
C     ITRAIL = SELECTS  WHETHER   EXPONENTS   ARE   TO   BE
C              RECOGNIZED.   IF  EXPONENTS  ARE  NOT  TO BE
C              RECOGNIZED  BUT  EXPONENT  IS  FOUND,   THEN
C              EVALUATION  OF CONTENTS OF INPUT TEXT BUFFER
C              WILL BE TERMINATED  PRIOR  TO  EXPONENT  AND
C              FIRST  CHARACTER OF EXPONENT WILL BE TREATED
C              SAME  AS  ANY   OTHER   UNKNOWN   ALPHABETIC
C              CHARACTER.   WHEN  SUCH UNKNOWN CHARACTER IS
C              FOUND, KIND IS  RETURNED  CONTAINING  2  AND
C              LOWBFR   IS  RETURNED  POINTING  TO  UNKNOWN
C              CHARACTER.
C            = -1, EXPONENTS EXPRESSED IN E NOTATION ARE TO
C              BE  RECOGNIZED, BUT PERCENT SIGN AND LETTERS
C              K AND M ARE TO BE TREATED SAME AS ANY  OTHER
C              ALPHABETIC CHARACTERS.
C            = 0,  NO  EXPONENTS  ARE  TO  BE   RECOGNIZED.
C              EVALUATION   WILL  BE  TERMINATED  PRIOR  TO
C              PERCENT SIGNS OR TO LETTERS E OR K OR M.
C            = 1, PERCENT  SIGNS,  LETTERS  K  AND  M,  AND
C              EXPONENTS EXPRESSED IN E NOTATION ARE ALL TO
C              BE RECOGNIZED.
C     IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS  OF
C              LINE   OF   TEXT   TO  BE  INTERPRETED,  ONE
C              CHARACTER PER ARRAY  LOCATION,  AS  READ  BY
C              MULTIPLE OF A1 FORMAT.
C     MAXBFR = SUBSCRIPT   OF   IBUFFR    ARRAY    LOCATION
C              CONTAINING   RIGHTMOST  (HIGHEST  SUBSCRIPT)
C              CHARACTER IN LINE OF TEXT BEING INTERPRETED.
C              MAXBFR WOULD NORMALLY BE DIMENSION OF IBUFFR
C              ARRAY.
C
C     FOLLOWING ARGUMENT IS USED BOTH  FOR  INPUT  TO  THIS
C     ROUTINE AND FOR OUTPUT TO CALLING PROGRAM.
C
C     LOWBFR = INPUT CONTAINING SUBSCRIPT OF  IBUFFR  ARRAY
C              LOCATION  WHICH  CONTAINS  LEFTMOST  (LOWEST
C              SUBSCRIPT)  CHARACTER   WHICH   IS   TO   BE
C              INTERPRETED  BY  THIS  ROUTINE.   LOWBFR  IS
C              RETURNED POINTING TO LEFTMOST CHARACTER  NOT
C              YET  IDENTIFIED BY THIS ROUTINE.  IF KIND IS
C              RETURNED  CONTAINING  3  OR  GREATER,   THEN
C              LOWBFR  IS RETURNED POINTING TO CHARACTER TO
C              IMMEDIATE RIGHT OF REPRESENTATION OF NUMBER.
C              IF  KIND  IS  RETURNED  CONTAINING  2,  THEN
C              LOWBFR IS  RETURNED  POINTING  TO  CHARACTER
C              WHICH  COULD  NOT  BE EVALUATED.  IF KIND IS
C              RETURNED  CONTAINING  1,  THEN   LOWBFR   IS
C              RETURNED POINTING BEYOND END OF BUFFER.
C
C     FOLLOWING ARGUMENTS ARE USED FOR OUTPUT ONLY.   THEIR
C     INPUT VALUES ARE IGNORED.
C
C     KIND   = 1, NO PRINTING CHARACTERS APPEARED AT OR  TO
C              THE  RIGHT  OF  IBUFFR(LOWBFR).   LOWBFR  IS
C              RETURNED POINTING BEYOND END OF BUFFER.
C            = 2, UNKNOWN CHARACTER WAS FOUND.   LOWBFR  IS
C              RETURNED   CONTAINING  SUBSCRIPT  OF  IBUFFR
C              ARRAY  LOCATION  CONTAINING   THIS   UNKNOWN
C              CHARACTER.  LOWBFR MUST BE INCREMENTED BY AT
C              LEAST 1 BEFORE THIS ROUTINE IS AGAIN  CALLED
C              TO CONTINUE PROCESSING OF TEXT.
C            = 3,  WHOLE  NUMBER  WAS  FOUND.   LOWBFR   IS
C              RETURNED  POINTING TO CHARACTER TO IMMEDIATE
C              RIGHT OF REPRESENTATION OF WHOLE NUMBER.
C            = 4, MIXED NUMBER CONSISTING OF  WHOLE  NUMBER
C              FOLLOWED  BY  UNSIGNED  FRACTION  WAS FOUND.
C              LOWBFR IS RETURNED POINTING TO CHARACTER  TO
C              IMMEDIATE   RIGHT   OF   REPRESENTATION   OF
C              FRACTION.
C            = 5, FRACTION WAS FOUND.  LOWBFR  IS  RETURNED
C              POINTING  TO CHARACTER TO IMMEDIATE RIGHT OF
C              REPRESENTATION OF FRACTION.
C            = 6, MIXED NUMBER OR  FRACTION  WAS  FOUND  IN
C              WHICH  RIGHTMOST  DENOMINATOR  WAS  MISSING.
C              LOWBFR IS RETURNED POINTING TO CHARACTER  TO
C              RIGHT OF RIGHTMOST SLASH.
C     VALUE  = RETURNED CONTAINING VALUE OF  WHOLE  NUMBER,
C              OR  MIXED  NUMBER  OR  FRACTION  IF  KIND IS
C              RETURNED CONTAINING 3  OR  GREATER.   VALUE,
C              DIVISR,   ISHIFT  AND  JSHIFT  ARE  RETURNED
C              UNDEFINED IF KIND IS RETURNED  CONTAINING  1
C              OR 2.
C     DIVISR = RETURNED CONTAINING VALUE OF DENOMINATOR  IF
C              FRACTION OR MIXED NUMBER IS FOUND.  RETURNED
C              SET TO 1 IF WHOLE NUMBER IS FOUND.
C     ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C              M FOLLOW NUMBER
C            = 1, PERCENT SIGN FOLLOWS NUMBER
C            = 2, K FOLLOWS NUMBER
C            = 3, M FOLLOWS NUMBER
C            = LESS  THAN  ZERO,  RETURNED  IF  E   FOLLOWS
C              NUMBER.
C            = -1, E  AND  POSSIBLY  SIGNED  NUMBER  FOLLOW
C              NUMBER.
C            = -2, E IS FOLLOWED BY PLUS SIGN NOT  IN  TURN
C              FOLLOWED BY DIGITS.
C            = -3, E IS FOLLOWED BY MINUS SIGN NOT IN  TURN
C              FOLLOWED BY DIGITS.
C            = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C     JSHIFT = EXPONENT  INDICATED  BY  FOLLOWING   PERCENT
C              SIGN,  K, M OR E FOLLOWED BY DIGITS.  12.34K
C              OR 12.34E3 OR  12  34/100K  OR  12  34/100E3
C              WOULD  GIVE JSHIFT OF 3.  12% OR 12E-2 WOULD
C              GIVE JSHIFT -2.
C
      DIMENSION IBUFFR(MAXBFR)
C
C     ISPACE CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C     TAB CHARACTER.  IF TAB CHARACTER IS NOT AVAILABLE,
C     ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
      DATA MINUS,IPLUS,ISLASH,ISPACE,ITAB/
     11H-,1H+,1H/,1H ,1H	/
C
C     INITIALIZE
      INITAL=0
      LEVEL=0
      ISIGN=1
      KIND=1
      JTRAIL=10
      IF(ITRAIL.LT.0)JTRAIL=9
      IF(ITRAIL.GT.0)JTRAIL=11
      GO TO 3
C
C     *********************
C     *  SCAN FOR NUMBER  *
C     *********************
C
C     LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
    1 LEVEL=1
    2 LOWBFR=LOWBFR+1
    3 IF(LOWBFR.GT.MAXBFR)GO TO 12
      NOWLTR=IBUFFR(LOWBFR)
C
C     LOOK FOR LEADING SPACES, SIGNS OR SLASHES
      IF(LEVEL.NE.0)GO TO 5
      IF(NOWLTR.EQ.ISPACE)GO TO 2
      IF(NOWLTR.EQ.ITAB)GO TO 2
      IF(NOWLTR.EQ.ISLASH)GO TO 7
      IF(NOWLTR.EQ.IPLUS)GO TO 4
      IF(NOWLTR.NE.MINUS)GO TO 6
      ISIGN=-1
    4 IF(INITAL.NE.0)GO TO 12
      GO TO 6
    5 IF(NOWLTR.EQ.IPLUS)GO TO 12
      IF(NOWLTR.EQ.MINUS)GO TO 12
      IF(NOWLTR.EQ.ISPACE)GO TO 12
      IF(NOWLTR.EQ.ITAB)GO TO 12
      IF(NOWLTR.EQ.ISLASH)GO TO 2
C
C     EVALUATE NUMBER
    6 CALL DAHEFT(1,JTRAIL,0,IBUFFR,MAXBFR,
     1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE)
      IF(KIND.NE.3)GO TO 12
      KSHIFT=KSHIFT-JSHIFT
      IF(KSHIFT.NE.0)VALUE=VALUE*(10.0**KSHIFT)
C
C     MARK THAT ARE IN FRACTION IF FIND SLASH
      IF(ISHIFT.NE.0)GO TO 9
      IF(LOWBFR.GT.MAXBFR)GO TO 9
      IF(IBUFFR(LOWBFR).NE.ISLASH)GO TO 9
      IF(LEVEL.EQ.0)GO TO 8
      LEVEL=-1
      GO TO 10
    7 VALUE=0.0
    8 DIVISR=1.0
      FRACTN=VALUE
      GO TO 1
C
C     *******************************
C     *  NUMBER HAS BEEN EVALUATED  *
C     *******************************
C
C     DIVIDE FRACTION BY NEW DENOMINATOR
    9 IF(LEVEL.EQ.0)GO TO 11
   10 IF(LSHIFT.LE.0)VALUE=1.0
      DIVISR=VALUE
      FRACTN=FRACTN/VALUE
      IF(LEVEL.GT.0)GO TO 13
      GO TO 1
C
C     STORE WHOLE NUMBER AND LOOP BACK FOR FRACTION
   11 IF(INITAL.NE.0)GO TO 12
      IF(ISHIFT.NE.0)GO TO 19
      INITAL=ISIGN
      LOWSAV=LOWBFR
      WHOLE=VALUE
      GO TO 3
C
C     COMBINE WHOLE NUMBER AND FRACTION
   12 ISHIFT=0
      JSHIFT=0
      IF(LEVEL.EQ.0)GO TO 18
      KIND=6
      IF(INITAL.EQ.0)GO TO 17
      GO TO 14
   13 IF(INITAL.EQ.0)GO TO 16
      KIND=4
   14 IF(INITAL.GT.0)GO TO 15
      VALUE=WHOLE-FRACTN
      GO TO 20
   15 VALUE=WHOLE+FRACTN
      GO TO 20
   16 KIND=5
   17 VALUE=FRACTN
      GO TO 20
   18 IF(INITAL.EQ.0)GO TO 21
      LOWBFR=LOWSAV
      VALUE=WHOLE
   19 KIND=3
      DIVISR=1.0
   20 IF(JSHIFT.NE.0)VALUE=VALUE*(10.0**JSHIFT)
      GO TO 22
C
C     SIMULATE NUMBER IF NONE FOUND
   21 VALUE=0.0
      DIVISR=1.0
C
C     RETURN TO CALLING PROGRAM
   22 RETURN
C     INITAL = 0, NO WHOLE NUMBER STORED
C            = -1, NEGATIVE WHOLE NUMBER STORED
C            = 1, POSITIVE WHOLE NUMBER STORED
C     ISIGN  = -1, MINUS SIGN AT START OF NUMBER
C            = 1, NUMBER DOES NOT START WITH MINUS SIGN
C     LEVEL  = 0, A SLASH HAS NOT BEEN FOUND.
C            = 1, THE NUMERATOR OF FRACTION HAS BEEN
C              STORED AND NEED TO GET DENOMINATOR.
C            = -1, A SLASH APPEARS AT RIGHT OF THE
C              DENOMINATOR OF THE FRACTION SO NEED
C              TO CALCULATE NEW NUMERATOR AND THEN
C              GO BACK TO LEVEL=1 STATE.
C510407084164
      END
      SUBROUTINE DAHEFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
     1    LOWBFR,KIND  ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2    VALUE )
C     RENBR(/FREE FORMAT NUMERIC INPUT ROUTINE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAHEFT  INTERPRETS  AN  ARRAY  READ  BY  THE  CALLING
C     PROGRAM  WITH  A MULTIPLE OF AN A1 FORMAT AND RETURNS
C     THE VALUES CONTAINED IN THIS  ARRAY.
C
C     NUMBERS  INTERPRETTED  BY  DAHEFT CAN CONTAIN LEADING
C     SIGN, EMBEDDED DECIMAL POINT AND/OR TRAILING  E  WITH
C     SIGNED EXPONENT.  A PERCENT SIGN FOLLOWING THE NUMBER
C     IMPLIES  E-2,  TRAILING  LETTER  K  IMPLIES  E3   AND
C     TRAILING LETTER M IMPLIES E6.
C
C     ARGUMENT LIST DEFINITIONS:
C
C     KONTRL = 1  OR  GREATER,  ITEM  IN  IBUFFR  ARRAY  IS
C              FLOATING  POINT.   IF POSSIBLE, THE FLOATING
C              POINT  NUMBER  WILL  BE  ACCUMULATED  AS  AN
C              INTEGER, THEN BE CONVERTED TO FLOATING POINT
C              AND SHIFTED IF NECESSARY.   KONTRL  IS  THEN
C              THE MAXIMUM NUMBER OF DIGITS IN THE INTEGER.
C              THE VALUE IS OUTPUT AS THE  ARGUMENT  VALUE.
C              IF  THE  ITEM  HAS  MORE THAN KONTRL DIGITS,
C              THEN  THE  ENTIRE  EVALUATION  IS  DONE   IN
C              FLOATING    POINT.     THE    ADVANTAGE   OF
C              CALCULATING THE  FLOATING  POINT  VALUES  IN
C              INTEGER  AS  LONG  AS  THE  PRECISION OF THE
C              COMPUTER  IS  NOT  OVERFLOWED  IS  THAT  THE
C              CALCULATION  OF  THE  PORTION  OF THE NUMBER
C              RIGHT OF THE DECIMAL POINT  IS  MORE  EXACT.
C              AS  AN EXAMPLE, IF KONTRL IS GREATER THAN OR
C              EQUAL TO 4, THEN THE  NUMBER  33.33  CAN  BE
C              STORED   AS   THE   INTEGER  3333,  THEN  BE
C              CONVERTED TO FLOATING POINT VALUE 3333.0 AND
C              DIVIDED   BY  100.0  TO  OBTAIN   THE  FINAL
C              ANSWER.  IF IT MAKES NO  DIFFERENCE  WHETHER
C              THE NUMBER TYPED AS 33.33 HAS VALUE 33.33 OR
C              33.32999...  THEN KONTRL CAN  BE  GIVEN  THE
C              VALUE 1.
C            = 0, ITEM IN IBUFFR ARRAY IS INTEGER  DECIMAL.
C              THE NUMBER CAN BE TYPED WITH A DECIMAL POINT
C              (FOR EXAMPLE 1.23K OR 1.23E3  EQUALS  1230),
C              BUT  IS  STORED AS AN INTEGER IN DAHEFT, AND
C              IS OUTPUT  AS ARGUMENT IVALUE.   ANY DECIMAL
C              INTEGER WHICH THE COMPUTER CAN REPRESENT CAN
C              BE  EVALUATED.    THIS  INCLUDES,   ON  TWOS
C              COMPLEMENT  COMPUTERS, THE  LARGEST NEGATIVE
C              NUMBER THE ABSOLUTE VALUE OF WHICH CANNOT BE
C              STORED.   ON THE  PDP10,  A 36 BIT  COMPUTER
C              WITH TWOS COMPLEMENT  NOTATION, THE RANGE OF
C              DECIMAL  INTEGERS  IS  -34359738368  THROUGH
C              34359738367  (OCTAL NOTATION OF BIT PATTERNS
C              BEING  400000000000  THROUGH  377777777777).
C            = -1, ITEM IN  IBUFFR  ARRAY  IS  OCTAL.   THE
C              NUMBER  CAN  BE  TYPED  WITH A DECIMAL POINT
C              AND/OR  WITH  AN  EXPONENT.   HOWEVER,   THE
C              NUMBER   FOLLOWING   THE  LETTER  E  OF  THE
C              EXPONENT IS EVALUATED IN DECIMAL.  THE VALUE
C              OF  THE  OCTAL  NUMBER  IS  RETURNED  AS THE
C              ARGUMENT  IVALUE.   IT  MUST  BE NOTED  THAT
C              NUMBERS EVALUATED AS NEGATIVE OCTAL INTEGERS
C              HAVE THE  NEGATIVE  OCTAL  INTEGER  AS THEIR
C              VALUE,  NOT AS  THEIR BIT  REPRESENTATION IN
C              COMPUTER STORAGE.   FOR EXAMPLE, ON A 36 BIT
C              TWOS COMPLEMENT  COMPUTER,  THE OCTAL NUMBER
C              -400000000000 (WHICH COULD  ALSO BE TYPED AS
C              -4E11 OR -4E+11 WHERE  THE 11 AFTER THE E IS
C              IN DECIMAL)  IS REPRESENTED  AS BIT  PATTERN
C              HAVING OCTAL  NOTATION  400000000000 AND THE
C              OCTAL NUMBER -377777777777 IS REPRESENTED BY
C              THE BIT PATTERN 400000000001.
C            = -2, DO  NOT  EVALUATE NUMBERS.   INSTEAD THE
C              CHARACTERS  FORMING NUMBER  ARE TREATED LIKE
C              ANY OTHER PRINTING CHARACTERS.
C     ITRAIL = SPECIFIES  WHETHER  EXPONENTS  ARE   TO   BE
C              RECOGNIZED.
C            = -1,  ALLOW  NUMBERS  TO  BE  FOLLOWED  BY  E
C              EXPONENT, BUT DO NOT RECOGNIZE PERCENT SIGN,
C              K  OR  M  AT  END  OF  NUMBER.   E  IS   NOT
C              RECOGNIZED  IF NOT PRECEDED BY SIGN, DECIMAL
C              POINT OR DIGIT.
C            = 0, DO NOT ALLOW TRAILING PERCENT SIGN,  K  M
C              OR E EXPONENT.
C            = 1, ALLOW NUMBERS TO BE FOLLOWED  BY  PERCENT
C              SIGN,  K M OR E EXPONENT.  PERCENT SIGN, K M
C              OR E IS NOT RECOGNIZED IF  NOT  PRECEDED  BY
C              SIGN, DECIMAL POINT OR DIGIT.
C
C            FOLLOWING VALUES DO NOT REQUIRE THAT  EXPONENT
C            BE  PRECEDED  BY  NUMBER.   ALTHOUGH  RETURNED
C            VALUE WILL ALWAYS BE ZERO IF NO  VALUE  DIGITS
C            ARE  FOUND,  CALLING PROGRAM COULD ADJUST THIS
C            RETURNED VALUE.
C
C            = -3,  LEADING  E  EXPONENT   IS   RECOGNIZED.
C              LEADING DIGITS, SIGNS AND DECIMAL POINTS ARE
C              NOT ALLOWED.
C            = -2,  SAME  AS  ITRAIL=-1,  EXCEPT  THAT   IN
C              ADDITION  E  EXPONENT  IS RECOGNIZED EVEN IF
C              NOT PRECEDED  BY  DIGITS,  SIGN  OR  DECIMAL
C              POINT.
C            = 2, SAME AS ITRAIL=1, EXCEPT THAT IN ADDITION
C              LEADING  PERCENT  SIGN,  OR LETTERS K M OR E
C              EXPONENT ARE RECOGNIZED EVEN IF NOT PRECEDED
C              BY DIGITS, SIGN OR DECIMAL POINT.
C            = 3, ONLY LEADING PERCENT SIGN OR LETTERS K  M
C              OR   E  EXPONENT  ARE  RECOGNIZED.   LEADING
C              DIGITS, SIGNS  OR  DECIMAL  POINTS  ARE  NOT
C              ALLOWED.
C
C            IF 10 IS  SUBTRACTED  FROM  ITRAIL  VALUES  -3
C            THROUGH  3,  AND  IF  EITHER  VALUE  DIGITS OR
C            DIGITS FOLLOWING LETTER E  ARE  MISSING,  THEN
C            ONE,  RATHER  THAN  ZERO, IS ASSUMED TO BE THE
C            DEFAULT  FOR  THE  VALUE   OR   THE   EXPONENT
C            RESPECTIVELY.   -E-  WOULD  BE  EQUIVALENT  TO
C            -1E-1 AND -E OR -E+  WOULD  BE  EQUIVALENT  TO
C            -1E1
C
C            IF 10 IS ADDED TO ITRAIL VALUES -3 THROUGH  3,
C            THEN  VALUE  IS  RETURNED  AS  THOUGH  NEITHER
C            EXPONENT NOR DECIMAL  POINT  HAD  BEEN  TYPED.
C            VALUE  INDICATED  BY  COMBINATION  OF  DIGITS,
C            DECIMAL POINT AND/OR EXPONENT CAN BE  OBTAINED
C            AS   VALUE*10**KSHIFT   OR  IVALUE*10**KSHIFT.
C            VALUE INDICATED BY COMBINATION OF  DIGITS  AND
C            DECIMAL  POINT  BUT  IGNORING  EXPONENT CAN BE
C            OBTAINED   AS   VALUE*10**(KSHIFT-JSHIFT)   OR
C            IVALUE*10**(KSHIFT-JSHIFT).
C     IEXTRA = EXTRA SHIFT TO BE APPLIED TO  VALUE.   SHIFT
C              IS  STATED  AS  POWER  OF  RADIX.   THIS  IS
C              APPLIED IN ADDITION  TO  SHIFT  REPORTED  IN
C              ISHIFT,  JSHIFT  AND  KSHIFT AS SPECIFIED BY
C              USER.  FOR EXAMPLE, IF DOLLAR VALUE IS TO BE
C              RETURNED  AS INTEGER NUMBER OF CENTS, IEXTRA
C              WOULD HAVE VALUE 2.
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT,  WHICH IS  TO BE SEARCHED  FOR WORDS
C              AND NUMBERS.   IBUFFR THEN CONTAINS 1 LETTER
C              PER COMPUTER STORAGE LOCATION.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C     LOWBFR = SUBSCRIPT WITHIN THE  IBUFFR  ARRAY  OF  THE
C              FIRST  (LEFTMOST)  CHARACTER  WHICH  CAN  BE
C              SCANNED FOR NUMBERS. LOWBFR WILL BE RETURNED
C              POINTING TO FIRST  PRINTING  CHARACTER WHICH
C              CANNOT APPEAR IN A NUMBER, OR BEYOND THE END
C              OF THE BUFFER IF THE BUFFER DOES NOT CONTAIN
C              ANY PRINTING CHARACTERS.
C     KIND   = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C              IN THE IBUFFR ARRAY.
C            = 1, NOTHING  WAS FOUND AT OR  TO THE RIGHT OF
C              LOWBFR.  THE  CALLING  PROGRAM SHOULD READ A
C              NEW LINE INTO IBUFFR.
C            = 2, NUMBER  WAS  NOT  FOUND,  BUT A  PRINTING
C              CHARACTER  WHICH CANNOT  START A  NUMBER WAS
C              FOUND.   LOWBFR IS RETURNED POINTING TO THIS
C              PRINTING CHARACTER.
C            = 3, A NUMBER  WAS FOUND.   LOWBFR IS RETURNED
C              POINTING TO CHARACTER TO RIGHT OF NUMBER.
C     ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C              M FOLLOW NUMBER
C            = 1, PERCENT SIGN FOLLOWS NUMBER
C            = 2, K FOLLOWS NUMBER
C            = 3, M FOLLOWS NUMBER
C            = LESS  THAN  ZERO,  RETURNED  IF  E   FOLLOWS
C              NUMBER.
C            = -1, E  AND  POSSIBLY  SIGNED  NUMBER  FOLLOW
C              NUMBER.
C            = -2, E IS FOLLOWED BY PLUS SIGN NOT  IN  TURN
C              FOLLOWED BY DIGITS.
C            = -3, E IS FOLLOWED BY MINUS SIGN NOT IN  TURN
C              FOLLOWED BY DIGITS.
C            = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C     JSHIFT = EXPONENT  INDICATED  BY  FOLLOWING   PERCENT
C              SIGN, K, M OR E  FOLLOWED BY DIGITS.    THIS
C              WILL HAVE BEEN APPLIED TO RETURNED VALUE  IF
C              ITRAIL  EQUALS  EITHER  -1  OR 1.  12.34K OR
C              12.34E3 WOULD GIVE  JSHIFT  OF  3.   12%  OR
C              12E-2 WOULD GIVE JSHIFT -2.
C     KSHIFT = EXPONENT WHICH WOULD BE NECESSARY TO  OBTAIN
C              DESIRED  VALUE  IF  NUMBER  HAD  BEEN  TYPED
C              WITHOUT DECIMAL POINT.  12.34 STATED WITHOUT
C              DECIMAL  POINT  WOULD  BE  1234E-2 SO KSHIFT
C              WOULD BE -2.   12.34K  WOULD  BE  1234E1  SO
C              KSHIFT WOULD BE 1.
C     LSHIFT = ZERO  OR  LESS,  THE  VALUE  ZERO  IS  BEING
C              RETURNED   FOR   EITHER   VALUE  OR  IVALUE,
C              WHICHEVER IS APPROPRIATE.
C            = -4, NUMBER CONTAINED NEITHER  VALUE  DIGITS,
C              NOR  DECIMAL  POINT,  NOR LEADING PLUS SIGN,
C              NOR  LEADING  MINUS  SIGN.   THIS  VALUE  OF
C              LSHIFT   IS   ALWAYS  RETURNED  IF  KIND  IS
C              RETURNED CONTAINING A VALUE  OTHER  THAN  3.
C              IF  KIND IS RETURNED CONTAINING THE VALUE 3,
C              THEN ITRAIL MUST BE EITHER -3 OR 3, AND  THE
C              CONTENTS OF THE INPUT TEXT BUFFER MUST BEGIN
C              WITH A REPRESENTATION OF AN EXPONENT.
C            = -3, A LEADING MINUS SIGN BUT NO VALUE DIGITS
C              WAS FOUND.
C            = -2, A LEADING PLUS SIGN BUT NO VALUE  DIGITS
C              WAS FOUND.
C            = -1, A LEADING PERIOD BUT NO VALUE DIGITS WAS
C              FOUND.
C            = 0, ONE OR MORE ZERO DIGITS WERE  FOUND,  BUT
C              THE  NUMBER  CONTAINED  NO DIGITS OTHER THAN
C              ZERO.  THE NUMBER REPRESENTATION MAY OR  MAY
C              NOT  HAVE  BEEN  BEGUN  BY  A PLUS SIGN OR A
C              MINUS SIGN AND MAY OR MAY NOT HAVE CONTAINED
C              A DECIMAL POINT.
C            = GREATER  THAN  ZERO,  LSHIFT  IS  NUMBER  OF
C              DIGITS  COUNTING LEFTMOST NON-ZERO DIGIT AND
C              ALL WHICH WERE SPECIFIED TO ITS RIGHT.  THIS
C              IS  INDEPENDENT  OF  ANY  SHIFT IMPLIED BY A
C              DECIMAL POINT OR EXPONENT
C     IVALUE = RETURNED WITH VALUE IF KONTRL IS  LESS  THAN
C              OR  EQUAL  TO  ZERO.  NOTE THAT IF KONTRL IS
C              LESS THAN OR EQUAL TO  ZERO,  THEN  ORIGINAL
C              CONTENT  OF IVALUE IS  ALWAYS DESTROYED.  IN
C              PARTICULAR, IF KONTRL IS LESS THAN OR  EQUAL
C              TO ZERO AND  IF KIND IS  RETURNED CONTAINING
C              EITHER 1 OR 2, THEN IVALUE WILL BE ZEROED.
C     VALUE  = RETURNED WITH VALUE  IF  KONTRL  IS  GREATER
C              THAN  ZERO.   NOTE THAT IF KONTRL IS GREATER
C              THAN ZERO,  THEN  THE  ORIGINAL  CONTENT  OF
C              VALUE  IS  ALWAYS DESTROYED.  IN PARTICULAR,
C              IF KONTRL IS GREATER THAN ZERO AND  IF  KIND
C              IS RETURNED  CONTAINING EITHER  1 OR 2, THEN
C              VALUE WILL BE ZEROED.
C
      DIMENSION IBUFFR(MAXBFR),IDIGIT(10),KAPLTR(3),
     1LOWLTR(3),JPOWER(3)
C
C     IDIGIT CONTAINS ALPHAMERIC FORM OF DIGITS 0 THRU 9
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     IBLANK CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C     TAB CHARACTER.  IF TAB CHARACTER IS NOT AVAILABLE,
C     ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
      DATA IPLUS,IMINUS,IDOT,IBLANK,ITAB/
     11H+,1H-,1H.,1H ,1H	/
C
C     KAPLTR = LIST OF UPPER CASE LETTERS WHICH CAN FOLLOW
C              A NUMBER TO INDICATE AN EXPONENT.
C     LOWLTR = LIST OF LOWER CASE LETTERS CORRESPONDING TO
C              UPPER CASE LETTERS IN KAPLTR ARRAY.
C     JPOWER = VALUE OF THE EXPONENT ASSOCIATED WITH THE
C              PARALLEL CHARACTERS IN THE KAPLTR AND LOWLTR
C              ARRAYS. JPOWER CAN BE NEGATIVE, FOR EXAMPLE
C              PERCENT SIGN WOULD CORRESPOND TO JPOWER=-2.
C     MAXTST = NUMBER OF ITEMS IN EACH OF KAPLTR, LOWLTR
C              AND JPOWER ARRAYS.
C     KAPEXP = UPPER CASE LETTER E
C     LOWEXP = LOWER CASE LETTER E
C
C     UPPER CASE LETTERS CAN  BE SUBSTITUTED FOR LOWER CASE
C     IN FOLLOWING DATA STATEMENTS,  IF COMPUTER UPON WHICH
C     THIS ROUTINE IS USED DOES NOT SUPPORT LOWER CASE.
C
      DATA KAPLTR/1H%,1HK,1HM/
      DATA LOWLTR/1H%,1Hk,1Hm/
      DATA JPOWER/-2,3,6/
      DATA MAXTST/3/
      DATA KAPEXP,LOWEXP/1HE,1He/
C
C     INITIALIZE
      ISIGN=0
      IF(KONTRL.GT.0)VALUE=0.0
      IF(KONTRL.LE.0)IVALUE=0
      ISHIFT=0
      JSHIFT=0
      KSHIFT=0
      LSHIFT=-4
      IRADIX=10
      IF(KONTRL.LT.0)IRADIX=8
      IADD=IRADIX-2
      IPOWER=0
      NUMKNT=-4
      NUMVAL=0
      NMBEXP=-1
      NUMPNT=-1
      IDEFLT=0
      IF(ITRAIL.LT.-5)IDEFLT=1
      KTRAIL=ITRAIL
      IF(KTRAIL.GT.5)KTRAIL=KTRAIL-10
      IF(KTRAIL.LT.-5)KTRAIL=KTRAIL+10
      LTRAIL=KTRAIL
      IF(LTRAIL.LT.0)LTRAIL=-LTRAIL
      GO TO 2
C
C     *********************
C     *  SCAN FOR NUMBER  *
C     *********************
C
C     LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
    1 LOWBFR=LOWBFR+1
    2 IF(LOWBFR.GT.MAXBFR)GO TO 25
      NOWLTR=IBUFFR(LOWBFR)
      IF(NMBEXP.GE.0)GO TO 20
      IF(ISIGN.NE.0)GO TO 4
C
C     SCAN OVER LEADING SPACES AND/OR TABS
      IF(NOWLTR.EQ.IBLANK)GO TO 1
      IF(NOWLTR.EQ.ITAB)GO TO 1
C
C     LOOK FOR INITIAL SIGNS + OR -
      IF(KONTRL.LE.-2)GO TO 40
      IF(LTRAIL.GE.3)GO TO 4
      IF(NOWLTR.EQ.IPLUS)GO TO 3
      IF(NOWLTR.NE.IMINUS)GO TO 4
      ISIGN=-1
      NUMKNT=-3
      GO TO 1
    3 ISIGN=1
      NUMKNT=-2
      GO TO 1
C
C     LOOK FOR % K OR M FOLLOWING NUMBER
C     LOCK OUT THESE AND ALSO E IF NO PART OF NUMBER FOUND
    4 IF(LTRAIL.GE.2)GO TO 5
      IF(ISIGN.EQ.0)GO TO 10
      IF(KTRAIL.EQ.0)GO TO 10
    5 IF(KTRAIL.LT.0)GO TO 8
      I=0
    6 I=I+1
      IF(I.GT.MAXTST)GO TO 8
      IF(NOWLTR.EQ.KAPLTR(I))GO TO 7
      IF(NOWLTR.NE.LOWLTR(I))GO TO 6
    7 IPOWER=JPOWER(I)
      JSIGN=1
      NMBEXP=1
      ISHIFT=I
      LOWBFR=LOWBFR+1
      GO TO 26
C
C     LOOK FOR LETTER E
    8 IF(NOWLTR.EQ.KAPEXP)GO TO 9
      IF(NOWLTR.NE.LOWEXP)GO TO 10
    9 JSIGN=0
      NMBEXP=0
      ISHIFT=-4
      GO TO 19
C
C     LOOK FOR LEADING OR EMBEDDED PERIOD
   10 IF(LTRAIL.GE.3)GO TO 24
      IF(NUMPNT.GE.0)GO TO 11
      IF(NOWLTR.NE.IDOT)GO TO 11
      DECML=0.1
      IF(ISIGN.EQ.0)NUMKNT=-1
      GO TO 18
C
C     LOOK FOR DIGIT OTHER THAN IN EXPONENT FIELD
   11 DO 16 I=1,IRADIX
      IF(NOWLTR.NE.IDIGIT(I))GO TO 16
      IF(NUMKNT.GT.0)GO TO 12
      NUMKNT=0
      IF(I.EQ.1)GO TO 13
   12 NUMKNT=NUMKNT+1
   13 IF(KONTRL.LE.0)GO TO 15
      IF(NUMKNT.LE.KONTRL)NUMVAL=(10*NUMVAL)+I-1
      IF(NUMPNT.GE.0)GO TO 14
      VALUE=(10.0*VALUE)+FLOAT(I-1)
      GO TO 19
   14 VALUE=VALUE+(DECML*FLOAT(I-1))
      DECML=DECML/10.0
      GO TO 18
C     FOLLOWING ALLOWS LARGEST NEGATIVE NUMBER FOR
C     WHICH THERE IS NOT CORRESPONDING POSITIVE VALUE
   15 IF(NUMKNT.EQ.1)IVALUE=I-2
      IF(NUMKNT.GT.1)IVALUE=(IRADIX*IVALUE)+I+IADD
      GO TO 17
   16 CONTINUE
      GO TO 24
C
C     DIGIT, E OR . FOUND SO MARK AS BEING IN NUMBER
   17 IF(NUMPNT.LT.0)GO TO 19
   18 NUMPNT=NUMPNT+1
   19 IF(ISIGN.EQ.0)ISIGN=1
      GO TO 1
C
C     LOOK FOR SIGN IN EXPONENT FIELD
   20 IF(JSIGN.NE.0)GO TO 22
      IF(NOWLTR.EQ.IPLUS)GO TO 21
      IF(NOWLTR.NE.IMINUS)GO TO 22
      JSIGN=-1
      ISHIFT=-3
      GO TO 1
   21 JSIGN=1
      ISHIFT=-2
      GO TO 1
C
C     LOOK FOR DIGITS IN EXPONENT FIELD
   22 DO 23 I=1,10
      IF(NOWLTR.NE.IDIGIT(I))GO TO 23
      IPOWER=(10*IPOWER)+I-1
      NMBEXP=1
      ISHIFT=-1
      IF(JSIGN.EQ.0)JSIGN=1
      GO TO 1
   23 CONTINUE
      GO TO 26
C
C     DECIDE WHAT TO DO IF NO MATCH FOUND
   24 IF(ISIGN.NE.0)GO TO 26
      GO TO 40
C
C     *******************************
C     *  NUMBER HAS BEEN EVALUATED  *
C     *******************************
C
   25 IF(ISIGN.EQ.0)GO TO 39
   26 KIND=3
C
C     ADJUST EXPONENT SIGN
      IF(NMBEXP.LT.0)GO TO 27
      IF(NMBEXP.EQ.0)IPOWER=IDEFLT
      IF(JSIGN.LT.0)IPOWER=-IPOWER
C
C     SHIFT FLOATING POINT NUMBER ACCORDING TO EXPONENT
   27 JSHIFT=IPOWER
      KSHIFT=IPOWER
      IF(NUMPNT.GT.0)KSHIFT=KSHIFT-NUMPNT
      LSHIFT=NUMKNT
      IF(NUMPNT.LT.0)NUMPNT=0
      IF(ITRAIL.GT.5)IPOWER=NUMPNT
      IPOWER=IPOWER+IEXTRA
      IF(KONTRL.LE.0)GO TO 31
      IF(NUMKNT.GT.KONTRL)GO TO 28
      IF(NUMKNT.LT.0)NUMVAL=IDEFLT
      IF(ISIGN.LT.0)NUMVAL=-NUMVAL
      VALUE=FLOAT(NUMVAL)
      IPOWER=IPOWER-NUMPNT
      GO TO 29
   28 IF(NUMKNT.LT.0)VALUE=IDEFLT
      IF(ISIGN.LT.0)VALUE=-VALUE
   29 IF(IPOWER.EQ.0)GO TO 41
      IF(IPOWER.GT.0)GO TO 30
      IPOWER=-IPOWER
      VALUE=VALUE/(10.0**IPOWER)
      GO TO 41
   30 VALUE=VALUE*(10.0**IPOWER)
      GO TO 41
C
C     SHIFT AN INTEGER ACCORDING TO EXPONENT
   31 IF(NUMKNT.LT.0)IVALUE=IDEFLT
      IPOWER=IPOWER-NUMPNT
      IF(ISIGN.GE.0)GO TO 32
      IVALUE=-IVALUE
C     NOTE THAT NEGATIVE NUMBER  AT THIS POINT HAS ABSOLUTE
C     VALUE 1 TOO LOW  TO ALLOW THE LARGEST NEGATIVE NUMBER
C     WHICH  HAS NO CORRESPONDING  POSITIVE  VALUE  IN TWOS
C     COMPLEMENT NOTATION
      IF(NUMKNT.GT.0)IVALUE=IVALUE-1
      GO TO 33
   32 IF(NUMKNT.GT.0)IVALUE=IVALUE+1
   33 IF(IPOWER.LE.0)GO TO 37
      IPOWER=IPOWER-1
      KVALUE=IVALUE
      IVALUE=IRADIX*IVALUE
      IF(ISIGN.GE.0)GO TO 34
      IF(IVALUE.GE.KVALUE)GO TO 36
      GO TO 35
   34 IF(IVALUE.LE.KVALUE)GO TO 36
   35 IF((IVALUE/IRADIX).EQ.KVALUE)GO TO 33
   36 IVALUE=KVALUE
   37 IF(IPOWER.GE.0)GO TO 41
      IPOWER=IPOWER+1
      KVALUE=IVALUE
      IVALUE=IVALUE/IRADIX
      IF(ISIGN.GE.0)GO TO 38
      IF((IRADIX*IVALUE).LT.KVALUE)IVALUE=IVALUE+1
   38 IF(IVALUE.NE.0)GO TO 37
      GO TO 41
C
C     NUMBER NOT FOUND
   39 KIND=1
      GO TO 41
   40 KIND=2
C
C     RETURN TO CALLING PROGRAM
   41 RETURN
C
C     IBLANK = THE BLANK OR SPACE CHARACTER
C     JSIGN  = 0, NEITHER SIGN NOR DIGITS AFTER E
C            = 1, EITHER PLUS OR DIGITS AFTER E
C            = -1, MINUS SIGN AFTER E
C     ITAB   = THE TAB CHARACTER
C     ISIGN  = 0, NO PART OF NUMBER ENCOUNTERED
C            = -1, MINUS SIGN AT START OF NUMBER
C            = 1, NUMBER DOES NOT START WITH MINUS SIGN
C     NMBEXP = -1, NO EXPONENT FIELD YET FOUND
C            = 0, EXPONENT FIELD FOUND BUT NUMBER NOT
C              YET FOUND
C            = 1, NUMBER FOUND IN EXPONENT FIELD
C     NOWLTR = THE CHARACTER CURRENTLY BEING TESTED
C     NUMKNT = NUMBER OF DIGITS IN VALUE FIELD
C            = 0, LEFT HAND ZERO ONLY READ SO FAR
C            = -1, NO DIGITS YET FOUND
C     NUMPNT = -1, DECIMAL POINT NOT YET FOUND
C            = 0, DECIMAL POINT ENCOUNTERED IN VALUE FIELD
C            = .GT.0, VALUE IS NUMBER OF DIGITS ENCOUNTERED
C              TO RIGHT OF DECIMAL POINT IN NUMBER.
C204733708764%kme
      END
      SUBROUTINE DAIHFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
     1    LOWBFR,KIND  ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE)
C     RENBR(/FREE FORMAT INTEGER INPUT ROUTINE)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAIHFT  INTERPRETS  AN  ARRAY  READ  BY  THE  CALLING
C     PROGRAM  WITH  A MULTIPLE OF AN A1 FORMAT AND RETURNS
C     THE VALUES IN THIS ARRAY.
C
C     NUMBERS  INTERPRETTED  BY  DAIHFT CAN CONTAIN LEADING
C     SIGN, EMBEDDED DECIMAL POINT AND/OR TRAILING  E  WITH
C     SIGNED EXPONENT.  A PERCENT SIGN FOLLOWING THE NUMBER
C     IMPLIES  E-2,  TRAILING  LETTER  K  IMPLIES  E3   AND
C     TRAILING LETTER M IMPLIES E6.
C
C     ARGUMENT LIST DEFINITIONS:
C
C     KONTRL = 0 OR GREATER, NUMBER IS EVALUATED AS DECIMAL
C              INTEGER.  NUMBER CAN CONTAIN A DECIMAL POINT
C              (FOR EXAMPLE 1.23K OR 1.23E3  EQUALS  1230),
C              BUT  IS  STORED AS AN INTEGER IN DAIHFT, AND
C              IS OUTPUT  AS ARGUMENT IVALUE.   ANY DECIMAL
C              INTEGER WHICH THE COMPUTER CAN REPRESENT CAN
C              BE  EVALUATED.    THIS  INCLUDES,   ON  TWOS
C              COMPLEMENT  COMPUTERS, THE  LARGEST NEGATIVE
C              NUMBER THE ABSOLUTE VALUE OF WHICH CANNOT BE
C              STORED.   ON THE  PDP10,  A 36 BIT  COMPUTER
C              WITH TWOS COMPLEMENT  NOTATION, THE RANGE OF
C              DECIMAL  INTEGERS  IS  -34359738368  THROUGH
C              34359738367  (OCTAL NOTATION OF BIT PATTERNS
C              BEING  400000000000  THROUGH  377777777777).
C            = -1, ITEM IN  IBUFFR  ARRAY  IS  OCTAL.   THE
C              NUMBER  CAN  BE  TYPED  WITH A DECIMAL POINT
C              AND/OR  WITH  AN  EXPONENT.   HOWEVER,   THE
C              NUMBER   FOLLOWING   THE  LETTER  E  OF  THE
C              EXPONENT IS EVALUATED IN DECIMAL.  THE VALUE
C              OF  THE  OCTAL  NUMBER  IS  RETURNED  AS THE
C              ARGUMENT  IVALUE.   IT  MUST  BE NOTED  THAT
C              NUMBERS EVALUATED AS NEGATIVE OCTAL INTEGERS
C              HAVE THE  NEGATIVE  OCTAL  INTEGER  AS THEIR
C              VALUE,  NOT AS  THEIR BIT  REPRESENTATION IN
C              COMPUTER STORAGE.   FOR EXAMPLE, ON A 36 BIT
C              TWOS COMPLEMENT  COMPUTER,  THE OCTAL NUMBER
C              -400000000000 (WHICH COULD  ALSO BE TYPED AS
C              -4E11 OR -4E+11 WHERE  THE 11 AFTER THE E IS
C              IN DECIMAL)  IS REPRESENTED  AS BIT  PATTERN
C              HAVING OCTAL  NOTATION  400000000000 AND THE
C              OCTAL NUMBER -377777777777 IS REPRESENTED BY
C              THE BIT PATTERN 400000000001.
C            = -2, DO  NOT  EVALUATE NUMBERS.   INSTEAD THE
C              CHARACTERS  FORMING NUMBER  ARE TREATED LIKE
C              ANY OTHER PRINTING CHARACTERS.
C     ITRAIL = SPECIFIES  WHETHER  EXPONENTS  ARE   TO   BE
C              RECOGNIZED.
C            = -1,  ALLOW  NUMBERS  TO  BE  FOLLOWED  BY  E
C              EXPONENT, BUT DO NOT RECOGNIZE PERCENT SIGN,
C              K  OR  M  AT  END  OF  NUMBER.   E  IS   NOT
C              RECOGNIZED  IF NOT PRECEDED BY SIGN, DECIMAL
C              POINT OR DIGIT.
C            = 0, DO NOT ALLOW TRAILING PERCENT SIGN,  K  M
C              OR E EXPONENT.
C            = 1, ALLOW NUMBERS TO BE FOLLOWED  BY  PERCENT
C              SIGN,  K M OR E EXPONENT.  PERCENT SIGN, K M
C              OR E IS NOT RECOGNIZED IF  NOT  PRECEDED  BY
C              SIGN, DECIMAL POINT OR DIGIT.
C
C            FOLLOWING VALUES DO NOT REQUIRE THAT  EXPONENT
C            BE  PRECEDED  BY  NUMBER.   ALTHOUGH  RETURNED
C            VALUE WILL ALWAYS BE ZERO IF NO  VALUE  DIGITS
C            ARE  FOUND,  CALLING PROGRAM COULD ADJUST THIS
C            RETURNED VALUE.
C
C            = -3,  LEADING  E  EXPONENT   IS   RECOGNIZED.
C              LEADING DIGITS, SIGNS AND DECIMAL POINTS ARE
C              NOT ALLOWED.
C            = -2,  SAME  AS  ITRAIL=-1,  EXCEPT  THAT   IN
C              ADDITION  E  EXPONENT  IS RECOGNIZED EVEN IF
C              NOT PRECEDED  BY  DIGITS,  SIGN  OR  DECIMAL
C              POINT.
C            = 2, SAME AS ITRAIL=1, EXCEPT THAT IN ADDITION
C              LEADING  PERCENT  SIGN,  OR LETTERS K M OR E
C              EXPONENT ARE RECOGNIZED EVEN IF NOT PRECEDED
C              BY DIGITS, SIGN OR DECIMAL POINT.
C            = 3, ONLY LEADING PERCENT SIGN OR LETTERS K  M
C              OR   E  EXPONENT  ARE  RECOGNIZED.   LEADING
C              DIGITS, SIGNS  OR  DECIMAL  POINTS  ARE  NOT
C              ALLOWED.
C
C            IF 10 IS  SUBTRACTED  FROM  ITRAIL  VALUES  -3
C            THROUGH  3,  AND  IF  EITHER  VALUE  DIGITS OR
C            DIGITS FOLLOWING LETTER E  ARE  MISSING,  THEN
C            ONE,  RATHER  THAN  ZERO, IS ASSUMED TO BE THE
C            DEFAULT  FOR  THE  VALUE   OR   THE   EXPONENT
C            RESPECTIVELY.   -E-  WOULD  BE  EQUIVALENT  TO
C            -1E-1 AND -E OR -E+  WOULD  BE  EQUIVALENT  TO
C            -1E1
C
C            IF 10 IS ADDED TO ITRAIL VALUES -3 THROUGH  3,
C            THEN  VALUE  IS  RETURNED  AS  THOUGH  NEITHER
C            EXPONENT NOR DECIMAL  POINT  HAD  BEEN  TYPED.
C            VALUE  INDICATED  BY  COMBINATION  OF  DIGITS,
C            DECIMAL POINT AND/OR EXPONENT CAN BE  OBTAINED
C            AS   VALUE*10**KSHIFT   OR  IVALUE*10**KSHIFT.
C            VALUE INDICATED BY COMBINATION OF  DIGITS  AND
C            DECIMAL  POINT  BUT  IGNORING  EXPONENT CAN BE
C            OBTAINED   AS   VALUE*10**(KSHIFT-JSHIFT)   OR
C            IVALUE*10**(KSHIFT-JSHIFT).
C     IEXTRA = EXTRA SHIFT TO BE APPLIED TO  VALUE.   SHIFT
C              IS  STATED  AS  POWER  OF  RADIX.   THIS  IS
C              APPLIED IN ADDITION  TO  SHIFT  REPORTED  IN
C              ISHIFT,  JSHIFT  AND  KSHIFT AS SPECIFIED BY
C              USER.  FOR EXAMPLE, IF DOLLAR VALUE IS TO BE
C              RETURNED  AS INTEGER NUMBER OF CENTS, IEXTRA
C              WOULD HAVE VALUE 2.
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT,  WHICH IS  TO BE SEARCHED  FOR WORDS
C              AND NUMBERS.   IBUFFR THEN CONTAINS 1 LETTER
C              PER COMPUTER STORAGE LOCATION.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C     LOWBFR = SUBSCRIPT WITHIN THE  IBUFFR  ARRAY  OF  THE
C              FIRST  (LEFTMOST)  CHARACTER  WHICH  CAN  BE
C              SCANNED FOR NUMBERS. LOWBFR WILL BE RETURNED
C              POINTING TO FIRST  PRINTING  CHARACTER WHICH
C              CANNOT APPEAR IN A NUMBER, OR BEYOND THE END
C              OF THE BUFFER IF THE BUFFER DOES NOT CONTAIN
C              ANY PRINTING CHARACTERS.
C     KIND   = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C              IN THE IBUFFR ARRAY.
C            = 1, NOTHING  WAS FOUND AT OR  TO THE RIGHT OF
C              LOWBFR.  THE  CALLING  PROGRAM SHOULD READ A
C              NEW LINE INTO IBUFFR.
C            = 2, NUMBER WAS  NOT  FOUND,  BUT  A  PRINTING
C              CHARACTER  WHICH CANNOT  START A  NUMBER WAS
C              FOUND.   LOWBFR IS RETURNED POINTING TO THIS
C              PRINTING CHARACTER.
C            = 3, A NUMBER  WAS FOUND.   LOWBFR IS RETURNED
C              POINTING TO CHARACTER TO RIGHT OF NUMBER.
C     ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C              M FOLLOW NUMBER
C            = 1, PERCENT SIGN FOLLOWS NUMBER
C            = 2, K FOLLOWS NUMBER
C            = 3, M FOLLOWS NUMBER
C            = LESS  THAN  ZERO,  RETURNED  IF  E   FOLLOWS
C              NUMBER.
C            = -1, E  AND  POSSIBLY  SIGNED  NUMBER  FOLLOW
C              NUMBER.
C            = -2, E IS FOLLOWED BY PLUS SIGN NOT  IN  TURN
C              FOLLOWED BY DIGITS.
C            = -3, E IS FOLLOWED BY MINUS SIGN NOT IN  TURN
C              FOLLOWED BY DIGITS.
C            = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C     JSHIFT = EXPONENT  INDICATED  BY  FOLLOWING   PERCENT
C              SIGN, K, M OR E  FOLLOWED BY DIGITS.    THIS
C              WILL HAVE BEEN APPLIED TO RETURNED VALUE  IF
C              ITRAIL  EQUALS  EITHER  -1  OR 1.  12.34K OR
C              12.34E3 WOULD GIVE  JSHIFT  OF  3.   12%  OR
C              12E-2 WOULD GIVE JSHIFT -2.
C     KSHIFT = EXPONENT WHICH WOULD BE NECESSARY TO  OBTAIN
C              DESIRED  VALUE  IF  NUMBER  HAD  BEEN  TYPED
C              WITHOUT DECIMAL POINT.  12.34 STATED WITHOUT
C              DECIMAL  POINT  WOULD  BE  1234E-2 SO KSHIFT
C              WOULD BE -2.   12.34K  WOULD  BE  1234E1  SO
C              KSHIFT  WOULD  BE  1.
C     LSHIFT = ZERO  OR  LESS,  THE  VALUE  ZERO  IS  BEING
C              RETURNED   FOR   EITHER   VALUE  OR  IVALUE,
C              WHICHEVER IS APPROPRIATE.
C            = -4, NUMBER CONTAINED NEITHER  VALUE  DIGITS,
C              NOR  DECIMAL  POINT,  NOR LEADING PLUS SIGN,
C              NOR  LEADING  MINUS  SIGN.   THIS  VALUE  OF
C              LSHIFT   IS   ALWAYS  RETURNED  IF  KIND  IS
C              RETURNED CONTAINING A VALUE  OTHER  THAN  3.
C              IF  KIND IS RETURNED CONTAINING THE VALUE 3,
C              THEN ITRAIL MUST BE EITHER -3 OR 3, AND  THE
C              CONTENTS OF THE INPUT TEXT BUFFER MUST BEGIN
C              WITH A REPRESENTATION OF AN EXPONENT.
C            = -3, A LEADING MINUS SIGN BUT NO VALUE DIGITS
C              WAS FOUND.
C            = -2, A LEADING PLUS SIGN BUT NO VALUE  DIGITS
C              WAS FOUND.
C            = -1, A LEADING PERIOD BUT NO VALUE DIGITS WAS
C              FOUND.
C            = 0, ONE OR MORE ZERO DIGITS WERE  FOUND,  BUT
C              THE  NUMBER  CONTAINED  NO DIGITS OTHER THAN
C              ZERO.  THE NUMBER REPRESENTATION MAY OR  MAY
C              NOT  HAVE  BEEN  BEGUN  BY  A PLUS SIGN OR A
C              MINUS SIGN AND MAY OR MAY NOT HAVE CONTAINED
C              A DECIMAL POINT.
C            = GREATER  THAN  ZERO,  LSHIFT  IS  NUMBER  OF
C              DIGITS  COUNTING LEFTMOST NON-ZERO DIGIT AND
C              ALL WHICH WERE SPECIFIED TO ITS RIGHT.  THIS
C              IS  INDEPENDENT  OF  ANY  SHIFT IMPLIED BY A
C              DECIMAL POINT OR EXPONENT
C     IVALUE = RETURNED WITH VALUE IF NUMBER IS FOUND.  THE
C              ORIGINAL CONTENT OF IVALUE IS DESTROYED.  IN
C              PARTICULAR,  IF KIND IS  RETURNED CONTAINING
C              EITHER 1 OR 2, THEN IVALUE WILL BE ZEROED.
C
      DIMENSION IBUFFR(MAXBFR),IDIGIT(10),KAPLTR(3),
     1LOWLTR(3),JPOWER(3)
C
C     IDIGIT CONTAINS ALPHAMERIC FORM OF DIGITS 0 THRU 9
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C     IBLANK CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C     TAB CHARACTER.  IF TAB CHARACTER IS NOT AVAILABLE,
C     ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
      DATA IPLUS,IMINUS,IDOT,IBLANK,ITAB/
     11H+,1H-,1H.,1H ,1H	/
C
C     KAPLTR = LIST OF UPPER CASE LETTERS WHICH CAN FOLLOW
C              A NUMBER TO INDICATE AN EXPONENT.
C     LOWLTR = LIST OF LOWER CASE LETTERS CORRESPONDING TO
C              UPPER CASE LETTERS IN KAPLTR ARRAY.
C     JPOWER = VALUE OF THE EXPONENT ASSOCIATED WITH THE
C              PARALLEL CHARACTERS IN THE KAPLTR AND LOWLTR
C              ARRAYS. JPOWER CAN BE NEGATIVE, FOR EXAMPLE
C              PERCENT SIGN WOULD CORRESPOND TO JPOWER=-2.
C     MAXTST = NUMBER OF ITEMS IN EACH OF KAPLTR, LOWLTR
C              AND JPOWER ARRAYS.
C     KAPEXP = UPPER CASE LETTER E
C     LOWEXP = LOWER CASE LETTER E
C
C     UPPER CASE LETTERS CAN  BE SUBSTITUTED FOR LOWER CASE
C     IN FOLLOWING DATA STATEMENTS,  IF COMPUTER UPON WHICH
C     THIS ROUTINE IS USED DOES NOT SUPPORT LOWER CASE.
C
      DATA KAPLTR/1H%,1HK,1HM/
      DATA LOWLTR/1H%,1Hk,1Hm/
      DATA JPOWER/-2,3,6/
      DATA MAXTST/3/
      DATA KAPEXP,LOWEXP/1HE,1He/
C
C     INITIALIZE
      ISIGN=0
      IVALUE=0
      ISHIFT=0
      JSHIFT=0
      KSHIFT=0
      LSHIFT=-4
      IRADIX=10
      IF(KONTRL.LT.0)IRADIX=8
      IADD=IRADIX-2
      IPOWER=0
      NUMKNT=-4
      NMBEXP=-1
      NUMPNT=-1
      IDEFLT=0
      IF(ITRAIL.LT.-5)IDEFLT=1
      KTRAIL=ITRAIL
      IF(KTRAIL.GT.5)KTRAIL=KTRAIL-10
      IF(KTRAIL.LT.-5)KTRAIL=KTRAIL+10
      LTRAIL=KTRAIL
      IF(LTRAIL.LT.0)LTRAIL=-LTRAIL
      GO TO 2
C
C     *********************
C     *  SCAN FOR NUMBER  *
C     *********************
C
C     LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
    1 LOWBFR=LOWBFR+1
    2 IF(LOWBFR.GT.MAXBFR)GO TO 23
      NOWLTR=IBUFFR(LOWBFR)
      IF(NMBEXP.GE.0)GO TO 18
      IF(ISIGN.NE.0)GO TO 4
C
C     SCAN OVER LEADING SPACES AND/OR TABS
      IF(NOWLTR.EQ.IBLANK)GO TO 1
      IF(NOWLTR.EQ.ITAB)GO TO 1
C
C     LOOK FOR INITIAL SIGNS + OR -
      IF(KONTRL.LE.-2)GO TO 34
      IF(LTRAIL.GE.3)GO TO 4
      IF(NOWLTR.EQ.IPLUS)GO TO 3
      IF(NOWLTR.NE.IMINUS)GO TO 4
      ISIGN=-1
      NUMKNT=-3
      GO TO 1
    3 ISIGN=1
      NUMKNT=-2
      GO TO 1
C
C     LOOK FOR % K OR M FOLLOWING NUMBER
C     LOCK OUT THESE AND ALSO E IF NO PART OF NUMBER FOUND
    4 IF(LTRAIL.GE.2)GO TO 5
      IF(ISIGN.EQ.0)GO TO 10
      IF(KTRAIL.EQ.0)GO TO 10
    5 IF(KTRAIL.LT.0)GO TO 8
      I=0
    6 I=I+1
      IF(I.GT.MAXTST)GO TO 8
      IF(NOWLTR.EQ.KAPLTR(I))GO TO 7
      IF(NOWLTR.NE.LOWLTR(I))GO TO 6
    7 IPOWER=JPOWER(I)
      JSIGN=1
      NMBEXP=1
      ISHIFT=I
      LOWBFR=LOWBFR+1
      GO TO 24
C
C     LOOK FOR LETTER E
    8 IF(NOWLTR.EQ.KAPEXP)GO TO 9
      IF(NOWLTR.NE.LOWEXP)GO TO 10
    9 JSIGN=0
      NMBEXP=0
      ISHIFT=-4
      GO TO 17
C
C     LOOK FOR LEADING OR EMBEDDED PERIOD
   10 IF(LTRAIL.GE.3)GO TO 22
      IF(NUMPNT.GE.0)GO TO 11
      IF(NOWLTR.NE.IDOT)GO TO 11
      IF(ISIGN.EQ.0)NUMKNT=-1
      GO TO 16
C
C     LOOK FOR DIGIT OTHER THAN IN EXPONENT FIELD
   11 DO 14 I=1,IRADIX
      IF(NOWLTR.NE.IDIGIT(I))GO TO 14
      IF(NUMKNT.GT.0)GO TO 12
      NUMKNT=0
      IF(I.EQ.1)GO TO 13
   12 NUMKNT=NUMKNT+1
C     FOLLOWING ALLOWS LARGEST NEGATIVE NUMBER FOR
C     WHICH THERE IS NOT CORRESPONDING POSITIVE VALUE
   13 IF(NUMKNT.EQ.1)IVALUE=I-2
      IF(NUMKNT.GT.1)IVALUE=(IRADIX*IVALUE)+I+IADD
      GO TO 15
   14 CONTINUE
      GO TO 22
C
C     DIGIT, E OR . FOUND SO MARK AS BEING IN NUMBER
   15 IF(NUMPNT.LT.0)GO TO 17
   16 NUMPNT=NUMPNT+1
   17 IF(ISIGN.EQ.0)ISIGN=1
      GO TO 1
C
C     LOOK FOR SIGN IN EXPONENT FIELD
   18 IF(JSIGN.NE.0)GO TO 20
      IF(NOWLTR.EQ.IPLUS)GO TO 19
      IF(NOWLTR.NE.IMINUS)GO TO 20
      JSIGN=-1
      ISHIFT=-3
      GO TO 1
   19 JSIGN=1
      ISHIFT=-2
      GO TO 1
C
C     LOOK FOR DIGITS IN EXPONENT FIELD
   20 DO 21 I=1,10
      IF(NOWLTR.NE.IDIGIT(I))GO TO 21
      IPOWER=(10*IPOWER)+I-1
      NMBEXP=1
      ISHIFT=-1
      IF(JSIGN.EQ.0)JSIGN=1
      GO TO 1
   21 CONTINUE
      GO TO 24
C
C     DECIDE WHAT TO DO IF NO MATCH FOUND
   22 IF(ISIGN.NE.0)GO TO 24
      GO TO 34
C
C     *******************************
C     *  NUMBER HAS BEEN EVALUATED  *
C     *******************************
C
   23 IF(ISIGN.EQ.0)GO TO 33
   24 KIND=3
C
C     ADJUST EXPONENT SIGN
      IF(NMBEXP.LT.0)GO TO 25
      IF(NMBEXP.EQ.0)IPOWER=IDEFLT
      IF(JSIGN.LT.0)IPOWER=-IPOWER
C
C     SHIFT AN INTEGER ACCORDING TO EXPONENT
   25 JSHIFT=IPOWER
      KSHIFT=IPOWER
      IF(NUMPNT.GT.0)KSHIFT=KSHIFT-NUMPNT
      LSHIFT=NUMKNT
      IF(NUMPNT.GT.0)IPOWER=IPOWER-NUMPNT
      IF(ITRAIL.GT.5)IPOWER=0
      IPOWER=IPOWER+IEXTRA
      IF(NUMKNT.LT.0)IVALUE=IDEFLT
      IF(ISIGN.GE.0)GO TO 26
      IVALUE=-IVALUE
C     NOTE THAT NEGATIVE NUMBER  AT THIS POINT HAS ABSOLUTE
C     VALUE 1 TOO LOW  TO ALLOW THE LARGEST NEGATIVE NUMBER
C     WHICH  HAS NO CORRESPONDING  POSITIVE  VALUE  IN TWOS
C     COMPLEMENT NOTATION
      IF(NUMKNT.GT.0)IVALUE=IVALUE-1
      GO TO 27
   26 IF(NUMKNT.GT.0)IVALUE=IVALUE+1
   27 IF(IPOWER.LE.0)GO TO 31
      IPOWER=IPOWER-1
      KVALUE=IVALUE
      IVALUE=IRADIX*IVALUE
      IF(ISIGN.GE.0)GO TO 28
      IF(IVALUE.GE.KVALUE)GO TO 30
      GO TO 29
   28 IF(IVALUE.LE.KVALUE)GO TO 30
   29 IF((IVALUE/IRADIX).EQ.KVALUE)GO TO 27
   30 IVALUE=KVALUE
   31 IF(IPOWER.GE.0)GO TO 35
      IPOWER=IPOWER+1
      KVALUE=IVALUE
      IVALUE=IVALUE/IRADIX
      IF(ISIGN.GE.0)GO TO 32
      IF((IRADIX*IVALUE).LT.KVALUE)IVALUE=IVALUE+1
   32 IF(IVALUE.NE.0)GO TO 31
      GO TO 35
C
C     IF DELIMITER AT END OF LINE, MARK VALUE AS MISSING
   33 KIND=1
      GO TO 35
   34 KIND=2
C
C     RETURN TO CALLING PROGRAM
   35 RETURN
C
C     IBLANK = THE BLANK OR SPACE CHARACTER
C     JSIGN  = 0, NEITHER SIGN NOR DIGITS AFTER E
C            = 1, EITHER PLUS OR DIGITS AFTER E
C            = -1, MINUS SIGN AFTER E
C     ITAB   = THE TAB CHARACTER
C     ISIGN  = 0, NO PART OF NUMBER ENCOUNTERED
C            = -1, MINUS SIGN AT START OF NUMBER
C            = 1, NUMBER DOES NOT START WITH MINUS SIGN
C     NMBEXP = -1, NO EXPONENT FIELD YET FOUND
C            = 0, EXPONENT FIELD FOUND BUT NUMBER NOT
C              YET FOUND
C            = 1, NUMBER FOUND IN EXPONENT FIELD
C     NOWLTR = THE CHARACTER CURRENTLY BEING TESTED
C     NUMKNT = NUMBER OF DIGITS IN VALUE FIELD
C            = 0, LEFT HAND ZERO ONLY READ SO FAR
C            = -1, NO DIGITS YET FOUND
C     NUMPNT = -1, DECIMAL POINT NOT YET FOUND
C            = 0, DECIMAL POINT ENCOUNTERED IN VALUE FIELD
C            = .GT.0, VALUE IS NUMBER OF DIGITS ENCOUNTERED
C              TO RIGHT OF DECIMAL POINT IN NUMBER.
C982714844451%kme
      END
      SUBROUTINE DATREK(LOWVLU,MAXVLU,MAXBFR,IBUFFR,LOWBFR,
     1    KIND  ,IVALUE,KNTVLU)
C     RENBR(/EVALUATE INTEGER SERIES OF FORM 1.2.3)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE  TO  EVALUATE  SERIES  OF  UNSIGNED  INTEGERS
C     SEPARATED  BY PERIODS.  VALUE OF -1 IS RETURNED FOR A
C     MISSING INTEGER INDICATED BY AN INITIAL PERIOD, BY  A
C     TRAILING PERIOD, OR BY 2 ADJACENT PERIODS.  SIGNS AND
C     EXPONENTS ARE NOT RECOGNIZED.
C
C     LOWVLU = SUBSCRIPT OF LOWEST LOCATION IN IVALUE ARRAY
C              WHICH CAN BE USED TO RETURN VALUES IN SERIES
C     MAXVLU = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  IVALUE
C              ARRAY  WHICH CAN BE USED TO RETURN VALUES IN
C              SERIES
C     MAXBFR = SUBSCRIPT  OF  LOCATION  IN   IBUFFR   ARRAY
C              CONTAINING FINAL CHARACTER TO BE EVALUATED
C     IBUFFR = ARRAY CONTAINING IN LOCATIONS LOWBFR THROUGH
C              MAXBFR  THE CHARACTERS TO BE EVALUATED AS IF
C              READ BY MULTIPLE OF A1 FORMAT OR BY  SEVERAL
C              1H FIELDS
C     LOWBFR = INPUT CONTAINING SUBSCRIPT OF FIRST LOCATION
C              OF  IBUFFR  ARRAY CONTAINING CHARACTER TO BE
C              EVALUATED
C            = RETURNED  CONTAINING  SUBSCRIPT   OF   FIRST
C              LOCATION    IN   IBUFFR   ARRAY   CONTAINING
C              CHARACTER NOT YET EVALUATED BY THIS ROUTINE
C     KIND   = 1, RETURNED IF IBUFFR IS EMPTY  OR  CONTAINS
C              ONLY  BLANKS  OR  TABS.   LOWBFR IS RETURNED
C              CONTAINING MAXBFR+1
C            = 2, RETURNED IF NUMBER NOT FOUND, BUT UNKNOWN
C              CHARACTER  IS  LOCATED  AT RETURNED VALUE OF
C              LOWBFR
C            = 3, RETURNED IF NUMBER OR SERIES  OF  NUMBERS
C              WAS  FOUND.   LOWBFR IS RETURNED POINTING TO
C              NEXT  CHARACTER  BEYOND  END  OF  SERIES  OF
C              NUMBERS
C            = 4, SAME  AS KIND=3,  EXCEPT  IVALUE CONTAINS
C              INSUFFICIENT SPACE  TO STORE ALL  THE VALUES
C              ENCOUNTERED.
C     IVALUE = ARRAY RETURNED CONTAINING EVALUATED  NUMBERS
C              IN  LOCATIONS  LOWVLU THROUGH RETURNED VALUE
C              OF KNTVLU.  A NUMBER INDICATED AS MISSING BY
C              AN  INITIAL  OR  TERMINAL  PERIOD,  OR  BY 2
C              ADJACENT PERIODS, IS INDICATED BY THE  VALUE
C              -1   BEING  RETURNED  IN  IVALUE.   NEGATIVE
C              NUMBERS ARE NOT OTHERWISE RETURNED
C     KNTVLU = RETURNED  CONTAINING  SUBSCRIPT  OF  HIGHEST
C              LOCATION USED IN IVALUE ARRAY.
C
      DIMENSION IBUFFR(MAXBFR),IVALUE(MAXVLU),IDIGIT(10)
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA IDOT,IBLANK,ITAB/1H.,1H ,1H	/
C
      KNTVLU=LOWVLU-1
      ISTATE=0
      NEWVLU=0
      GO TO 4
C
C     PERIOD FOUND
    1 IF(KNTVLU.GE.MAXVLU)GO TO 2
      IF(ISTATE.LE.0)NEWVLU=-1
      KNTVLU=KNTVLU+1
      IVALUE(KNTVLU)=NEWVLU
    2 NEWVLU=0
      ISTATE=-1
C
C     CHECK IF NEXT CHARACTER IS ALLOWED IN NUMBER SERIES
    3 LOWBFR=LOWBFR+1
    4 IF(LOWBFR.GT.MAXBFR)GO TO 7
      LETTER=IBUFFR(LOWBFR)
      IF(LETTER.EQ.IBLANK)GO TO 6
      IF(LETTER.EQ.ITAB)GO TO 6
      IF(LETTER.EQ.IDOT)GO TO 1
      DO 5 I=1,10
      IF(LETTER.NE.IDIGIT(I))GO TO 5
      ISTATE=1
      NEWVLU=(10*NEWVLU)+I-1
      GO TO 3
    5 CONTINUE
C
C     UNKNOWN CHARACTER FOUND
      IF(ISTATE.EQ.0)GO TO 9
C
C     SPACE OR TAB CHARACTER FOUND
    6 IF(ISTATE.EQ.0)GO TO 3
C
C     END OF BUFFER
    7 IF(ISTATE.EQ.0)GO TO 8
C
C     END OF NUMBER SEQUENCE
      IF(KNTVLU.GE.MAXVLU)GO TO 11
      IF(ISTATE.LE.0)NEWVLU=-1
      KNTVLU=KNTVLU+1
      IVALUE(KNTVLU)=NEWVLU
      GO TO 10
C
C     RETURN TO CALLING PROGRAM
    8 KIND=1
      GO TO 12
    9 KIND=2
      GO TO 12
   10 KIND=3
      GO TO 12
   11 KIND=4
   12 RETURN
C309755265976
      END
      SUBROUTINE DAPATH(LOWVLU,KNTVLU,IVALUE,JSTIFY,IFILL ,
     1    IWIDTH,LFTCOL,MAXBFR,IBUFFR,KOUNT ,IERR  )
C     RENBR(/REPRESENT INTEGER SEQUENCE OF FORM 1.2.3)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     LOWVLU = SUBSCRIPT OF LOWEST LOCATION IN IVALUE ARRAY
C              WHICH  SPECIFIES PART OF INTEGER SEQUENCE TO
C              BE REPRESENTED.
C     KNTVLU = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  IVALUE
C              ARRAY   WHICH   SPECIFIES  PART  OF  INTEGER
C              SEQUENCE TO BE REPRESENTED.
C     IVALUE = ARRAY  CONTAINING  DESCRIPTION  OF   INTEGER
C              SEQUENCE IN LOCATIONS IVALUE(LOWVLU) THROUGH
C              IVALUE(KNTVLU).  VALUES EQUAL TO OR  GREATER
C              THAN   ZERO  ARE  REPRESENTED  DIRECTLY  AND
C              SEPARATED BY PERIODS.  VALUES LESS THAN ZERO
C              ARE  NOT  REPRESENTED,  BUT  SAME SEPARATING
C              PERIODS   APPEAR   AS   IF    VALUES    WERE
C              REPRESENTED.
C     JSTIFY = -1, LEFT JUSTIFY REPRESENTATION  OF  INTEGER
C              SEQUENCE     IN    FIELD    CONSISTING    OF
C              IBUFFR(LFTCOL+1)   THROUGH    IBUFFR(LFTCOL+
C              IWIDTH).
C            = 0, CENTER REPRESENTATION OF INTEGER SEQUENCE
C              IN   FIELD  CONSISTING  OF  IBUFFR(LFTCOL+1)
C              THROUGH IBUFFR(LFTCOL+IWIDTH).  IBUFFR ARRAY
C              LOCATIONS   TO  LEFT  OF  REPRESENTATION  OF
C              INTEGER SEQUENCE ARE FILLED WITH SPACES.
C            = 1, RIGHT JUSTIFY REPRESENTATION  OF  INTEGER
C              SEQUENCE     IN    FIELD    CONSISTING    OF
C              IBUFFR(LFTCOL+1)   THROUGH    IBUFFR(LFTCOL+
C              IWIDTH).   IBUFFR ARRAY LOCATIONS TO LEFT OF
C              REPRESENTATION  OF  INTEGER   SEQUENCE   ARE
C              FILLED WITH SPACES.
C     IFILL  = 0, DO NOT FILL PORTION  OF  FIELD  RIGHT  OF
C              REPRESENTATION   OF  INTEGER  SEQUENCE  WITH
C              SPACES.  VALUE OF IFILL  HAS  NO  EFFECT  ON
C              PRINTING  CHARACTERS  IN  REPRESENTATION  OF
C              INTEGER SEQUENCE.  KOUNT  WILL  BE  RETURNED
C              POINTING  TO RIGHTMOST PRINTING CHARACTER IN
C              REPRESENTATION OF INTEGER SEQUENCE.
C            = 1, FILL FIELD  RIGHT  OF  REPRESENTATION  OF
C              INTEGER   SEQUENCE   AND  EXTENDING  THROUGH
C              IBUFFR(LFTCOL+IWIDTH)  WITH  SPACES.   KOUNT
C              WILL   BE   RETURNED  RETURNED  POINTING  TO
C              IBUFFR(LFTCOL+IWIDTH).
C     IWIDTH = WIDTH, STATED AS NUMBER OF COLUMNS OR IBUFFR
C              ARRAY  LOCATIONS,  OF FIELD IN WHICH INTEGER
C              SEQUENCE IS TO BE REPRESENTATED.   RIGHTMOST
C              IBUFFR ARRAY LOCATION IN FIELD HAS SUBSCRIPT
C              LFTCOL+IWIDTH OR ELSE MAXBFR,  WHICHEVER  IS
C              SMALLER.
C     LFTCOL = SUBSCRIPT  OF  IBUFFR  ARRAY   LOCATION   TO
C              IMMEDIATE  LEFT  OF  LEFTMOST  IBUFFR  ARRAY
C              LOCATION  INTO   WHICH   EITHER   SPACE   OR
C              CHARACTER   OF   REPRESENTATION  OF  INTEGER
C              SEQUENCE CAN BE PLACED.
C     MAXBFR = SUBSCRIPT OF RIGHTMOST IBUFFR ARRAY LOCATION
C              WHICH  COULD BE PLACED SPACE OR CHARACTER OF
C              REPRESENTATION OF INTEGER SEQUENCE IF IWIDTH
C              IS LARGE ENOUGH.
C     IBUFFR = ARRAY IN  WHICH  REPRESENTATION  OF  INTEGER
C              SEQUENCE  IS RETURNED, 1 CHARACTER PER ARRAY
C              LOCATION AS THOUGH READ BY  MULTIPLE  OF  A1
C              FORMAT.
C     KOUNT  = RETURNED CONTAINING SUBSCRIPT  OF  RIGHTMOST
C              LOCATION   OF   IBUFFR   ARRAY   INTO  WHICH
C              CHARACTER HAS BEEN PLACED BY THIS ROUTINE.
C     IERR   = -1  RETURNED  IF  REPRESENTATION  OF  ENTIRE
C              INTEGER  SEQUENCE  WOULD  NOT FIT INTO FIELD
C              INDICATED BY LFTCOL AND BY EITHER IWIDTH  OR
C              MAXBFR,  WHICHEVER  INDICATES SMALLER FIELD.
C              IF  MAXBFR  IS  GREATER  THAN  OR  EQUAL  TO
C              LFTCOL+IWIDTH, THEN IBUFFR(LFTCOL+1) THROUGH
C              IBUFFR(LFTCOL+IWIDTH)      ARE      RETURNED
C              CONTAINING  ASTERISKS, AND KOUNT IS RETURNED
C              SET EQUAL TO LFTCOL+IWIDTH.   IF  MAXBFR  IS
C              LESS  THAN LFTCOL+IWIDTH, THEN THE ASTERISKS
C              EXTEND THROUGH IBUFFR(MAXBFR) AND  KOUNT  IS
C              RETURNED SET EQUAL TO MAXBFR.
C            = 0 RETURNED IF ENTIRE INTEGER SEQUENCE  COULD
C              BE REPRESENTED IN FIELD.
C
      DIMENSION IBUFFR(MAXBFR),IVALUE(KNTVLU)
      DATA IDOT/1H./
C
C     PREPARE TO REPRESENT FIRST NUMBER IN SERIES
      LTREND=LFTCOL+IWIDTH
      IF(LTREND.GT.MAXBFR)LTREND=MAXBFR
      JPOINT=LFTCOL
      IERR=0
      IF(KNTVLU.LT.LOWVLU)GO TO 4
      INDEX=LOWVLU
C
C     REPRESENT NEXT NUMBER IN SERIES
    1 NUMBER=IVALUE(INDEX)
      IF(NUMBER.LT.0)GO TO 2
      INITAL=JPOINT
      CALL DANUMB(0,NUMBER,10,IBUFFR,JPOINT,INITAL,LTREND)
      IF(JPOINT.LE.INITAL)GO TO 3
    2 INDEX=INDEX+1
      IF(INDEX.GT.KNTVLU)GO TO 4
      IF(JPOINT.GE.LTREND)GO TO 3
      JPOINT=JPOINT+1
      IBUFFR(JPOINT)=IDOT
      GO TO 1
C
C     FILL FIELD WITH STARS IF SERIES WON'T FIT
    3 IERR=-1
C
C     JUSTIFY THE SERIES
    4 CALL DAMOVE(JSTIFY,IFILL ,LFTCOL,LTREND,IERR  ,
     1    IBUFFR,JPOINT )
C
C     RETURN TO CALLING PROGRAM
    5 KOUNT=JPOINT
      RETURN
C223649117134
      END
      SUBROUTINE DAVERB(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
     1    KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MATCH ,LCNWRD,
     2    LCNKNT,LCNBFR)
C     RENBR(/IDENTIFY WORDS OR ABBREVIATIONS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DAVERB  INTERPRETS  AN  ARRAY  READ  BY  THE  CALLING
C     PROGRAM   WITH   A  MULTIPLE  OF  AN  A1  FORMAT  AND
C     IDENTIFIES THE WORDS AND WORD ABBREVIATIONS CONTAINED
C     IN  THIS  ARRAY.   THE  WORDS ARE RECOGNIZED BY BEING
C     MATCHED AGAINST A USER DEFINED  DICTIONARY.   IF  THE
C     ARRAY   CONTAINS   ABBREVIATIONS   OF  WORDS  IN  THE
C     DICTIONARY, THEN DAVERB ALSO SPECIFIES WHETHER  THESE
C     ABBREVIATIONS ARE AMBIGUOUS.
C
C     ARGUMENT LIST DEFINITIONS:
C
C     LOWBFR IS USED  FOR BOTH  INPUT  AND OUTPUT.    KIND,
C     MATCH, LCNWRD,  LCNKNT AND  LCNBFR ARE  USED ONLY FOR
C     OUTPUT.  REMAINING ARGUMENTS ARE USED ONLY FOR INPUT.
C
C     LOWWRD = SUBSCRIPT  OF LOCATION IN  IWORD ARRAY WHICH
C              CONTAINS 1ST LETTER OF 1ST WORD.   NOTE THAT
C              IF KNTLTR(LOWKNT) IS NEGATIVE,  THEN THE 1ST
C              LETTER OF  1ST WORD  WILL BE  FOUND IN ARRAY
C              LOCATION IWORD(LOWWRD-KNTLTR(LOWKNT)).
C     MAXWRD = DIMENSION OF IWORD ARRAY.
C     IWORD  = DICTIONARY ARRAY  CONTAINING  CHARACTERS  OF
C              WORDS  TO  BE  RECOGNIZED,  1  CHARACTER PER
C              ARRAY LOCATION AS READ BY A1 FORMAT OR  ELSE
C              DEFINED BY 1H FIELD.  SECTIONS OF A WORD CAN
C              BE ABBREVIATED AND/OR SEPARATED BY SPACES OR
C              TABS  IF THE WORD IN IWORD CONTAINS A SINGLE
C              SPACE BETWEEN EACH SUCH SECTION AND  IF  THE
C              LENGTH  STORED  IN  THE  KNTLTR ARRAY IS 100
C              MORE THAN THE ACTUAL LENGTH  (INCLUDING  THE
C              SPACES).   ALL  LETTERS  IN  THE IWORD ARRAY
C              MUST BE UPPER CASE.
C     LOWKNT = SUBSCRIPT OF  KNTLTR ARRAY LOCATION DEFINING
C              LENGTH OF FIRST WORD WHICH CAN BE MATCHED IN
C              THE IWORD ARRAY.  THIS FIRST WORD WILL START
C              AT  IWORD(LOWWRD).   IF NO  WORDS ARE  TO BE
C              RECOGNIZED,  THEN  EITHER  MAXKNT  SHOULD BE
C              LESS  THAN LOWKNT,  OR ELSE  BOTH LOWKNT AND
C              MAXKNT CAN POINT  TO THE SAME ZERO  ENTRY IN
C              THE KNTLTR ARRAY.
C     MAXKNT = SUBSCRIPT OF  KNTLTR ARRAY LOCATION DEFINING
C              LENGTH OF FINAL WORD WHICH CAN BE MATCHED IN
C              THE IWORD ARRAY.
C     KNTLTR = ARRAY CONTAINING THE NUMBERS  OF  CHARACTERS
C              IN  THE WORDS IN THE IWORD ARRAY.  A ZERO OR
C              NEGATIVE VALUE IN THE KNTLTR  ARRAY  OFFSETS
C              THE  NEXT POSSIBLE WORD WHICH CAN BE MATCHED
C              IN THE IWORD ARRAY BY THE NUMBER OF  LETTERS
C              GIVEN  BY THE ABSOLUTE VALUE OF THE NEGATIVE
C              NUMBER IN THE KNTLTR  ARRAY.   DIMENSION  OF
C              KNTLTR MUST BE AT LEAST MAXKNT.  FOR EXAMPLE
C              TO RECOGNIZE THE WORDS
C
C                   YES, NO, MAYBE
C
C              THE CONTENTS OF THE IWORD ARRAY WOULD BE
C
C                   1HY,1HE,1HS,1HN,1HO,1HM,1HA,1HY,1HB,1HE
C
C              AND CONTENTS OF THE KNTLTR ARRAY WOULD BE
C
C                    3,2,5
C
C              IF A  WORD  IN  THE   IWORD  ARRAY  CONTAINS
C              EMBEDDED  SPACES,  THEN 100 MUST BE ADDED TO
C              THE LENGTH  STORED  FOR  THIS  WORD  IN  THE
C              KNTLTR  ARRAY  TO  ALLOW  THE PORTION OF THE
C              WORD  LEFT OF  THE SPACE TO  BE ABBREVIATED.
C              VALUES 101 THROUGH  199 IN KNTLTR ARRAY THUS
C              INDICATE WORDS CONTAINING  SPACES WHICH HAVE
C              LENGTHS  OF  1 THROUGH 99 RESPECTIVELY.  THE
C              VALUE 100 IN THE KNTLTR ARRAY IS TREATED THE
C              SAME AS A ZERO.
C     IBUFFR = INPUT  BUFFER  ARRAY  CONTAINING  CHARACTERS
C              TYPED BY USER,  READ BY A  MULTIPLE OF AN A1
C              FORMAT, WHICH IS  TO BE SEARCHED  FOR WORDS.
C              IBUFFR THEN  CONTAINS 1  LETTER PER COMPUTER
C              STORAGE  LOCATION.   LETTERS  IN THE  IBUFFR
C              ARRAY CAN BE EITHER UPPER OR LOWER CASE.
C     MAXBFR = MAXIMUM SUBSCRIPT  OF  IBUFFR  ARRAY  TO  BE
C              SEARCHED
C     LOWBFR = SUBSCRIPT WITHIN THE  IBUFFR  ARRAY  OF  THE
C              FIRST  (LEFTMOST)  CHARACTER  WHICH  CAN  BE
C              SCANNED FOR WORDS.  LOWBFR WILL BE  RETURNED
C              POINTING  TO THE  NEXT  CHARACTER  BEYOND  A
C              MATCHED  WORD  IF A WORD IS FOUND.  IF THERE
C              IS NOTHING AT OR TO RIGHT  OF  LOWBFR,  THEN
C              LOWBFR WILL BE LEFT POINTING AT MAXBFR+1 AND
C              KIND  WILL  BE  RETURNED   CONTAINING   ONE.
C              LOWBFR MUST BE SET BY CALLING PROGRAM BEFORE
C              ANYTHING IS  PROCESSED IN  CURRENT  CONTENTS
C              OF  THE IBUFFR ARRAY, BUT THEN SHOULD NOT BE
C              MODIFIED BY CALLING PROGRAM UNTIL THE ENTIRE
C              CONTENTS OF IBUFFR ARRAY HAS BEEN PROCESSED.
C     KIND   = RETURNED DESCRIBING THE KIND OF ITEM LOCATED
C              IN THE IBUFFR ARRAY.
C            = 1, NOTHING  WAS FOUND AT OR  TO THE RIGHT OF
C              LOWBFR.  THE  CALLING  PROGRAM SHOULD READ A
C              NEW LINE INTO IBUFFR.
C            = 2, ACCEPTABLE  WORD OR  ABBREVIATION THEREOF
C              WAS NOT FOUND,  BUT A PRINTING CHARACTER WAS
C              FOUND WHICH  DOES NOT BEGIN  ANY WORD IN THE
C              DICTIONARY.   LOWBFR IS RETURNED POINTING TO
C              THIS PRINTING CHARACTER.
C            = RETURNED  CONTAINING 3, 4  OR 5 IF A WORD IN
C              THE DICTIONARY  WAS MATCHED  EVEN PARTIALLY.
C              FOR EXAMPLE, IF DICTIONARY CONTAINED BOTH OF
C              THE WORDS NO AND NONE, THEN
C              A) INITIAL LETTER N  IN THE BUFFER  FOLLOWED
C                 BY SOME CHARACTER OTHER THAN THE LETTER O
C                 WOULD BE  AMBIGUOUS  ABBREVIATION AND THE
C                 POINTER  NAMED  MATCH  WOULD BE  RETURNED
C                 POINTING TO  (CONTAINING  SEQUENCE NUMBER
C                 WITHIN DICTIONARY  OF) WHICHEVER  WORD NO
C                 OR NONE APPEARED FIRST IN THE DICTIONARY.
C              B) INITIAL LETTERS N AND  O FOLLOWED BY SOME
C                 CHARACTER OTHER  THAN THE  LETTER N WOULD
C                 BE AN EXACT MATCH WITH THE WORD NO.
C              C) INITIAL LETTERS N AND  O AND N WOULD BE A
C                 PARTIAL  BUT NONAMBIGUOUS MATCH  WITH THE
C                 WORD NONE.
C              LEADING SPACES AND/OR  TABS ARE IGNORED.   A
C              STRING  OF  CHARACTERS  CONTAINING  EMBEDDED
C              SPACES AND/OR  TABS CAN MATCH  A WORD IN THE
C              DICTIONARY  ONLY IF  THE WORD  IN DICTIONARY
C              CONTAINS A  SINGLE SPACE AT  THE POSITION AT
C              WHICH  THE SPACES AND/OR TABS   ARE  ALLOWED
C              (BUT NOT NECESSARY).
C            = 3, A WORD IN THE  IWORD  ARRAY  WAS  MATCHED
C              EXACTLY.   MATCH  IS RETURNED CONTAINING THE
C              SEQUENCE NUMBER OF THE WORD MATCHED  IN  THE
C              IWORD ARRAY.
C            = 4, A NONAMBIGUOUS ABBREVIATION OF A WORD  IN
C              THE   IWORD   ARRAY  WAS  FOUND.   MATCH  IS
C              RETURNED CONTAINING THE SEQUENCE  NUMBER  OF
C              THE WORD IN THE IWORD ARRAY.
C            = 5, AN AMBIGUOUS ABBREVIATION OF A  WORD  WAS
C              FOUND.   MATCH  IS  RETURNED  CONTAINING THE
C              SEQUENCE NUMBER OF THE FIRST WORD MATCHED IN
C              THE IWORD ARRAY.
C     MATCH  = RETURNED CONTAINING THE SEQUENCE NUMBER OF A
C              WORD  MATCHED  IN THE IWORD ARRAY IF KIND IS
C              RETURNED CONTAINING 3, 4 OR 5.  FOR EXAMPLE,
C              IF  THE  SECOND  WORD IS MATCHED, THEN MATCH
C              WOULD  BE  RETURNED   CONTAINING   2.    THE
C              SEQUENCE  NUMBER  OF  THE  WORD IN THE IWORD
C              ARRAY DOES NOT INCLUDE THE  LETTERS  SKIPPED
C              OVER  BY  THE  VALUE OF LOWWRD, AND DOES NOT
C              INCLUDE THE LETTERS SKIPPED OVER BY NEGATIVE
C              VALUES  ENCOUNTERED  IN  THE  KNTLTR  ARRAY.
C              MATCH IS RETURNED CONTAINING KIND-2 IF  KIND
C              IS RETURNED .LE.2 INDICATING THAT NO WORD IN
C              THE  IWORD  ARRAY  COULD  BE  MATCHED   EVEN
C              PARTIALLY.   THIS MEANS  THAT IF THE CALLING
C              PROGRAM  TESTS FOR  KIND=5 AFTER  THE RETURN
C              FROM DAVERB, AND IF KIND=4 IS TO BE TAKEN AS
C              EQUIVALENT  TO KIND=3,  THEN CALLING PROGRAM
C              CAN ADD 2 TO THE VALUE OF MATCH AND USE THIS
C              SUM AS INDEX FOR A COMPUTED GO TO STATEMENT.
C     LCNWRD = IF KIND IS RETURNED CONTAINING 3 OR GREATER,
C              LOCWRD IS  RETURNED WITH  SUBSCRIPT OF IWORD
C              LOCATION CONTAINING FIRST  LETTER OF MATCHED
C              WORD.
C     LCNKNT = IF KIND IS RETURNED CONTAINING 3 OR GREATER,
C              LCNKNT IS RETURNED  WITH SUBSCRIPT OF KNTWRD
C              LOCATION CONTAINING THE WORD LENGTH.
C     LCNBFR = IF KIND IS RETURNED CONTAINING 3 OR GREATER,
C              INDICATING  THAT  A WORD OR ITS ABBREVIATION
C              WAS   FOUND,   THEN   LCNBFR   IS   RETURNED
C              CONTAINING THE SUBSCRIPT OF THE IBUFFR ARRAY
C              LOCATION WHICH CONTAINS THE FIRST  CHARACTER
C              OF THE WORD OR ITS ABBREVIATION.
C
      DIMENSION IBUFFR(MAXBFR),IWORD(MAXWRD),
     1KNTLTR(MAXKNT),KONVRT(10),KAPITL(26),LOWER(26)
C
C     CCCC       AAA UU   UU TTTTTTTT IIII  OOOO   NN    NN
C   CC          AAAA UU   UU    TT     II  OO  OO  NNN   NN
C  CC          AA AA UU   UU    TT     II OO    OO NNNN  NN
C  CC         AA  AA UU   UU    TT     II OO    OO NN NN NN
C  CC        AAAAAAA UU   UU    TT     II OO    OO NN  NNNN
C   CC      AA    AA  UU UU     TT     II  OO  OO  NN   NNN
C     CCCC AA     AA   UUU      TT    IIII  OOOO   NN    NN
C
C     TO CONVERT LOWER  CASE  LETTERS  IN  THE  INPUT  TEXT
C     BUFFER  INTO  UPPER CASE LETTERS WHICH CAN BE MATCHED
C     AGAINST THE DICTIONARY,  THIS  ROUTINE  COMPARES  THE
C     CHARACTERS IN THE INPUT TEXT BUFFER AGAINST THE LOWER
C     CASE LETTERS IN THE LOWER ARRAY.  THE LETTERS IN  THE
C     LOWER  ARRAY MUST BE ARRANGED IN INCREASING NUMERICAL
C     ORDER.  IF THE NUMERICAL ORDER IS NOT THE SAME AS THE
C     ALPHABETICAL   ORDER,   THEN   THE   DATA  STATEMENTS
C     APPEARING BELOW MUST BE CHANGED OR ELSE SOME  OR  ALL
C     LOWER  CASE LETTERS IN THE INPUT TEXT BUFFER WILL NOT
C     BE TREATED AS EQUIVALENT TO THE  CORRESPONDING  UPPER
C     CASE  LETTERS.   ONCE THE LETTERS IN THE  LOWER ARRAY
C     ARE SORTED INTO INCREASING NUMERICAL ORDER, THE UPPER
C     CASE LETTERS IN THE KAPITL ARRAY SHOULD BE REARRANGED
C     SO THAT LOWER AND UPPER CASE VERSIONS OF EACH  LETTER
C     APPEAR  IN  LOCATIONS  IN THE LOWER AND KAPITL ARRAYS
C     HAVING THE SAME SUBSCRIPTS.
C
C     IF THE COMPUTER UPON WHICH THIS ROUTINE IS USED  DOES
C     NOT  SUPPORT  LOWER CASE LETTERS, THEN BOTH THE LOWER
C     AND KAPITL ARRAYS CAN CONTAIN THE LETTERS 1HA THROUGH
C     1HZ  IN  ALPHABETICAL  ORDER (EVEN IF THIS IS NOT THE
C     NUMERICALLY SORTED ORDER).
C
C     KAPITL = UPPER CASE LETTERS A THROUGH Z SORTED ON
C              LOWER ARRAY
      DATA KAPITL/
     11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     31HU,1HV,1HW,1HX,1HY,1HZ/
C
C     LOWER  = LOWER CASE LETTERS A THROUGH Z SORTED INTO
C              NUMERICALLY INCREASING ORDER
      DATA LOWER/
     11Ha,1Hb,1Hc,1Hd,1He,1Hf,1Hg,1Hh,1Hi,1Hj,
     21Hk,1Hl,1Hm,1Hn,1Ho,1Hp,1Hq,1Hr,1Hs,1Ht,
     31Hu,1Hv,1Hw,1Hx,1Hy,1Hz/
C
C     IBLANK = THE BLANK OR SPACE CHARACTER
C     ITAB   = TABULATION  CHARACTER,  THIS CAN BE REPLACED
C              BY SPACE IF TAB CHARACTER IS NOT AVAILABLE
      DATA IBLANK,ITAB/1H ,1H	/
C
C     SEARCH FOR FIRST PRINTING CHARACTER
      GO TO 2
    1 LOWBFR=LOWBFR+1
    2 IF(LOWBFR.GT.MAXBFR)GO TO 29
      NOWLTR=IBUFFR(LOWBFR)
      IF(NOWLTR.EQ.IBLANK)GO TO 1
      IF(NOWLTR.EQ.ITAB)GO TO 1
C
C     SET INITIAL CONSTANTS IF FIND PRINTING CHARACTER
      LMTBFR=MAXBFR
      LCNBFR=LOWBFR
      IEND=LOWWRD
      MSTSAM=1
      KNTKNV=0
      KNTWRD=LOWKNT-1
      INDEX=0
    3 IEXACT=1
    4 KNTWRD=KNTWRD+1
      IF(KNTWRD.GT.MAXKNT)GO TO 28
C
C     GET NEXT WORD IN DICTIONARY
      JEND=KNTLTR(KNTWRD)
      KEND=JEND-100
      IF(KEND.GE.0)JEND=KEND
      IF(JEND.LE.0)GO TO 27
      KEND=0
      NXTCMP=IEND
      IEND=IEND+JEND
      JEXACT=-1
      INDEX=INDEX+1
      NXTBFR=LOWBFR
      NOWSAM=1
C
C     GET NEXT CHARACTERS TO BE COMPARED
    5 IF(NXTBFR.GT.LMTBFR)GO TO 22
      KOMPAR=IBUFFR(NXTBFR)
      IF(KOMPAR.EQ.IBLANK)GO TO 15
      IF(KOMPAR.EQ.ITAB)GO TO 15
      IF(NOWSAM.LE.KNTKNV)GO TO 13
C
C     DETERMINE UPPER CASE  VERSION OF A LOWER CASE LETTER.
C     THIS IS A TERNARY SEARCH TAKING ADVANTAGE OF THE SIZE
C     OF  ALPHABET BEING NEARLY 3**3.  THE 3RD OF THE ARRAY
C     CONTAINING THE DESIRED LETTER IS FIRST LOCATED,  THEN
C     THE  3RD  OF  THIS  3RD,  AND  FINALLY  EACH  OF  THE
C     REMAINING 3  LETTERS  ARE  TESTED  INDIVIDUALLY.   TO
C     PREVENT  TESTING  AGAINST  THE 27TH LETTER WHICH DOES
C     NOT EXIST, UPPER 3RD  IS  TAKEN  AS  UPPER  9  SORTED
C     LETTERS,  RATHER THAN FROM 19TH THROUGH 27TH LETTERS,
C     SO THAT LOWER(18) IS TESTED AGAINST IN UPPER 3RD EVEN
C     THOUGH LETTER BEING MATCHED HAS ALREADY BEEN FOUND TO
C     BE LARGER THAN THIS.
      IF(KOMPAR.GT.LOWER(18))GO TO 7
      IF(KOMPAR.GT.LOWER(9))GO TO 6
      IF(KOMPAR.LT.LOWER(1))GO TO 11
      KUT=3
      GO TO 8
    6 KUT=12
      GO TO 8
    7 IF(KOMPAR.GT.LOWER(26))GO TO 11
      KUT=20
    8 IF(KOMPAR.LE.LOWER(KUT))GO TO 9
      KUT=KUT+3
      IF(KOMPAR.GT.LOWER(KUT))KUT=KUT+3
    9 IF(KOMPAR.EQ.LOWER(KUT))GO TO 10
      KUT=KUT-1
      IF(KOMPAR.EQ.LOWER(KUT))GO TO 10
      KUT=KUT-1
      IF(KOMPAR.NE.LOWER(KUT))GO TO 11
   10 KOMPAR=KAPITL(KUT)
   11 IF(KNTKNV.GE.10)GO TO 12
      KNTKNV=KNTKNV+1
      KONVRT(KNTKNV)=KOMPAR
C
C     DETERMINE IF LETTER IN BUFFER MATCHES DICTIONARY.
   12 IF(KOMPAR.EQ.IWORD(NXTCMP))GO TO 19
      GO TO 14
   13 IF(KONVRT(NOWSAM).EQ.IWORD(NXTCMP))GO TO 19
   14 IF(KEND.LE.0)GO TO 23
      GO TO 17
   15 IF(KEND.LE.0)GO TO 23
   16 NXTBFR=NXTBFR+1
      IF(NXTBFR.GT.LMTBFR)GO TO 22
      IF(IBUFFR(NXTBFR).EQ.IBLANK)GO TO 16
      IF(IBUFFR(NXTBFR).EQ.ITAB)GO TO 16
   17 KEND=0
   18 IF(IWORD(NXTCMP).EQ.IBLANK)GO TO 20
      JEXACT=0
      NXTCMP=NXTCMP+1
      IF(NXTCMP.LT.IEND)GO TO 18
      GO TO 24
   19 NOWSAM=NOWSAM+1
      NEWBFR=NXTBFR
      KEND=JEND
      NXTBFR=NXTBFR+1
   20 NXTCMP=NXTCMP+1
   21 IF(NXTCMP.LT.IEND)GO TO 5
      GO TO 24
C
C     WORD CANNOT EXTEND FURTHER TO RIGHT
   22 LMTBFR=NEWBFR
   23 JEXACT=0
   24 IF(NOWSAM.LT.MSTSAM)GO TO 4
      IF(NOWSAM.GT.MSTSAM)GO TO 26
      IF(IEXACT.GE.0)GO TO 25
      IF(JEXACT.LT.0)GO TO 3
      GO TO 4
   25 IF(JEXACT.GE.0)GO TO 3
   26 IEXACT=JEXACT
      MSTSAM=NOWSAM
      MATCH=INDEX
      LSTBFR=NEWBFR+1
      LCNKNT=KNTWRD
      LCNWRD=IEND
      GO TO 4
   27 IEND=IEND-JEND
      GO TO 4
C
C     ENTIRE DICTIONARY HAS BEEN SEARCHED
   28 IF(MSTSAM.LE.1)GO TO 30
      LOWBFR=LSTBFR
      KIND=4+IEXACT
      JEND=KNTLTR(LCNKNT)
      IF(JEND.GE.100)JEND=JEND-100
      LCNWRD=LCNWRD-JEND
      GO TO 31
C
C     NO PRINTING CHARACTERS WERE FOUND TO BE IDENTIFIED
   29 KIND=1
      MATCH=-1
      GO TO 31
C
C     NOT EVEN A PARTIAL MATCH COULD BE MADE
   30 KIND=2
      MATCH=0
C
C     RETURN TO CALLING PROGRAM
   31 RETURN
C
C     IEXACT = -1, EXACT MATCH FOUND BUT MUST CHECK THAT
C              A LONGER MATCH CANNOT BE FOUND WITH ANOTHER
C              WORD (FOR EXAMPLE, IF IWORD ARRAY CONTAINS
C              BOTH OF THE WORDS NO AND NONE, THEN THE
C              BUFFER CONTENTS "NON" WOULD MATCH WORD NO
C              EXACTLY, BUT THE PARTIAL MATCH WITH WORD
C              NONE WOULD BE BETTER)
C            = 0, A PARTIAL MATCH HAS BEEN FOUND
C            = 1, NO MATCH FOUND OR DUPLICATE PARTIAL
C     MSTSAM = 1 + MAXIMUM NUMBER OF LETTERS MATCHED
C     NOWSAM = 1 + NUMBER OF LETTERS MATCHING CURRENT WORD
C864241272470abcdefghijklmnopqrstuvwxyz
      END
      SUBROUTINE DASWAP(IARRAY,LOW,MID,MAX)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     ROUTINE TO SWAP ADJACENT SECTIONS OF SINGLE ARRAY
C
C     IARRAY = ARRAY CONTAINING SECTIONS TO BE SWAPPED
C     LOW    = SUBSCRIPT OF LOWEST LOCATION IN LOW SECTION
C     MID    = SUBSCRIPT OF HIGHEST LOCATION IN LOW SECTION
C     MAX    = SUBSCRIPT OF HIGHEST LOCATION IN HIGH
C              SECTION
C
C     SWAP IS PERFORMED BY MOVING VALUES DIRECTLY TO
C     LOCATIONS THEY ARE TO OCCUPY IN THE RESULT.
C
C     FOR EXAMPLE, TO SWAP ABCD AND 123 IN THE
C     FOLLOWING EXAMPLE, 3 IS MOVED TO LOCATION HOLDING C
C     WHICH IS MOVED TO LOCATION HOLDING 2 AND SO ON.
C
C     A  B  C  D  1  2  3
C     .  .  I-----------I
C     .  .  I--------I  .
C     .  I-----------I  .
C     .  I--------I  .  .
C     I-----------I  .  .
C     I--------I  .  .  .
C     .  .  .  I--------I
C
C     IARRAY ARRAY AND NEW AND KEEP VARIABLES SHOULD BE
C     MADE FLOATING POINT TO SWAP A FLOATING POINT ARRAY.
C
      DIMENSION IARRAY(MAX)
      IF(LOW.GT.MID)GO TO 5
      IF(MID.GE.MAX)GO TO 5
      KOUNT=LOW-MAX-1
      LAST=MAX
      LONGLO=LOW-MID-1
      LONGHI=MAX-MID
    1 INDEX=LAST+LONGLO
      KEEP=IARRAY(LAST)
    2 KOUNT=KOUNT+1
      NEW=IARRAY(INDEX)
      IARRAY(INDEX)=KEEP
      KEEP=NEW
      IF(INDEX.GT.MID)GO TO 3
      INDEX=INDEX+LONGHI
      GO TO 2
    3 IF(INDEX.EQ.LAST)GO TO 4
      INDEX=INDEX+LONGLO
      GO TO 2
    4 IF(KOUNT.EQ.0)GO TO 5
      LAST=LAST-1
      GO TO 1
    5 RETURN
C107401072377
      END
      SUBROUTINE DAFILL(INITAL,INTRVL,IBEGIN,IFINAL,MAXBFR,
     1IBUFFR,MAXPRT,MAXUSD)
C     RENBR(/EXPAND TABS TO SPACES WITHOUT EXTRA BUFFER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THE TAB CHARACTER IS A  NONPRINTING  CHARACTER  WHICH
C     CAUSES  THE FOLLOWING CHARACTER TO APPEAR IN THE NEXT
C     COLUMN BEYOND THE NEXT MULTIPLE OF THE TAB STOP.
C
C     INITAL = LESS THAN ZERO,  PROVIDING  THAT  INTRVL  IS
C              GREATER  THAN  ZERO,  THE  NUMBER  OF  EXTRA
C              SPACES INDICATED BY THE  ABSOLUTE  VALUE  OF
C              INITAL  ARE  TO  BE INSERTED AT THE START OF
C              THE BUFFER SHIFTING  THE REST OF THE TEXT TO
C              THE RIGHT.   THE FIRST  TAB STOP  WILL BE OF
C              THE WIDTH INDICATED BY INTRVL.  IF INTRVL IS
C              LESS THAN OR EQUAL TO ZERO, THEN NO  LEADING
C              SPACES WILL APPEAR AT START OF THE PROCESSED
C              TEXT, WHETHER  REQUESTED  BY  INITAL  OR  BY
C              LEADING SPACES OR TABS IN THE IBUFFR ARRAY.
C            = EQUAL TO OR GREATER THAN ZERO, INITAL IS THE
C              NUMBER  OF SPACES TO THE FIRST TAB STOP.  IF
C              INITAL  IS ZERO,  THEN  THE  DISTANCE TO THE
C              FIRST  TAB STOP  IS  TAKEN  AS THE  ABSOLUTE
C              VALUE OF INTRVL.   IF THE FIRST CHARACTER IN
C              INPUT BUFFER IS A TAB,  IT WILL BE  EXPANDED
C              TO THIS NUMBER  OF SPACES.  INITAL CAN EQUAL
C              EITHER ZERO OR VALUE  OF INTRVL IF FIRST TAB
C              STOP IS TO BE  OF SAME WIDTH  AS THOSE WHICH
C              FOLLOW IT.
C     INTRVL = THE ABSOLUTE VALUE OF INTRVL IS THE TAB STOP
C              INTERVAL.   A  TAB  CHARACTER  IN  THE INPUT
C              BUFFER CAUSES THE FOLLOWING CHARACTER TO  GO
C              INTO THE NEXT POSITION BEYOND THE SUM OF THE
C              ABSOLUTE VALUE OF INITAL AND  NEXT  MULTIPLE
C              OF THE ABSOLUTE VALUE OF INTRVL.
C            = LESS THAN ZERO, NO LEADING SPACES ARE TO  BE
C              INSERTED   INTO THE  PROCESSED  TEXT WHETHER
C              REQUESTED BY A NEGATIVE VALUE OF  INITAL  OR
C              BY  LEADING  SPACES  OR  TABS  IN THE IBUFFR
C              ARRAY.  ONCE A PRINTING CHARACTER  HAS  BEEN
C              ENCOUNTERED  IN THE  TEXT  BEING  PROCESSED,
C              THEN ALL REMAINING SPACES WILL BE COPIED AND
C              REMAINING TABS WILL BE EXPANDED TO SPACES.
C            = ZERO, NO SPACES ARE TO BE INSERTED INTO  THE
C              PROCESSED  TEXT.   TABS IN THE  INPUT BUFFER
C              ARE IGNORED, AND SPACES ARE NOT COPIED.
C            = GREATER  THAN  ZERO,  ALL   SPACES   WHETHER
C              REQUESTED  BY  A NEGATIVE VALUE OF INITAL OR
C              BY SPACES  OR TABS  IN THE INPUT  BUFFER ARE
C              INSERTED INTO THE PROCESSED TEXT.
C     IBEGIN = SUBSCRIPT OF THE IBUFFR ARRAY AT WHICH IS TO
C              BE FOUND THE FIRST  CHARACTER OF THE TEXT TO
C              BE PROCESSSED.   FOLLOWING CONVERSION OF TAB
C              CHARACTERS TO PROPER NUMBER  OF SPACES,  THE
C              TEXT  IS PLACED  BACK INTO THE  IBUFFR ARRAY
C              STARTING AT SUBSCRIPT IBEGIN.
C     IFINAL = SUBSCRIPT OF THE IBUFFR ARRAY AT WHICH IS TO
C              BE FOUND THE FINAL  CHARACTER OF THE TEXT TO
C              BE PROCESSED.
C     MAXBFR = MAXIMUM  SUBSCRIPT  OF THE  IBUFFR  ARRAY AT
C              WHICH THE  FINAL CHARACTER  OF THE PROCESSED
C              TEXT CAN BE PLACED.  MAXBFR MUST BE EQUAL TO
C              OR BE GREATER THAN IFINAL.
C     IBUFFR = ARRAY USED FOR  INPUT OF THE TEXT CONTAINING
C              TAB CHARACTERS TO BE  EXPANDED TO THE PROPER
C              NUMBER OF SPACES, AND USED FOR OUTPUT OF THE
C              TEXT AFTER THE EXPANSION HAS BEEN PERFORMED.
C              IBUFFR  CONTAINS  CHARACTERS  READ   BY   A1
C              FORMAT.
C     MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION  IN THE OUTPUT  CONTENTS OF  IBUFFR
C              WHICH CONTAINS A PRINTING CHARACTER.
C     MAXUSD = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION IN  THE IBUFFR  ARRAY  CONTAINING A
C              CHARACTER OF THE TEXT  AFTER PROCESSING.  IF
C              INTRVL IS LESS  THAN OR EQUAL  TO ZERO,  AND
C              TEXT  CONTAINS  ONLY SPACES  AND TABS,  THEN
C              MAXUSD  IS RETURNED  SET EQUAL  TO IBEGIN-1.
C              THE MAXIMUM VALUE OF MAXUSD IS MAXBFR.
C
C
      DIMENSION IBUFFR(MAXBFR)
C
C     ISPACE = THE SPACE CHARACTER
C     ITAB   = THE TAB CHARACTER
      DATA ISPACE,ITAB/1H ,1H	/
C
C     ****************************************************
C     *                                                  *
C     *  COPY CHARACTERS GOING TO LEFT OR STAYING FIXED  *
C     *                                                  *
C     ****************************************************
C
C     INITIAL POINTERS
      JBEGIN=IBEGIN-1
      JUSED=JBEGIN
      JPRINT=JUSED
      NEED=INITAL
      KPYEND=MAXBFR
      LOKEND=IFINAL
C
C     INSERT EXTRA SPACES AT START IF INITAL.LT.0
      IF(INTRVL.LE.0)GO TO 1
      JNTRVL=INTRVL
      IF(NEED.LT.0)GO TO 9
      NONSPC=1
      GO TO 2
    1 JNTRVL=-INTRVL
      NONSPC=0
C
C     TEST IF AT END OF TEXT MOVING LEFT OR KEPT IN PLACE
    2 IF(JBEGIN.GE.LOKEND)GO TO 21
      JBEGIN=JBEGIN+1
C
C     SET DISTANCE TO NEXT TAB STOP OF JUST BEYOND LAST
      IF(NEED.LE.0)NEED=JNTRVL
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(JBEGIN).EQ.ISPACE)GO TO 5
      IF(IBUFFR(JBEGIN).NE.ITAB)GO TO 6
C
C     IF FIND A TAB, COPY IN THE SPACES TO NEXT TAB STOP
      IF(NONSPC.EQ.0)GO TO 4
    3 JUSED=JUSED+1
      IBUFFR(JUSED)=ISPACE
      NEED=NEED-1
      IF(NEED.LE.0)GO TO 2
      IF(JUSED.LT.JBEGIN)GO TO 3
      GO TO 10
    4 NEED=0
      GO TO 2
C
C     IF FIND CHARACTER OTHER THAN A TAB, JUST COPY IT
    5 IF(NONSPC.NE.0)GO TO 7
      GO TO 8
    6 JPRINT=JUSED+1
      NONSPC=JNTRVL
    7 JUSED=JUSED+1
      IBUFFR(JUSED)=IBUFFR(JBEGIN)
    8 NEED=NEED-1
      GO TO 2
C
C     *****************************************************
C     *                                                   *
C     *  MOVE RIGHTMOST AS YET UNMOVED GROUP OF TABS OR   *
C     *  GROUP OF NON-TABS TO ITS FINAL DESTINATION       *
C     *                                                   *
C     *****************************************************
C
C     INITIAL POINTERS
    9 NEED=-NEED
   10 IF(KPYEND.LE.JBEGIN)GO TO 21
      LOOK=JBEGIN
      KOPY=JBEGIN
      LIMIT=NEED
      GO TO 13
C
C     TEST IF HAVE SCANNED TO RIGHT END OF UNPROCESSED TEXT
   11 IF(KOPY.GE.KPYEND)GO TO 17
   12 IF(LOOK.GE.LOKEND)GO TO 17
      LOOK=LOOK+1
C
C     SET DISTANCE TO NEXT TAB STOP OF JUST BEYOND LAST
      IF(LIMIT.LE.0)LIMIT=JNTRVL
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(LOOK).EQ.ISPACE)GO TO 16
      IF(IBUFFR(LOOK).NE.ITAB)GO TO 15
C
C     IF FIND A TAB, RECORD NUMBER OF SPACES TO NEXT STOP
      IF(KIND.GT.0)GO TO 14
   13 LOCATN=KOPY
      KIND=1
   14 KOPY=KOPY+LIMIT
      LIMIT=0
      IF(KOPY.LT.KPYEND)GO TO 12
      KOPY=KPYEND
      GO TO 17
C
C     IF FIND CHARACTER OTHER THAN A TAB, RECORD LOCATION
   15 IF(KOPY.GE.JPRINT)JPRINT=KOPY+1
   16 LIMIT=LIMIT-1
      IF(KIND.GT.0)LOCATN=KOPY
      KOPY=KOPY+1
      KIND=0
      GO TO 11
C
C     COPY RIGHTMOST GROUP OF CHARACTERS
   17 IF(JUSED.LT.KOPY)JUSED=KOPY
      IF(KIND.GT.0)GO TO 19
   18 IBUFFR(KOPY)=IBUFFR(LOOK)
      KOPY=KOPY-1
      LOOK=LOOK-1
      IF(KOPY.GT.LOCATN)GO TO 18
      GO TO 20
   19 IBUFFR(KOPY)=ISPACE
      KOPY=KOPY-1
      IF(KOPY.GT.LOCATN)GO TO 19
      LOOK=LOOK-1
C
C     SHRINK THE UNPROCESSED REGION AND GO BACK TO DO AGAIN
   20 LOKEND=LOOK
      KPYEND=KOPY
      GO TO 10
C
C     RETURN TO CALLING PROGRAM
   21 MAXUSD=JUSED
      MAXPRT=JPRINT
      RETURN
C404242973694
      END
      SUBROUTINE DAIFLL(INITAL,INTRVL,IBEGIN,IFINAL,MAXBFR,
     1IBUFFR,MAXPRT,MAXUSD)
C     RENBR(/EXPAND TABS TO SPACES WITHOUT EXTRA BUFFER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THE TAB CHARACTER IS A  NONPRINTING  CHARACTER  WHICH
C     CAUSES  THE FOLLOWING CHARACTER TO APPEAR IN THE NEXT
C     COLUMN BEYOND THE NEXT MULTIPLE OF THE TAB STOP.
C
C     INITAL = EQUAL TO OR GREATER THAN ZERO, INITAL IS THE
C              NUMBER  OF SPACES TO THE FIRST TAB STOP.  IF
C              INITAL  IS ZERO,  THEN DISTANCE TO FIRST TAB
C              IS VALUE OF INTRVL.   IF  FIRST CHARACTER IN
C              INPUT BUFFER IS A TAB,  IT WILL BE  EXPANDED
C              TO THIS NUMBER  OF SPACES.  INITAL CAN EQUAL
C              EITHER ZERO OR VALUE  OF INTRVL IF FIRST TAB
C              STOP IS TO BE  OF SAME WIDTH  AS THOSE WHICH
C              FOLLOW IT.
C     INTRVL = TAB STOP INTERVAL.  A TAB CHARACTER IN INPUT
C              BUFFER CAUSES THE FOLLOWING CHARACTER TO  GO
C              INTO THE NEXT POSITION BEYOND THE SUM OF THE
C              VALUE OF INITAL AND NEXT MULTIPLE OF INTRVL.
C     IBEGIN = SUBSCRIPT OF THE IBUFFR ARRAY AT WHICH IS TO
C              BE FOUND THE FIRST  CHARACTER OF THE TEXT TO
C              BE PROCESSSED.   FOLLOWING CONVERSION OF TAB
C              CHARACTERS TO PROPER NUMBER  OF SPACES,  THE
C              TEXT  IS PLACED  BACK INTO THE  IBUFFR ARRAY
C              STARTING AT SUBSCRIPT IBEGIN.
C     IFINAL = SUBSCRIPT OF THE IBUFFR ARRAY AT WHICH IS TO
C              BE FOUND THE FINAL  CHARACTER OF THE TEXT TO
C              BE PROCESSED.
C     MAXBFR = MAXIMUM  SUBSCRIPT  OF THE  IBUFFR  ARRAY AT
C              WHICH THE  FINAL CHARACTER  OF THE PROCESSED
C              TEXT CAN BE PLACED.  MAXBFR MUST BE EQUAL TO
C              OR BE GREATER THAN IFINAL.
C     IBUFFR = ARRAY USED FOR  INPUT OF THE TEXT CONTAINING
C              TAB CHARACTERS TO BE  EXPANDED TO THE PROPER
C              NUMBER OF SPACES, AND USED FOR OUTPUT OF THE
C              TEXT AFTER THE EXPANSION HAS BEEN PERFORMED.
C              IBUFFR  CONTAINS  CHARACTERS  READ   BY   A1
C              FORMAT.
C     MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION  IN THE OUTPUT  CONTENTS OF  IBUFFR
C              WHICH CONTAINS A PRINTING CHARACTER.
C     MAXUSD = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION IN  THE IBUFFR  ARRAY  CONTAINING A
C              CHARACTER OF THE TEXT AFTER PROCESSING.  THE
C              MAXIMUM VALUE OF MAXUSD IS MAXBFR.
C
      DIMENSION IBUFFR(MAXBFR)
C
C     ISPACE = THE SPACE CHARACTER
C     ITAB   = THE TAB CHARACTER
      DATA ISPACE,ITAB/1H ,1H	/
C
C     INITIAL POINTERS
      JBEGIN=IBEGIN-1
      NEEDED=INITAL
      JPRINT=JBEGIN
      KPYEND=MAXBFR
      LOKEND=IFINAL
    1 JUSED=JBEGIN
      IF(IFINAL.LE.JBEGIN)GO TO 14
C
C     RESET POINTERS PRIOR TO NEXT SCAN
    2 IF(KPYEND.LE.JBEGIN)GO TO 14
      LOOK=JBEGIN
      KOPY=JBEGIN
      LIMIT=NEEDED
      KIND=-1
C
C     TEST IF HAVE SCANNED TO RIGHT END OF UNPROCESSED TEXT
    3 IF(KOPY.GE.KPYEND)GO TO 10
    4 IF(LOOK.GE.LOKEND)GO TO 10
      LOOK=LOOK+1
C
C     ADJUST NUMBER OF COLUMNS LEFT UNTIL NEXT TAB STOP
      IF(LIMIT.LE.0)LIMIT=INTRVL
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(LOOK).EQ.ISPACE)GO TO 7
      IF(IBUFFR(LOOK).NE.ITAB)GO TO 6
C
C     IF FIND A TAB, RECORD NUMBER OF SPACES TO NEXT STOP
      IF(KIND.GT.0)GO TO 5
      LOCATN=KOPY
      KIND=1
    5 KOPY=KOPY+LIMIT
      LIMIT=0
      IF(KOPY.LT.KPYEND)GO TO 4
      KOPY=KPYEND
      GO TO 10
C
C     IF FIND CHARACTER OTHER THAN A TAB, RECORD LOCATION
    6 IF(KOPY.GE.JPRINT)JPRINT=KOPY+1
    7 LIMIT=LIMIT-1
      IF(KIND.EQ.0)GO TO 8
      IF(KIND.LT.0)GO TO 9
      LOCATN=KOPY
      KIND=0
    8 KOPY=KOPY+1
      GO TO 3
    9 NEEDED=LIMIT
      JBEGIN=LOOK
      GO TO 1
C
C     COPY RIGHTMOST GROUP OF CHARACTERS
   10 IF(JUSED.LT.KOPY)JUSED=KOPY
      IF(KIND.GT.0)GO TO 12
   11 IBUFFR(KOPY)=IBUFFR(LOOK)
      KOPY=KOPY-1
      LOOK=LOOK-1
      IF(KOPY.GT.LOCATN)GO TO 11
      GO TO 13
   12 IBUFFR(KOPY)=ISPACE
      KOPY=KOPY-1
      IF(KOPY.GT.LOCATN)GO TO 12
      LOOK=LOOK-1
C
C     SHRINK THE UNPROCESSED REGION AND GO BACK TO DO AGAIN
   13 LOKEND=LOOK
      KPYEND=KOPY
      GO TO 2
C
C     RETURN TO CALLING PROGRAM
   14 MAXUSD=JUSED
      MAXPRT=JPRINT
      RETURN
C281985458052
      END
      SUBROUTINE DACOPY(INITAL,INTRVL,IBUFFR,IBEGIN,IFINAL,
     1JFINAL,JUSED,JBUFFR,NXTINI,NXTBGN,MAXPRT)
C     RENBR(/COPY BUFFER EXPANDING TABS TO SPACES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THE TAB CHARACTER IS A  NONPRINTING  CHARACTER  WHICH
C     CAUSES  THE FOLLOWING CHARACTER TO APPEAR IN THE NEXT
C     COLUMN BEYOND THE NEXT MULTIPLE OF THE TAB STOP.
C
C     INITAL = LESS THAN ZERO,  PROVIDING  THAT  INTRVL  IS
C              GREATER  THAN  ZERO,  THE  NUMBER  OF  EXTRA
C              SPACES INDICATED BY THE  ABSOLUTE  VALUE  OF
C              INITAL  ARE  TO  BE INSERTED AT THE START OF
C              THE JBUFFR ARRAY BEFORE THE CONTENTS OF  THE
C              IBUFFR  ARRAY  IS  COPIED  INTO  THE  JBUFFR
C              ARRAY.  THE FIRST TAB STOP WILL  BE  OF  THE
C              WIDTH  INDICATED  BY  INTRVL.   IF INTRVL IS
C              LESS THAN OR EQUAL TO ZERO, THEN NO  LEADING
C              SPACES  WILL  BE  INSERTED  INTO  THE JBUFFR
C              ARRAY WHETHER  REQUESTED  BY  INITAL  OR  BY
C              LEADING SPACES OR TABS IN THE IBUFFR ARRAY.
C            = EQUAL TO OR GREATER THAN ZERO, INITAL IS THE
C              NUMBER  OF SPACES TO THE FIRST TAB STOP.  IF
C              INITAL IS ZERO,  THEN  COPYING  HAS  ALREADY
C              PASSED  BEYOND  THE  FIRST  TAB STOP AND THE
C              DISTANCE TO THE NEXT TAB STOP  IS  TAKEN  AS
C              THE  ABSOLUTE VALUE OF INTRVL.  IF THE FIRST
C              CHARACTER IN THE INPUT BUFFER IS A  TAB,  IT
C              WILL  BE  EXPANDED TO THIS NUMBER OF SPACES.
C              INITAL CAN EQUAL EITHER ZERO OR THE VALUE OF
C              INTRVL IF THE FIRST TAB STOP IS TO BE OF THE
C              SAME WIDTH AS THOSE WHICH FOLLOW IT.
C     INTRVL = THE ABSOLUTE VALUE OF INTRVL IS THE TAB STOP
C              INTERVAL.   A  TAB  CHARACTER  IN  THE INPUT
C              BUFFER CAUSES THE FOLLOWING CHARACTER TO  GO
C              INTO THE NEXT POSITION BEYOND THE SUM OF THE
C              ABSOLUTE VALUE OF INITAL AND  NEXT  MULTIPLE
C              OF THE ABSOLUTE VALUE OF INTRVL.
C            = LESS THAN ZERO, NO LEADING SPACES ARE TO  BE
C              INSERTED   INTO  THE  JBUFFR  ARRAY  WHETHER
C              REQUESTED BY A NEGATIVE VALUE OF  INITAL  OR
C              BY  LEADING  SPACES  OR  TABS  IN THE IBUFFR
C              ARRAY.  ONCE A PRINTING CHARACTER  HAS  BEEN
C              COPIED  INTO THE JBUFFR ARRAY, HOWEVER, THEN
C              ALL REMAINING SPACES WILL BE COPIED AND  ALL
C              REMAINING TABS WILL BE EXPANDED TO SPACES.
C            = ZERO, NO SPACES ARE TO BE INSERTED INTO  THE
C              JBUFFR  ARRAY.  TABS IN THE IBUFFR ARRAY ARE
C              IGNORED, AND SPACES ARE NOT COPIED.
C            = GREATER  THAN  ZERO,  ALL   SPACES   WHETHER
C              REQUESTED  BY  A NEGATIVE VALUE OF INITAL OR
C              BY SPACES OR TABS IN THE  IBUFFR  ARRAY  ARE
C              INSERTED INTO THE JBUFFR ARRAY.
C     IBUFFR = THE INPUT BUFFER WHICH IS TO BE COPIED  INTO
C              THE  OUTPUT BUFFER EXPANDING ANY TABS FOUND.
C              IBUFFR  CONTAINS  CHARACTERS  READ   BY   A1
C              FORMAT.
C     IBEGIN = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO  BE
C              FOUND THE FIRST CHARACTER TO BE COPIED.
C     IFINAL = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO  BE
C              FOUND THE FINAL CHARACTER TO BE COPIED.
C     JFINAL = THE DIMENSION OF JBUFFR ARRAY.
C     JUSED  = SUBSCRIPT OF THE LOWEST LOCATION  IN  JBUFFR
C              ARRAY  WHICH  IS  CURRENTLY IN USE AND WHICH
C              CONTAINS  DATA  WHICH  MUST  BE  MAINTAINED.
C              JUSED  IS  RETURNED CONTAINING THE SUBSCRIPT
C              OF THE HIGHEST LOCATION  INTO  WHICH  DACOPY
C              HAS PLACED A CHARACTER.
C     JBUFFR = ARRAY INTO WHICH THE CONTENTS OF IBUFFR  ARE
C              TO BE COPIED EXPANDING TABS TO SPACES.
C     NXTINI = RETURNED CONTAINING  VALUE NEXT  TO BE GIVEN
C              TO INITAL  IF THE  CURRENT  CALL  COULD  NOT
C              COMPLETELY  REPESENT  THE  CONTENTS  OF  THE
C              IBUFFR  ARRAY  DUE  TO THE ROOM AVAILABLE IN
C              JBUFFR  BEING  TOO  SMALL.   IF  A  TAB  WAS
C              ENCOUNTERED  IN  IBUFFR  BUT  COULD  NOT  BE
C              COMPLETELY REPRESENTED, THEN NXTINI WILL  BE
C              NEGATIVE.  IF THE LAST CHARACTER ENCOUNTERED
C              IN THE IBUFFR ARRAY  WAS  NOT  A  TAB,  THEN
C              NXTINI  WILL  BE RETURNED WITH THE REMAINING
C              DISTANCE TO THE NEXT TAB STOP.
C     NXTBGN = RETURNED CONTAINING THE SUBSCRIPT WITHIN THE
C              IBUFFR ARRAY OF THE FIRST LETTER WHICH COULD
C              NOT BE REPRESENTED IN THE OUTPUT BUFFER.  IF
C              ALL   LETTERS  COULD  BE  REPRESENTED,  THEN
C              NXTBGN WILL BE RETURNED CONTAINING IFINAL+1.
C              NOTE  THAT  IF  A TAB IS REPRESENTED EVEN BY
C              SINGLE SPACE, THEN NXTBGN IS  PASSED  BEYOND
C              THIS  TAB ALTHOUGH THERE MIGHT NOT BE ENOUGH
C              ROOM IN THE OUTPUT BUFFER TO FILL COMPLETELY
C              TO THE NEXT TAB STOP.
C     MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION  IN  JBUFFR ARRAY INTO WHICH DACOPY
C              HAS PLACED A PRINTING CHARACTER.
C
      DIMENSION IBUFFR(IFINAL),JBUFFR(JFINAL)
C
C     ISPACE = THE SPACE CHARACTER
C     ITAB   = THE TAB CHARACTER
      DATA ISPACE,ITAB/1H ,1H	/
C
C     INITIAL POINTERS
      INDEX=IBEGIN-1
      IPRINT=JUSED
      LIMIT=INITAL
C
C     INSERT EXTRA SPACES AT START IF INITAL.LT.0
      IF(INTRVL.LE.0)GO TO 2
      JNTRVL=INTRVL
      NONSPC=1
    1 IF(LIMIT.GE.0)GO TO 4
      LIMIT=-LIMIT
      GO TO 6
    2 JNTRVL=-INTRVL
      NONSPC=0
      GO TO 4
C
C     TEST IF ARE AT END OF EITHER INPUT OR OUTPUT BUFFERS
    3 LIMIT=0
    4 INDEX=INDEX+1
      IF(JUSED.GE.JFINAL)GO TO 11
      IF(INDEX.GT.IFINAL)GO TO 11
C
C     ADJUST NUMBER OF COLUMNS LEFT UNTIL NEXT TAB STOP
      IF(LIMIT.LE.0)LIMIT=JNTRVL
      LIMIT=LIMIT-1
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(INDEX).EQ.ISPACE)GO TO 7
      IF(IBUFFR(INDEX).NE.ITAB)GO TO 8
C
C     IF FIND A TAB, COPY IN THE SPACES TO NEXT TAB STOP
      IF(NONSPC.EQ.0)GO TO 3
    5 JUSED=JUSED+1
      JBUFFR(JUSED)=ISPACE
      IF(LIMIT.LE.0)GO TO 4
    6 IF(JUSED.GE.JFINAL)GO TO 10
      LIMIT=LIMIT-1
      GO TO 5
C
C     IF FIND CHARACTER OTHER THAN A TAB, JUST COPY IT
    7 IF(NONSPC.EQ.0)GO TO 4
      GO TO 9
    8 IPRINT=JUSED+1
      NONSPC=JNTRVL
    9 JUSED=JUSED+1
      JBUFFR(JUSED)=IBUFFR(INDEX)
      GO TO 4
C
C     NOT ENOUGH ROOM FOR ALL SPACES IN TAB EXPANSION
   10 LIMIT=-LIMIT
      INDEX=INDEX+1
C
C     RETURN TO CALLING PROGRAM
   11 NXTINI=LIMIT
      NXTBGN=INDEX
      MAXPRT=IPRINT
      RETURN
C243897269317
      END
      SUBROUTINE DALOOP(IRAPID,LOWSUB,KNTSUB,INISUB,LMTSUB,
     1    INCSUB,NXTSUB,INLOOP,NOWSUB)
C     RENBR(/VARIABLY EMBEDDED DO LOOP SIMULATOR)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     ROUTINE TO PROVIDE CONTROL OF VARIABLY EMBEDDED
C     LOOPS TO ANY DESIRED LEVEL.  EACH LOOP HAS ITS OWN
C     INITIAL AND FINAL VALUE, AND ITS OWN INCREMENT BY
C     WHICH IT VARIES BETWEEN THESE.  THE FINAL VALUE CAN
C     BE EITHER LESS THAN, EQUAL TO OR GREATER THAN THE
C     INITIAL VALUE.
C
C     ***************************************************
C     *  CAUTION,  DALOOP MUST BE  CALLED INITIALLY TO  *
C     *  DEFINE LOOP STRUCTURE, THEN AT EACH LOOP END.  *
C     *  NONE OF THE CALLING  ARGUMENTS CAN BE CHANGED  *
C     *  BY CALLING  PROGRAM UNTIL ALL LOOPS ARE DONE.  *
C     ***************************************************
C
C     THE FOLLOWING ARGUMENTS ARE USED AS INPUT ONLY
C
C     IRAPID = 0, THE INNERMOST LOOP (ONE DONE THE MOST
C              RAPIDLY) IS THAT WITH THE SMALLEST VALUE
C              IN THE NXTSUB ARRAY.
C            = 1, THE INNERMOST LOOP IS THAT WITH THE
C              LARGEST VALUE IN THE NXTSUB ARRAY.
C     LOWSUB = THE INITIAL SUBSCRIPT OF THE ARRAYS WHICH
C              ARE TO BE USED AS THE LOOP DESCRIPTORS.
C     KNTSUB = THE FINAL SUBSCRIPT OF THE ARRAYS WHICH
C              ARE TO BE USED AS THE LOOP DESCRIPTORS.
C              KNTSUB MUST BE GREATER THAN OR EQUAL TO
C              LOWSUB.
C     INISUB = ARRAY CONTAINING THE STARTING VALUES OF THE
C              INDIVIDUAL LOOP LIMITS.
C     LMTSUB = ARRAY CONTAINING ENDING VALUES OF THE
C              INDIVIDUAL LOOP LIMITS.  AN INDIVIDUAL ITEM
C              IN THE LMTSUB ARRAY CAN BE EITHER LESS THAN,
C              EQUAL TO, OR GREATER THAN THE CORRESPONDING
C              ITEM IN THE INISUB ARRAY.
C     INCSUB = ARRAY CONTAINING THE INCREMENT BY WHICH THE
C              NOWSUB ARRAY IS VARIED BETWEEN THE STARTING
C              VALUES IN INISUB ARRAY, AND THE ENDING
C              VALUES IN LMTSUB ARRAY.  IF THE INCREMENT
C              IS ZERO, IT IS CHANGED TO 1.  IF THE
C              INCREMENT HAS THE WRONG SIGN, ITS SIGN IS
C              CHANGED.
C
C     THE FOLLOWING ARGUMENT IS USED AS INPUT, THEN IS
C     RETURNED CHANGED FOR USE BY SUBSEQUENT DALOOP CALLS
C
C     NXTSUB = ARRAY SET BY THE CALLING PROGRAM BEFORE THE
C              INITIAL CALL TO DALOOP TO CONTROL THE ORDER
C              OF THE EMBEDDED LOOPS.  DALOOP WILL RETURN
C              NXTSUB AS AN ARRAY CONTAINING POINTERS FOR
C              USE BY SUBSEQUENT CALLS TO DALOOP.  THE
C              ORIGINAL CONTENTS OF NXTSUB ARE USED TO
C              ESTABLISH THE ORDER OF THE POINTERS, BUT
C              THE ORIGINAL CONTENTS ARE DESTROYED AFTER
C              BEING USED.  THE RETURNED VALUES MUST NOT BE
C              ALTERED BY CALLING PROGRAM.  SEE DEFINITION
C              OF IRAPID FOR DESCRIPTION OF INPUT NXTSUB
C              VALUES.  LOOPS WHICH HAVE IDENTICAL VALUES
C              OF NXTSUB ARE PERFORMED AS A SINGLE UNIT, A
C              SINGLE CALL TO DALOOP ADVANCING THE NOWSUB
C              ARRAY VALUES FOR ALL MEMEBERS OF THE GROUP
C              UNTIL NOWSUB ARRAY VALUE OF ANY MEMBER OF
C              THE GROUP EXCEEDS ITS OWN CORRESPONDING
C              LMTSUB ARRAY VALUE.  WHEN DALOOP FINALLY
C              SIGNALS THAT ALL LOOPS HAVE BEEN COMPLETED,
C              BY RETURNING INLOOP=0, IT WILL ALSO ATTEMPT
C              TO RESTORE THE ORIGINAL VALUES OF THE NXTSUB
C              ARRAY, MAKING THE ASSUMPTION THAT SMALLEST
C              VALUE IN RANGE NXTSUB(LOWSUB) THROUGH
C              NXTSUB(KNTSUB) HAS THE VALUE LOWSUB, AND
C              THAT THE VALUES ARE THEN INCREMENTED BY 1.
C              THE RELATIVE ORDER WITHIN THE USED PORTION
C              OF NXTSUB ARRAY WILL BE RETURNED CORRECT,
C              BUT IF THE ASSUMPTIONS ARE NOT CORRECT, THE
C              ORDER WILL BE INCORRECT RELATIVE TO THAT OF
C              THE UNUSED PORTION, IF ANY, OF NXTSUB ARRAY.
C
C     THE FOLLOWING ARGUMENT IS USED AS INPUT, THEN IS
C     RETURNED CHANGED FOR USE BY BOTH THE CALLING PROGRAM
C     AND BY SUBSEQUENT CALLS TO DALOOP
C
C     INLOOP = MUST BE SET TO ZERO BEFORE INITIAL CALL TO
C              DALOOP.  THIS INITIAL CALL WILL SET INLOOP
C              NONZERO, AND WILL COPY THE INISUB ARRAY
C              INTO THE NOWSUB ARRAY FOR USE AS THE LOOP
C              PARAMETERS.  EACH SUBSEQUENT CALL TO DALOOP
C              WILL EITHER LOAD THE PARAMETERS FOR THE
C              NEXT SET OF LOOPS INTO THE NOWSUB ARRAY OR
C              SET INLOOP TO ZERO IF THE LOOP STRUCTURE
C              HAS BEEN COMPLETED.
C
C     THE FOLLOWING ARGUMENT IS RETURNED CHANGED FOR USE
C     BY BOTH THE CALLING PROGRAM AND SUBSEQUENT CALLS TO
C     DALOOP.  THE ORIGINAL CONTENTS ARE IGNORED.
C
C     NOWSUB = ARRAY RETURNED CONTAINING THE LOOP CONTROL
C              PARAMETERS FOR THE NEXT LOOP STRUCTURE.
C              THE CONTENTS OF NOWSUB(LOWSUB) THROUGH
C              NOWSUB(KNTSUB) ARE USED IN THE SAME MANNER
C              AS THE INDEXES OF FORTRAN DO LOOPS.
C              THE VALUES UPON INPUT TO THE INITIAL CALL
C              TO DALOOP ARE IGNORED.
C
C     AS AN EXAMPLE, WITH LOWSUB=5, KNTSUB=8, IRAPID=1 AND
C     (NXTSUB(I),I=5,8)=1,2,3,4
C     THE STATEMENTS
C
C           INLOOP=0
C         1 CALL DALOOP(IRAPID,LOWSUB,KNTSUB,INISUB,LMTSUB,
C          1INCSUB,NXTSUB,INLOOP,NOWSUB)
C           IF(INLOOP.EQ.0)GO TO 2
C                *
C                *
C           TEXT TO BE EXECUTED WITHIN THE LOOP STRUCTURE
C                *
C                *
C           GO TO 1
C         2 CONTINUE
C
C     WOULD SIMULATE THE CORRESPONDING DO LOOP STRUCTURE
C
C           DO 2 NOWSUB(5)=INISUB(5),LMTSUB(5),INCSUB(5)
C           DO 2 NOWSUB(6)=INISUB(6),LMTSUB(6),INCSUB(6)
C           DO 2 NOWSUB(7)=INISUB(7),LMTSUB(7),INCSUB(7)
C           DO 2 NOWSUB(8)=INISUB(8),LMTSUB(8),INCSUB(8)
C                *
C                *
C           TEXT TO BE EXECUTED WITHIN THE LOOP STRUCTURE
C                *
C                *
C         2 CONTINUE
C
C     HOWEVER, MERELY BY CHANGING THE NXTSUB ARRAY TO
C     (NXTSUB(I),I=5,8)=3,1,4,2
C     THE ORDER OF THE SIMULATED DO LOOPS WOULD BECOME
C
C           DO 2 NOWSUB(6)=INISUB(6),LMTSUB(6),INCSUB(6)
C           DO 2 NOWSUB(8)=INISUB(8),LMTSUB(8),INCSUB(8)
C           DO 2 NOWSUB(5)=INISUB(5),LMTSUB(5),INCSUB(5)
C           DO 2 NOWSUB(7)=INISUB(7),LMTSUB(7),INCSUB(7)
C                *
C                *
C           TEXT TO BE EXECUTED WITHIN THE LOOP STRUCTURE
C                *
C                *
C         2 CONTINUE
C
C     THE FIRST CALL TO DALOOP CONVERTS  THE  NXTSUB  ARRAY
C     FROM  AN  ORDER  ARRAY  TO  A  POINTER ARRAY SO AS TO
C     PREVENT UNNECESSARY  SEARCHES  BY  SUCCEEDING  CALLS.
C     THE  FIRST LOCATION IN THE USED PORTION OF THE NXTSUB
C     ARRAY  AFTER  ITS  CONVERSION  TO  A  POINTER   ARRAY
C     CONTAINS  THE  SUBSCRIPT  OF THE INDEX WHICH IS BEING
C     VARIED THE MOST RAPIDLY.  IF ADDITIONAL  INDEXES  ARE
C     BEING  VARIED  AT  THE  SAME  RATE,  THEN  THE SECOND
C     LOCATION IN THE POINTER ARRAY WILL CONTAIN THE SUM OF
C     THE  SUBSCRIPT  OF THE INDEX BEING VARIED AT THE SAME
C     RATE AND THE TOTAL NUMBER OF INDEXES SO THAT THE  SUM
C     IS  GREATER  THAN  THE  MAXIMUM  POSSIBLE  SUBSCRIPT.
C     SCANNING FROM LEFT TO RIGHT, THE NEXT LOCATION IN THE
C     POINTER  ARRAY  WHICH  CONTAINS  A VALUE LESS THAN OR
C     EQUAL TO THE MAXIMUM SUBSCRIPT OF AN INDEX WILL POINT
C     TO THE INDEX BEING VARIED THE NEXT MOST RAPIDLY.  FOR
C     EXAMPLE, IF THE INITIAL CONTENTS OF THE NXTSUB  ARRAY
C     IS
C
C          1, 2, 3, 2, 3, 4, 3, 4, 5
C
C     MEANING (IF SMALLEST NUMBER INDICATES INNERMOST LOOP)
C     THAT  THE  FIRST  INDEX  IS  VARIED MOST RAPIDLY, THE
C     SECOND AND FOURTH ARE VARIED NEXT MOST  RAPIDLY,  AND
C     SO  ON  THROUGH  THE  NINTH WHICH IS VARIED THE LEAST
C     RAPIDLY, THEN, AFTER CONVERSION TO A  POINTER  ARRAY,
C     THE CONTENTS OF THE NXTSUB ARRAY ARE
C
C     1, 2, (4+9)=13, 3, (5+9)=14, (7+9)=16, 6, (8+9)=17, 9
C
      DIMENSION NOWSUB(KNTSUB),NXTSUB(KNTSUB),
     1INISUB(KNTSUB),LMTSUB(KNTSUB),INCSUB(KNTSUB)
      IF(INLOOP.GT.0)GO TO 11
C
C     CHANGE ORDER ARRAY INTO A POINTER ARRAY
      INLOOP=KNTSUB-LOWSUB+1
      IF(INLOOP.LE.0)GO TO 24
      DO 1 I=LOWSUB,KNTSUB
    1 NOWSUB(I)=I
      I=LOWSUB
      L=LOWSUB
    2 IF(I.GT.KNTSUB)GO TO 25
      N=NXTSUB(I)
      M=I
      IF(I.EQ.KNTSUB)GO TO 6
      L=L+1
      DO 5 K=L,KNTSUB
      IF(IRAPID.LE.0)GO TO 3
      IF(NXTSUB(K).LE.N)GO TO 5
      GO TO 4
    3 IF(NXTSUB(K).GE.N)GO TO 5
    4 M=K
      N=NXTSUB(K)
    5 CONTINUE
      NXTSUB(M)=NXTSUB(I)
    6 J=NOWSUB(M)
      NOWSUB(M)=NOWSUB(I)
      IF(I.EQ.LOWSUB)GO TO 7
      IF(LAST.EQ.N)J=J+INLOOP
    7 NXTSUB(I)=J
      LAST=N
      NOWSUB(I)=INISUB(I)
      IF(INCSUB(I).EQ.0)INCSUB(I)=1
      IF(INISUB(I).GT.LMTSUB(I))GO TO 8
      IF(INCSUB(I).GE.0)GO TO 10
      GO TO 9
    8 IF(INCSUB(I).LE.0)GO TO 10
    9 INCSUB(I)=-INCSUB(I)
   10 I=I+1
      GO TO 2
C
C     IF ALREADY INITIALIZED, FIND NEXT VALUES
   11 I=LOWSUB
   12 J=I
      K=NXTSUB(J)
   13 NOWSUB(K)=NOWSUB(K)+INCSUB(K)
      IF(INISUB(K).GT.LMTSUB(K))GO TO 14
      IF(NOWSUB(K).GT.LMTSUB(K))GO TO 16
      GO TO 15
   14 IF(NOWSUB(K).LT.LMTSUB(K))GO TO 16
   15 J=J+1
      IF(J.GT.KNTSUB)GO TO 25
      K=NXTSUB(J)
      IF(K.LE.KNTSUB)GO TO 25
      K=K-INLOOP
      GO TO 13
   16 J=NXTSUB(I)
   17 NOWSUB(J)=INISUB(J)
      I=I+1
      IF(I.GT.KNTSUB)GO TO 18
      IF(NXTSUB(I).LE.KNTSUB)GO TO 12
      J=NXTSUB(I)-INLOOP
      GO TO 17
C
C     ALL DONE WITH LOOPS, TRY TO RESTORE NXTSUB ARRAY
   18 I=LOWSUB
      K=-1
      GO TO 21
   19 K=K+1
   20 NOWSUB(J)=K
      I=I+1
   21 IF(I.GT.KNTSUB)GO TO 22
      J=NXTSUB(I)
      IF(J.LE.KNTSUB)GO TO 19
      J=J-INLOOP
      GO TO 20
   22 DO 23 I=LOWSUB,KNTSUB
      IF(IRAPID.GT.0)NOWSUB(I)=K-NOWSUB(I)
   23 NXTSUB(I)=LOWSUB+NOWSUB(I)
C
C     ALL DONE
   24 INLOOP=0
   25 RETURN
C485603982534
      END
      SUBROUTINE DASITE(IRAPID,KOUNT ,LOWSUB,KNTSUB,NOWSUB,
     1    IEXTRA,LRGNUM,NUMUSD,NUMSTR,LSTKNT,NUMINI,INITAL,
     2    LOCATN)
C     RENBR(/GET BUFFER SUBSCRIPT FROM NAME + SUBSCRIPTS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DASITE  RETURNS  THE   POSITION   WITHIN   A   SINGLY
C     SUBSCRIPTED  BUFFER  OF  A  SINGLE ITEM OF A POSSIBLY
C     MULTIPLY  SUBSCRIPTED  ARRAY  EQUIVALENCED  WITH   OR
C     OTHERWISE  LOADED  INTO  PART  OR  ALL  OF THE SINGLY
C     SUBSCRIPTED  BUFFER  (AS  DEFINED  PERHAPS   BY   THE
C     DICTIONARY CONSTRUCTED BY THE DALOAD ROUTINE).  THERE
C     IS NO UPPER LIMIT TO THE NUMBER OF SUBSCRIPTS OF  THE
C     ARRAYS  SIMULATED  IN  THE  BUFFER  (OTHER  THAN  THE
C     OBVIOUS RESTRICTIONS IMPOSED BY THE  LENGTHS  OF  THE
C     NOWSUB  AND  NUMSTR  ARRAYS  AND BY THE LENGTH OF THE
C     BUFFER ITSELF).  THE RANGE OF VALUES OF ANY SUBSCRIPT
C     CAN  START  AT ANY VALUE AND CAN BE EITHER INCREASING
C     OR DECREASING.  THIS CONVERSION IS  THE  OPPOSITE  OF
C     THAT PERFORMED BY DANAME.
C
C     THE FOLLOWING ARGUMENTS ARE USED AS INPUT
C
C     IRAPID = 0, SELECTED ARRAY, IF MULTIPLY  SUBSCRIPTED,
C              HAS  LEFT  SUBSCRIPT  VARYING  MOST RAPIDLY.
C              THIS IS THE NORMAL  FORTRAN  CONVENTION  FOR
C              READS  OR  WRITES  IN WHICH NAME OF ARRAY IS
C              USED WITHOUT ANY SUBSCRIPTS.
C            = 1, SELECTED ARRAY, IF MULTIPLY  SUBSCRIPTED,
C              HAS RIGHT SUBSCRIPT VARYING MOST RAPIDLY.
C     KOUNT  = SEQUENCE NUMBER  OF THE DESIRED  ARRAY AMONG
C              ALL ARRAYS IN BUFFER.  1ST ARRAY IS SELECTED
C              BY KOUNT=1, 2ND BY KOUNT=2 AND SO ON.
C     LOWSUB = SUBSCRIPT OF NOWSUB ARRAY  CONTAINING  FIRST
C              SIMULATED   SUBSCRIPT   OF  THE  ITEM  BEING
C              LOCATED.
C     KNTSUB = SUBSCRIPT OF NOWSUB ARRAY  CONTAINING  FINAL
C              SIMULATED   SUBSCRIPT   OF  THE  ITEM  BEING
C              LOCATED.  IF THE LOWER PORTION OF THE NOWSUB
C              ARRAY  IS  USED,  THEN  LOWSUB WILL HAVE THE
C              VALUE 1 AND KNTSUB WILL  BE  THE  NUMBER  OF
C              SUBSCRIPTS OF THE SIMULATED ARRAY.
C     NOWSUB = ARRAY CONTAINING THE SIMULATED SUBSCRIPTS OF
C              THE   ITEM  BEING  LOCATED.   NOWSUB(LOWSUB)
C              THROUGH NOWSUB(KNTSUB) CONTAIN VALUES OF THE
C              SUBSCRIPTS  OF  THE  SIMULATED  ARRAY  WHICH
C              SELECT A PARTICULAR WORD  WITHIN  THE  TOTAL
C              BUFFER.
C     IEXTRA = 0, FOR  EACH  SIMULATED  ARRAY,  THE  NUMSTR
C              ARRAY CONTAINS ONLY THE NUMBER OF SUBSCRIPTS
C              AND THE SUBSCRIPT LIMITS.
C            = GREATER THAN ZERO,  NUMSTR(LRGNUM)  CONTAINS
C              FIRST OF  IEXTRA  WORDS WHICH  APPEAR BEFORE
C              THE FIRST SUBSCRIPT DESCRIPTION. THEREAFTER,
C              IEXTRA EXTRA WORDS ARE TO BE IGNORED BETWEEN
C              DESCRIPTIONS OF CONSECUTIVE SIMULATED ARRAYS
C            = -1, EACH  SUBSCRIPT DESCRIPTION  IS PRECEDED
C              BY A VARIABLE NUMBER OF WORDS TO BE IGNORED.
C              EACH  SECTION  TO BE  IGNORED STARTS  WITH A
C              WORD CONTAINING NUMBER OF WORDS EXCLUSIVE OF
C              ITSELF WHICH  ARE TO BE IGNORED  BEFORE NEXT
C              SUBSCRIPT  COUNT IS FOUND.    NUMSTR(LRGNUM)
C              CONTAINS NUMBER OF WORDS EXCLUSIVE OF ITSELF
C              TO BE  IGNORED  BEFORE THE  FIRST  SUBSCRIPT
C              DESCRIPTION.
C            = -2,  DICTIONARY  WAS  CONSTRUCTED  BY DALOAD
C              ROUTINE.   LRGNUM CAN POINT  TO EITHER START
C              OF THE  DESCRIPTION OF THE  LOGICAL GROUP OR
C              TO THE START OF THE DESCRIPTION OF THE FIRST
C              ARRAY IN THE LOGICAL GROUP.
C     LRGNUM = SUBSCRIPT OF THE NUMSTR ARRAY CONTAINING THE
C              START   OF  THE  DESCRIPTION  OF  THE  FIRST
C              SIMULATED ARRAY IN WHICH A  PARTICULAR  WORD
C              CAN BE LOCATED.
C     NUMUSD = SUBSCRIPT OF THE NUMSTR ARRAY CONTAINING THE
C              END   OF   THE   DESCRIPTION  OF  THE  FINAL
C              SIMULATED ARRAY IN WHICH A  PARTICULAR  WORD
C              CAN BE LOCATED.  IF ERRORS ARE NOT EXPECTED,
C              THEN NUMUSD CAN JUST BE THE DIMENSION OF THE
C              NUMSTR  ARRAY  REGARDLESS  OF WHETHER ALL OF
C              THE NUMSTR ARRAY IS USED.
C     NUMSTR = ARRAY DESCRIBING THE SUBSCRIPT LIMITS OF THE
C              ARRAYS  SIMULATED  IN THE SINGLY SUBSCRIPTED
C              BUFFER.  THE CONTENTS OF  THE  NUMSTR  ARRAY
C              ARE, FOR EACH ARRAY SIMULATED IN THE BUFFER,
C              THE NUMBER OF SUBSCRIPTS  OF  THE  SIMULATED
C              ARRAY  FOLLOWED  BY  LEFT AND RIGHT LIMITING
C              VALUES OF THESE SUBSCRIPTS (VALUES WHICH THE
C              SUBSCRIPTS   WOULD   HAVE   IF   THE  ARRAYS
C              SIMULATED  IN  THE  BUFFER   WERE   ACTUALLY
C              INCLUDED  IN  DIMENSION STATEMENTS).  IF THE
C              ITEM IN THE BUFFER WOULD BE  DIMENSIONED  AT
C              1, OR WOULD NOT DIMENSIONED, THEN A SINGLE 0
C              CAN BE USED IN PLACE OF THE SEQUENCE  1,1,1.
C              IT  SHOULD BE NOTED THAT THE RIGHT LIMIT CAN
C              BE EITHER GREATER THAN OR LESS THAN THE LEFT
C              LIMIT.
C
C     FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C     LSTKNT = SHOULD BE SET TO ZERO BY THE CALLING PROGRAM
C              BEFORE DASITE  IS FIRST CALLED  AND WHENEVER
C              THE DICTIONARY  CORRESPONDING  TO THE BUFFER
C              CHANGES.
C            = RETURNED CONTAINING INPUT VALUE OF KOUNT.
C     NUMINI = INPUT VALUE IS IGNORED  IF LSTKNT IS ZERO OR
C              IF LSTKNT IS GREATER THAN KOUNT.   NUMINI IS
C              SET BY EACH CALL TO  DASITE AND SHOULD NEVER
C              BE SET BY THE CALLING PROGRAM.
C            = INPUT VALUE IS LOCATION IN NUMSTR ARRAY  (AS
C              SUBSCRIPT  OF THE NUMSTR ARRAY) OF THE START
C              OF THE DESCRIPTION OF  THE  SELECTED  ARRAY.
C              IF IEXTRA=0,  THEN  NUMSTR(NUMINI)  CONTAINS
C              SUBSCRIPT COUNT AT START OF THE DESCRIPTION.
C            = RETURNED CONTAINING LOCATION IN NUMSTR ARRAY
C              OF  THE  START  OF  DESCRIPTION  OF SELECTED
C              ARRAY.
C     INITAL = INPUT VALUE IS IGNORED  IF LSTKNT IS ZERO OR
C              IF LSTKNT IS GREATER THAN KOUNT.   INITAL IS
C              SET BY EACH CALL TO  DASITE AND SHOULD NEVER
C              BE SET BY THE CALLING PROGRAM.
C            = INPUT VALUE IS LOCATION IN  BUFFER  (AS  THE
C              WORD  COUNT  WITHIN  BUFFER) OF THE START OF
C              SELECTED ARRAY.
C            = RETURNED CONTAINING LOCATION  IN  BUFFER  OF
C              START OF SELECTED ARRAY.
C
C     THE FOLLOWING ARGUMENT IS RETURNED AS OUTPUT
C
C     LOCATN = IF RETURNED GREATER THAN ZERO, LOCATN IS THE
C              POSITION   OF   THE  SELECTED  WORD  OF  THE
C              SELECTED ARRAY FROM THE START OF THE BUFFER.
C            = 0 RETURNED IF  SUBSCRIPTS  ARE  NOT  IN  THE
C              RANGE PREDICTED BY NUMSTR ARRAY.
C            = -1  RETURNED  IF   NOWSUB   ARRAY   CONTAINS
C              DIFFERENT  NUMBER  OF SUBSCRIPTS THAN NUMSTR
C              ARRAY.
C            = -2 RETURNED IF SEQUENCE NUMBER INDICATED  BY
C              KOUNT IS NOT IN THE NUMSTR ARRAY.
C
C     FOR EXAMPLE, IF BUFFER CONTAINS VALUES OF  ARRAYS  A,
C     B, E DIMENSIONED A(1/3,1/5), B(1/5,1/6), E(1/10,1/10)
C     (THIS SPECIFICATION MEANS THAT THE LEFT SUBSCRIPT  OF
C     ARRAY  A  CAN  RANGE  FROM  1  THROUGH 3 AND THAT THE
C     SECOND SUBSCRIPT CAN RANGE  FROM  1  THROUGH  5)  AND
C     CONTAINS NONDIMENSIONED ITEMS C AND D IN ORDER
C
C              A,B,C,D,E
C
C     THEN THE CONTENTS OF THE NUMSTR ARRAY WOULD BE
C
C              2,1,3,1,5,2,1,5,1,6,0,0,2,1,10,1,10
C
C     OR
C
C              2,1,3,1,5,2,1,5,1,6,1,1,1,1,1,1,2,1,10,1,10
C
C     IF KOUNT  HAS THE VALUE 2 AND  IF  THE  NOWSUB  ARRAY
C     CONTAINS  THE  VALUES 4 AND 3 SELECTING B(4,3) AND IF
C     IRAPID HAD VALUE 0, SO THAT ALL OF  ARRAY  A,  B(1,1)
C     THROUGH  B(5,1),  B(1,2)  THROUGH  B(5,2), AND B(1,3)
C     THROUGH B(3,3) WOULD  BE  BELOW  B(4,3)  THEN  LOCATN
C     WOULD BE RETURNED AS 15+5+5+3+1=29
C
C     IF IRAPID=0, ORDER OF A ARRAY IN BUFFER WOULD BE
C     (READING ACROSS EACH LINE FROM LEFT TO RIGHT)
C     A(1,1),A(2,1),A(3,1),A(1,2),A(2,2),A(3,2),
C     A(1,3),A(2,3),A(3,3),A(1,4),A(2,4),A(3,4),
C     A(1,5),A(2,5),A(3,5)
C
C     IF IRAPID=1, ORDER OF A ARRAY IN BUFFER WOULD BE
C     A(1,1),A(1,2),A(1,3),A(1,4),A(1,5)
C     A(2,1),A(2,2),A(2,3),A(2,4),A(2,5)
C     A(3,1),A(3,2),A(3,3),A(3,4),A(3,5)
C
C     IF Z ARRAY IS EFFECTIVELY DIMENSIONED Z(4/3,-1/1)
C     THEN ITS REPRESENTATION IN NUMSTR ARRAY WOULD BE
C              2,4,3,-1,1
C     AND IF IRAPID=0, ITS ORDER IN BUFFER WOULD BE
C     Z(4,-1),Z(3,-1),Z(4,0),Z(3,0),Z(4,1),Z(3,1)
C     IF INSTEAD IRAPID=1, ITS ORDER IN BUFFER WOULD BE
C     Z(4,-1),Z(4,0),Z(4,1),Z(3,-1),Z(3,0),Z(3,1)
C
      DIMENSION NOWSUB(KNTSUB),NUMSTR(NUMUSD)
C
C     FIND NUMBER OF WORDS BELOW SELECTED ARRAY
      IFORMT=IEXTRA+1
      JEXTRA=2
      IF(IFORMT.GT.0)JEXTRA=IEXTRA
      IF(LSTKNT.LE.0)GO TO 1
      IF(KOUNT.GE.LSTKNT)GO TO 2
    1 LSTKNT=1
      INITAL=1
      NUMINI=LRGNUM
      IF(IFORMT.GE.0)GO TO 2
      IF(NUMINI.GT.NUMUSD)GO TO 13
      IF(NUMSTR(NUMINI).GT.0)GO TO 2
      IF(NUMSTR(NUMINI+2).LT.0)GO TO 13
      NUMINI=NUMINI+3+(2*NUMSTR(NUMINI+2))
    2 IF(NUMINI.GT.NUMUSD)GO TO 13
      IF(IFORMT.GT.0)GO TO 4
      IF(IFORMT.EQ.0)GO TO 3
      IF(NUMSTR(NUMINI).GT.0)GO TO 4
      GO TO 13
    3 JEXTRA=NUMSTR(NUMINI)+1
      IF(JEXTRA.LE.0)GO TO 13
    4 NEXT=NUMINI+JEXTRA
      KNTLMT=NUMSTR(NEXT)
      IF(KOUNT.LE.LSTKNT)GO TO 7
      NUMINI=NEXT+1
      NEXT=NEXT+KNTLMT+KNTLMT
      LOCAL=1
    5 IF(NUMINI.GE.NEXT)GO TO 6
      ISIZE=NUMSTR(NUMINI+1)-NUMSTR(NUMINI)+1
      IF(ISIZE.LE.0)ISIZE=2-ISIZE
      LOCAL=LOCAL*ISIZE
      NUMINI=NUMINI+2
      GO TO 5
    6 INITAL=INITAL+LOCAL
      LSTKNT=LSTKNT+1
      GO TO 2
C
C     FIND LOCATION WITHIN SELECTED ARRAY
    7 LOCAL=0
      IF(KNTLMT.GT.0)GO TO 8
      IF(KNTSUB.LT.LOWSUB)GO TO 16
      IF(KNTSUB.NE.LOWSUB)GO TO 14
      IF(NOWSUB(LOWSUB).NE.1)GO TO 15
      GO TO 16
    8 IF((KNTSUB-LOWSUB).NE.(KNTLMT-1))GO TO 14
      IF(IRAPID.GT.0)GO TO 9
      INDEX=KNTLMT+LOWSUB-1
      LMTPNT=NEXT+KNTLMT+KNTLMT
      GO TO 10
    9 INDEX=LOWSUB
      LMTPNT=NEXT+2
   10 ILOWER=NOWSUB(INDEX)-NUMSTR(LMTPNT-1)
      ISIZE=NUMSTR(LMTPNT)-NUMSTR(LMTPNT-1)+1
      IF(ISIZE.GT.0)GO TO 11
      ILOWER=-ILOWER
      ISIZE=2-ISIZE
   11 IF(ILOWER.LT.0)GO TO 15
      IF(ILOWER.GE.ISIZE)GO TO 15
      LOCAL=(LOCAL*ISIZE)+ILOWER
      KNTLMT=KNTLMT-1
      IF(KNTLMT.LE.0)GO TO 16
      IF(IRAPID.GT.0)GO TO 12
      INDEX=INDEX-1
      LMTPNT=LMTPNT-2
      GO TO 10
   12 INDEX=INDEX+1
      LMTPNT=LMTPNT+2
      GO TO 10
C
C     ARRAY SEQUENCE NUMBER TOO LARGE
   13 LOCATN=-2
      GO TO 17
C
C     INCORRECT NUMBER OF SUBSCRIPTS
   14 LOCATN=-1
      GO TO 17
C
C     SUBSCRIPT OUTSIDE INDICATED LIMIT
   15 LOCATN=0
      GO TO 17
C
C     ADD OFFSET TO START OF AND OFFSET WITHIN ARRAY
   16 LOCATN=INITAL+LOCAL
   17 RETURN
C575207010056
      END
      SUBROUTINE DANAME(IRAPID,LOCATN,LRGNUM,NUMUSD,NUMSTR,
     1    LRGLTR,MAXSUB,INITAL,KOUNT ,LTRINI,NUMINI,KNTSUB,
     2    NOWSUB)
C     RENBR(/GET NAME + SUBSCRIPTS FROM BUFFER SUBSCRIPT)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     DANAME CONVERTS A SUBSCRIPT OF A  SINGLY  SUBSCRIPTED
C     BUFFER  WHICH  IS  CONSIDERED  TO  HOLD  ONE  OR MORE
C     POSSIBLY MULTIPLY SUBSCRIPTED ARRAYS INTO  THE  ARRAY
C     NAME  AND ITS SUBSCRIPTS AS DEFINED BY THE DICTIONARY
C     CONSTRUCTED BY THE DALOAD ROUTINE.   THIS  CONVERSION
C     IS  THE  OPPOSITE  OF  THAT  PERFORMED  BY THE DASITE
C     ROUTINE.
C
C     SINCE THE DICTIONARY CONSTRUCTED BY DALOAD IS DIVIDED
C     INTO  LOGICAL  GROUPS  OF  ARRAY  NAMES,  THE  PROPER
C     LOGICAL GROUP MUST BE LOCATED BY CALLING  THE  DABASE
C     ROUTINE  PRIOR TO THE FIRST CALL TO DANAME, UNLESS IT
C     IS KNOWN THAT THE DESIRED LOGICAL GROUP IS THE  FIRST
C     (OR ONLY) GROUP IN THE DICTIONARY.
C
C     FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY  AND  ARE
C     RETURNED UNCHANGED.
C
C     IRAPID = 0, MULTIPLY SUBSCRIPTED  ARRAYS  HAVE  THEIR
C              LEFT SUBSCRIPTS VARY MOST RAPIDLY
C            = 1, MULTIPLY SUBSCRIPTED  ARRAYS  HAVE  THEIR
C              RIGHT SUBSCRIPTS VARY MOST RAPIDLY.
C
C     LOCATN = THE VALUE OF SUBSCRIPT OF SINGLY SUBSCRIPTED
C              BUFFER   WHICH   IS   TO   BE  CONVERTED  TO
C              CORRESPONDING ARRAY NAME AND ITS SUBSCRIPTS.
C
C     LRGNUM = SUBSCRIPT OF  NUMSTR  ARRAY  LOCATION  WHICH
C              CONTAINS   FIRST   OF   NUMERIC  INFORMATION
C              ASSOCIATED WITH LOGICAL GROUP  OF  NAMES  OF
C              ARRAYS VALUES OF WHICH ARE EQUIVALENCED WITH
C              OR OTHERWISE CONTAINED IN SINGLY SUBSCRIPTED
C              BUFFER.    NUMSTR(LRGNUM)  CONTAINS  AS  ITS
C              ABSOLUTE VALUE NUMBER  OF  CHARACTERS  WHICH
C              ARE  CONTAINED  IN  NAME, IF ANY, OF LOGICAL
C              GROUP.
C
C     NUMUSD = HIGHEST SUBSCRIPT  OF  LOCATIONS  IN  NUMSTR
C              ARRAY    CONTAINING    NUMERIC   INFORMATION
C              CORRESPONDING    TO    POSSIBLY     MULTIPLY
C              SUBSCRIPTED   ARRAYS  VALUES  OF  WHICH  ARE
C              EQUIVALENCED WITH OR OTHERWISE CONTAINED  IN
C              SINGLY   SUBSCRIPTED   BUFFER.    NUMUSD  IS
C              HIGHEST SUBSCRIPT USED IN NUMSTR  ARRAY  FOR
C              STORAGE  OF  INFORMATION  ABOUT ANY ARRAY IN
C              ANY LOGICAL GROUP, AND  IS  NOT  NECESSARILY
C              HIGHEST  SUBSCRIPT  USED IN NUMSTR ARRAY FOR
C              STORAGE  OF  INFORMATION  ABOUT   ARRAY   IN
C              CURRENT LOGICAL GROUP.
C
C     NUMSTR = THE  ARRAY  CONTAINING  NUMERIC  INFORMATION
C              CORRESPONDING     TO    POSSIBLY    MULTIPLY
C              SUBSCRIPTED  ARRAYS  VALUES  OF  WHICH   ARE
C              EQUIVALENCED  WITH OR OTHERWISE CONTAINED IN
C              SINGLY SUBSCRIPTED BUFFER.  CONSTRUCTION  OF
C              NUMSTR  ARRAY  IS  DESCRIBED  IN  DETAIL  IN
C              DALOAD  DOCUMENTATION.   FOR  EACH  NAME  IN
C              DICTIONARY, NUMSTR ARRAY CONTAINS
C
C                A. THE NUMBER OF CHARACTERS IN NAME
C                B. AN INDICATION OF ASSOCIATED DATA TYPE
C                C. THE NUMBER OF SUBSCRIPT RANGES
C                D. PAIRS OF STARTING AND ENDING VALUES  OF
C                   THESE RANGES.
C
C              IF NUMBER OF CHARACTERS IS INSTEAD  ZERO  OR
C              NEGATIVE,  THEN ITS ABSOLUTE VALUE IS NUMBER
C              OF CHARACTERS IN NAME OF  LOGICAL  GROUP  OF
C              NAMES,   AND   NEXT  LOCATION,  RATHER  THAN
C              INDICATING DATA  TYPE,  CONTAINS  NUMBER  OF
C              LOCATIONS  WITHIN  SINGLY SUBSCRIPTED BUFFER
C              WHICH WOULD BE NEEDED  TO  STORE  VALUES  OF
C              MULTIPLY SUBSCRIPTED ARRAYS WHICH ARE WITHIN
C              LOGICAL  GROUP  AND  EQUIVALENCED  WITH   OR
C              OTHERWISE    LOADED    INTO    SUCH   SINGLY
C              SUBSCRIPTED BUFFER.
C
C     LRGLTR = THE SUBSCRIPT OF LTRSTR ARRAY (NOT  ARGUMENT
C              OF THIS ROUTINE BUT CONSTRUCTED BY DALOAD IN
C              PARALLEL WITH NUMSTR) WHICH  CONTAINS  FIRST
C              LETTER OF NAME ASSOCIATED WITH LOGICAL GROUP
C              OF NAMES IN DICTIONARY IF NUMSTR(LRGNUM)  IS
C              NEGATIVE,  OR WHICH CONTAINS FIRST LETTER OF
C              FIRST ARRAY NAME IN LOGICAL GROUP  OF  NAMES
C              IF NUMSTR(LRGNUM) IS POSITIVE OR ZERO.
C
C     MAXSUB = HIGHEST  SUBSCRIPT  OF  LOCTIONS  IN  NOWSUB
C              ARRAY  WHICH  CAN BE USED BY THIS ROUTINE TO
C              STORE VALUES OF  SUBSCRIPTS  OF  ARRAY  NAME
C              CORRESPONDING  TO  SUBSCRIPT (INPUT AS VALUE
C              OF LOCATN) OF SINGLY SUBSCRIPTED BUFFER.
C
C     FOLLOWING ARGUMENTS  ARE  USED  FOR  BOTH  INPUT  AND
C     OUTPUT.  IF THIS ROUTINE IS ASKED TO CONVERT VALUE OF
C     LOCATN WHICH IS SUBSCRIPT OF LOCATION IN  OR  FURTHER
C     BEYOND  ARRAY  IDENTIFIED  BY  PREVIOUS  CALL TO THIS
C     ROUTINE BUT WHICH IS STILL WITHIN SAME LOGICAL  GROUP
C     OF  ARRAYS AS DEALT WITH BY PREVOUS CALL, THEN VALUES
C     OF THESE ARGUMENTS AS OUTPUT  BY  PREVIOUS  CALL  ARE
C     USED  AS NEW OFFSETS IN DICTIONARY AND BUFFER, RATHER
C     THAN REPEATING  CALCULATIONS  FOR  LOWER  PORTION  OF
C     LOGICAL GROUP.
C
C     INITAL = SHOULD BE SET TO  ZERO  BY  CALLING  PROGRAM
C              BEFORE  THIS  ROUTINE  IS  FIRST CALLED, AND
C              AGAIN SET TO ZERO WHENEVER THIS  ROUTINE  IS
C              CALLED  TO REFERENCE DIFFERENT LOGICAL GROUP
C              OF ARRAY NAMES IN DICTIONARY.
C            = RETURNED GREATER THAN ZERO IF  SUBSCRIPT  OF
C              SINGLY  SUBSCRIPTED BUFFER INPUT AS VALUE OF
C              ARGUMENT LOCATN COULD BE CONVERTED INTO NAME
C              AND    SUBSCRIPTS   OF   POSSIBLY   MULTIPLY
C              SUBSCRIPTED  ARRAY  EQUIVALENCED   WITH   OR
C              OTHERWISE CONTAINED IN PART OR ALL OF SINGLY
C              SUBSCRIPTED  BUFFER.   INITAL  IS   RETURNED
C              CONTAINING  SUBSCRIPT  OF SINGLY SUBSCRIPTED
C              BUFFER LOCATION WHICH CONTAINS START OF (THE
C              FIRST  LOCATION  WITHIN)  POSSIBLY  MULTIPLY
C              SUBSCRIPTED ARRAY SOME LOCATION WITHIN WHICH
C              CORRESPONDS  TO  SINGLY  SUBSCRIPTED  BUFFER
C              LOCATION HAVING AS ITS SUBSCRIPT INPUT VALUE
C              OF  ARGUMENT  LOCATN.   IF POSSIBLY MULTIPLY
C              SUBSCRIPTED ARRAY IDENTIFIED BY THIS ROUTINE
C              CONSISTS  OF SINGLE LOCATION, THEN INITAL IS
C              RETURNED CONTAINING INPUT VALUE OF LOCATN.
C            = 0,   RETURNED   IF   SUBSCRIPT   OF   SINGLY
C              SUBSCRIPTED   BUFFER   INPUT   AS  VALUE  OF
C              ARGUMENT LOCATN COULD NOT BE CONVERTED  INTO
C              NAME  AND  SUBSCRIPTS  OF ARRAY EQUIVALENCED
C              WITH OR OTHERWISE CONTAINED IN PART  OR  ALL
C              OF  SINGLY  SUBSCRIPTED  BUFFER.   IN  OTHER
C              WORDS, LOCATN WAS INPUT CONTAINING VALUE NOT
C              INDICATED  BY  DICTIONARY  AS  BEING  WITHIN
C              SINGLY SUBSCRIPTED BUFFER CONTAINING  ARRAYS
C              FORMING LOGICAL GROUP.
C            = -1, MAXSUB IS LESS THAN NUMBER OF SUBSCRIPTS
C              OF   POSSIBLY   MULTIPLY  SUBSCRIPTED  ARRAY
C              IDENTIFIED BY THIS ROUTINE SO THAT  NOT  ALL
C              OF SUBSCRIPTS COULD BE REPRESENTED IN NOWSUB
C              ARRAY.
C
C     KOUNT  = INPUT VALUE IS IGNORED IF  INITAL  IS  INPUT
C              CONTAINING   ZERO  OR  IF  INITAL  IS  INPUT
C              GREATER THAN INPUT VALUE OF  LOCATN.   KOUNT
C              IS  SET  BY  EACH  CALL TO THIS ROUTINE, AND
C              SHOULD NEVER BE SET BY CALLING PROGRAM.
C            = IF INITAL IS INPUT  GREATER  THAN  ZERO  BUT
C              LESS THAN OR EQUAL TO LOCATN, THEN KOUNT, AS
C              RETURNED BY PREVIOUS CALL TO  THIS  ROUTINE,
C              IS  SEQUENCE  NUMBER  OF  POSSIBLY  MULTIPLY
C              SUBSCRIPTED  ARRAY  CORRESPONDING  TO  INPUT
C              VALUE OF INITAL.
C            = RETURNED  CONTAINING  SEQUENCE   NUMBER   OF
C              IDENTIFIED  ARRAY  RELATIVE TO ALL ARRAYS IN
C              LOGICAL GROUP OF ARRAYS.  IF THIRD ARRAY  IN
C              LOGICAL      GROUP     CONTAINS     LOCATION
C              CORRESPONDING TO INPUT VALUE OF LOCATN, THEN
C              KOUNT IS RETURNED CONTAINING VALUE 3.
C
C     LTRINI = INPUT VALUE IS IGNORED IF  INITAL  IS  INPUT
C              CONTAINING   ZERO  OR  IF  INITAL  IS  INPUT
C              GREATER THAN INPUT VALUE OF LOCATN.   LTRINI
C              IS  SET  BY  EACH  CALL TO THIS ROUTINE, AND
C              SHOULD NEVER BE SET BY CALLING PROGRAM.
C            = IF INITAL IS INPUT  GREATER  THAN  ZERO  BUT
C              LESS  THAN  OR EQUAL TO LOCATN, THEN LTRINI,
C              AS  RETURNED  BY  PREVIOUS  CALL   TO   THIS
C              ROUTINE,  IS  SUBSCRIPT  OF  LTRSTR LOCATION
C              CONTAINING 1ST  CHARACTER OF THE NAME OF THE
C              POSSIBLY    MULTIPLY    SUBSCRIPTED    ARRAY
C              CORRESPONDING TO INPUT VALUE OF INITAL.
C            = RETURNED  CONTAINING  SUBSCRIPT  OF   LTRSTR
C              ARRAY  LOCATION  CONTAINING 1ST CHARACTER OF
C              NAME OF IDENTIFIED ARRAY.
C
C     NUMINI = INPUT VALUE IS IGNORED IF  INITAL  IS  INPUT
C              CONTAINING   ZERO  OR  IF  INITAL  IS  INPUT
C              GREATER THAN INPUT VALUE OF LOCATN.   NUMINI
C              IS  SET  BY  EACH  CALL TO THIS ROUTINE, AND
C              SHOULD NEVER BE SET BY CALLING PROGRAM.
C            = IF INITAL IS INPUT  GREATER  THAN  ZERO  BUT
C              LESS  THAN  OR EQUAL TO LOCATN, THEN NUMINI,
C              AS  RETURNED  BY  PREVIOUS  CALL   TO   THIS
C              ROUTINE,  IS  SUBSCRIPT  OF  NUMSTR LOCATION
C              CONTAINING START OF NUMERIC  DESCRIPTION  OF
C              POSSIBLY    MULTIPLY    SUBSCRIPTED    ARRAY
C              CORRESPONDING TO INPUT VALUE OF INITAL.
C            = RETURNED  CONTAINING  SUBSCRIPT  OF   NUMSTR
C              ARRAY  LOCATION  CONTAINING START OF NUMERIC
C              DESCRIPTION OF IDENTIFIED ARRAY.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT.   THEIR
C     INPUT   VALUES  ARE  IGNORED.   THESE  ARGUMENTS  ARE
C     RETURNED UNDEFINED IF INITAL IS RETURNED LESS THAN OR
C     EQUAL TO ZERO.
C
C     KNTSUB = RETURNED CONTAINING NUMBER OF SUBSCRIPTS  OF
C              IDENTIFIED ARRAY.  IF NUMSTR ARRAY INDICATES
C              THAT  IDENTIFIED  ARRAY  IS  NONDIMENSIONED,
C              THEN  KNTSUB  IS  RETURNED CONTAINING 1, AND
C              NOWSUB(1) IS RETURNED ALSO CONTAINING 1.
C
C     NOWSUB = ARRAY  RETURNED  CONTAINING   IN   LOCATIONS
C              NOWSUB(1)      THROUGH     AND     INCLUDING
C              NOWSUB(KNTSUB)  VALUES  OF   SUBSCRIPTS   OF
C              POSSIBLY MULTIPLY SUBSCRIPTED ARRAY LOCATION
C              CORRESPONDING   TO   SUBSCRIPT   OF   SINGLY
C              SUBSCRIPTED BUFFER INPUT AS ARGUMENT LOCATN.
C
      DIMENSION NUMSTR(NUMUSD),NOWSUB(MAXSUB)
C
      IF(INITAL.LE.0)GO TO 1
      IF(LOCATN.GE.INITAL)GO TO 2
C
C     FIND NUMBER OF LOCATIONS BELOW CURRENT LOCATION
    1 NUMINI=LRGNUM
      LTRINI=LRGLTR
      KOUNT=0
      INITAL=1
    2 IF(NUMINI.GE.NUMUSD)GO TO 14
      KNTLTR=NUMSTR(NUMINI)
      IF(KNTLTR.GT.0)GO TO 3
      IF(NUMINI.NE.LRGNUM)GO TO 14
      KNTLTR=-KNTLTR
      GO TO 6
    3 KOUNT=KOUNT+1
      ISIZE=1
      INDEX=NUMINI+3
      LIMIT=NUMSTR(INDEX-1)
    4 IF(LIMIT.LE.0)GO TO 5
      JSIZE=NUMSTR(INDEX+1)-NUMSTR(INDEX)+1
      IF(JSIZE.LE.0)JSIZE=2-JSIZE
      ISIZE=ISIZE*JSIZE
      INDEX=INDEX+2
      LIMIT=LIMIT-1
      GO TO 4
    5 IF((INITAL+ISIZE).GT.LOCATN)GO TO 7
      INITAL=INITAL+ISIZE
    6 LTRINI=LTRINI+KNTLTR
      NUMINI=NUMINI+3+(2*NUMSTR(NUMINI+2))
      GO TO 2
C
C     FIND SUBSCRIPTS CORRESPONDING TO CURRENT LOCATION
    7 LOCAL=LOCATN-INITAL
      LIMIT=NUMSTR(NUMINI+2)
      IF(LIMIT.LE.0)GO TO 12
      IF(LIMIT.GT.MAXSUB)GO TO 13
      KNTSUB=LIMIT
      IF(IRAPID.LE.0)GO TO 8
      ICHANG=-2
      INDEX=NUMINI+1+LIMIT+LIMIT
      JCHANG=-1
      LOCSUB=LIMIT
      GO TO 9
    8 ICHANG=2
      INDEX=NUMINI+3
      JCHANG=1
      LOCSUB=1
    9 IF(LIMIT.LE.0)GO TO 15
      INISUB=NUMSTR(INDEX)
      ISIZE=NUMSTR(INDEX+1)-INISUB+1
      NEWSUB=LOCAL
      IF(ISIZE.GT.0)GO TO 10
      ISIZE=2-ISIZE
      LOCAL=LOCAL/ISIZE
      NOWSUB(LOCSUB)=INISUB-NEWSUB+(ISIZE*LOCAL)
      GO TO 11
   10 LOCAL=LOCAL/ISIZE
      NOWSUB(LOCSUB)=INISUB+NEWSUB-(ISIZE*LOCAL)
   11 LIMIT=LIMIT-1
      INDEX=INDEX+ICHANG
      LOCSUB=LOCSUB+JCHANG
      GO TO 9
C
C     SIMULATE SUBSCRIPT IF NAME IS UNDIMENSIONED
   12 IF(MAXSUB.LE.0)GO TO 13
      KNTSUB=1
      NOWSUB(1)=1
      GO TO 15
C
C     NOWSUB ARRAY TOO SMALL
   13 INITAL=-1
      GO TO 15
C
C     LOCATION NOT IN LOGICAL GROUP
   14 INITAL=0
C
C     RETURN TO CALLING PROGRAM
   15 RETURN
C445857737136
      END
      SUBROUTINE DASAVE(IPART ,IFORMT,MAXCLM,MAXLIN,IDATA ,
     1    KNTDAT,LETTER,KNTLTR,NAME  ,KNTNAM,IOUT  ,IERR  )
C     RENBR(/INTEGER AND 1H DATA STATEMENT GENERATOR)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JUL 14, 1970
C
C     IPART  = -1,  CONSTRUCT  DIMENSION  AND   EQUIVALENCE
C              STATEMENTS BUT NOT DATA STATEMENTS
C            = 0, CONSTRUCT DIMENSION, EQUIVALENCE AND DATA
C              STATEMENTS
C            = 1, CONSTRUCT DIMENSION STATEMENTS ONLY
C            = 2, CONSTRUCT EQUIVALENCE STATEMENTS ONLY
C            = 3, CONSTRUCT DATA STATEMENTS ONLY
C            = -4, -3 OR -2, IDENTICAL TO IPART=-1, 0 OR  1
C              RESPECTIVELY,    EXCEPT    THAT    DIMENSION
C              STATEMENTS SPECIFY COMPONENT ARRAYS NECESARY
C              TO   CONSTRUCT  ORGINAL  ARRAY  BUT  DO  NOT
C              INCLUDE  NAME  AND  DIMENSION  OF   ORIGINAL
C              ARRAY.
C     IFORMT = -1, REPRESENT  CHARACTERS  IN  LETTER  ARRAY
C              WHICH WERE DEFINED BY 1H FIELDS OR READ WITH
C              A1 FORMATS
C            = 0, REPRESENT  INTEGERS  IN  IDATA  ARRAY  IN
C              COMPACT FORM
C            = 1 OR GREATER, REPRESENT  INTEGERS  IN  IDATA
C              ARRAY  IN  COLUMNS WHICH ARE AT LEAST IFORMT
C              CHARACTERS WIDE (IFORMT=10 IS EQUIVALENT  TO
C              I10 FORMAT)
C     MAXCLM = NUMBER OF  CHARACTERS  TO  BE  IN  STATEMENT
C              FIELD  (66  IF  MAXIMUM,  IE 72 MINUS LEFT 6
C              COLUMNS)
C     MAXLIN = MAXIMUM NUMBER OF LINES FOR SINGLE STATEMENT
C     IDATA  = ARRAY OF INTEGERS TO BE REPRESENTED IN  DATA
C              STATEMENTS IF IFORMT IS ZERO OR GREATER
C     KNTDAT = NUMBER OF LOCATIONS IN  IDATA  ARRAY  TO  BE
C              REPRESENTED IN DATA STATEMENTS
C     LETTER = ARRAY OF CHARACTERS READ WITH A1  FORMAT  OR
C              DEFINED USING 1H FIELDS TO BE REPRESENTED IN
C              DATA STATEMENTS IF IFORMT HAS VALUE -1
C     KNTLTR = NUMBER OF LOCATIONS IN LETTER  ARRAY  TO  BE
C              REPRESENTED IN DATA STATEMENTS
C     NAME   = ALPHAMERIC ARRAY CONTAINING  NAME  OF  ARRAY
C              (READ BY MULTIPLE OF A1 FORMAT)
C     KNTNAM = NUMBER OF LETTERS IN NAME OF ARRAY
C     IOUT   = OUTPUT UNIT ON WHICH STATEMENT IS WRITTEN
C     IERR   = 0 RETURNED IF COULD GENERATE DATA STATEMENT
C            = 1 RETURNED IF MAXCLM TOO SMALL
C            = 2 RETURNED IF ISTORE ARRAY TOO SMALL
C
      DIMENSION IDATA(KNTDAT),LETTER(KNTLTR),NAME(KNTNAM),
     1IBUFFR(66),ISTORE(200)
      DATA IBLANK,ISLASH,KOMMA,ILPR,IRPR,IONE,IHOLLR/
     11H ,1H/,1H,,1H(,1H),1H1,1HH/
C
C     JSTORE = DIMENSION OF ISTORE ARRAY.  THIS IS THE
C              MAXIMUM NUMBER OF SMALL ARRAYS WHICH CAN
C              BE USED TO REPRESENT THE IDATA ARRAY.
C
      DATA JSTORE/200/
C
      JPART=IPART
      IF(JPART.LT.-1)JPART=JPART+3
      IERR=0
      IF(IFORMT)1,2,2
    1 NEEDED=KNTLTR
      GO TO 3
    2 NEEDED=KNTDAT
    3 IF(NEEDED)113,113,4
    4 LOCK=1
      MOST=0
      MAX1=MAXCLM-1
      MAX2=MAXCLM-2
      LEFT=0
      CALL DANUMB(0,NEEDED,10,IBUFFR,LEFT,0,MAXCLM)
      LENGTH=KNTNAM+LEFT
      IF(LENGTH-6)6,6,5
    5 LENGTH=6
    6 IF(IFORMT)12,81,7
C
C     PREPARE FOR EXPANDED FORMAT
    7 MOST=IDATA(1)
      LEAST=MOST
      DO 8 INDEX=1,NEEDED
      IF(LEAST.GT.IDATA(INDEX))LEAST=IDATA(INDEX)
      IF(MOST.LT.IDATA(INDEX))MOST=IDATA(INDEX)
    8 CONTINUE
      KOUNT=0
      CALL DANUMB(0,MOST,10,IBUFFR,KOUNT,0,MAXCLM)
      MOST=KOUNT
      KOUNT=0
      CALL DANUMB(0,LEAST,10,IBUFFR,KOUNT,0,MAXCLM)
      IF(MOST-KOUNT)9,10,10
    9 MOST=KOUNT
   10 IF(MOST-IFORMT)11,13,13
   11 MOST=IFORMT
      GO TO 13
   12 MOST=3
   13 LIMIT=MAXLIN*((MAXCLM-LENGTH-6)/(MOST+1))
      IF(LIMIT)112,112,14
   14 KNTPRT=1+((NEEDED-1)/LIMIT)
      IF(KNTPRT-JSTORE)15,15,111
   15 LEAST=1
      DO 16 INDEX=1,KNTPRT
      ISTORE(INDEX)=LEAST
   16 LEAST=LEAST+LIMIT
C
C     TEST IF LABELS ARE OF MINIMUM LENGTH
   17 ITEST=0
      CALL DANUMB(0,ISTORE(KNTPRT),10,IBUFFR,ITEST,0,
     1MAXCLM)
      IF(KNTNAM+ITEST-LENGTH)18,19,19
   18 LENGTH=KNTNAM+ITEST
      IF(IFORMT)13,81,13
   19 LOCK=0
      IF(IFORMT)21,20,21
   20 LEFT=0
      ITEST=0
C
C     CONSTRUCT SINGLE LINE OF DIMENSION STATEMENT
   21 IF(JPART-2)22,59,81
   22 INDEX=0
      DO 23 LEAST=1,10
   23 IBUFFR(LEAST)=IBLANK
   24 LINE=1
      LAST=INDEX
   25 KOUNT=10
   26 IF(INDEX)27,27,39
C
C     INSERT NAME OF MAIN ARRAY
   27 IF(IFORMT)28,29,28
   28 LIMIT=-LENGTH
      GO TO 30
   29 LIMIT=0
   30 LEAST=KOUNT
      CALL DABOTH(LIMIT,LEFT,NAME,KNTNAM,0,NEEDED,IBUFFR,
     1KOUNT,MAX1)
C
C     OUTPUT COMMENT LINE DESCRIBING DIMENSION
      IF(IPART+1)31,38,38
   31 IF(LINE-1)32,32,35
   32 IF(KOUNT-10)33,33,34
   33 WRITE(IOUT,120)
      GO TO 52
   34 WRITE(IOUT,120)(IBUFFR(LEAST),LEAST=11,KOUNT)
      GO TO 37
   35 IF(KOUNT-LEAST)112,112,36
   36 WRITE(IOUT,121)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
   37 INDEX=1
      GO TO 24
C
C     INSERT NAME OF SMALL ARRAY
   38 IF(KOUNT-LEAST)46,46,43
   39 IF(INDEX-KNTPRT)41,40,40
   40 LIMIT=NEEDED-ISTORE(INDEX)+1
      GO TO 42
   41 LIMIT=ISTORE(INDEX+1)-ISTORE(INDEX)
   42 LEAST=KOUNT
      CALL DABOTH(LENGTH,LEFT,NAME,KNTNAM,ISTORE(INDEX),
     1LIMIT,IBUFFR,KOUNT,MAX1)
      IF(KOUNT-LEAST)44,44,43
   43 INDEX=INDEX+1
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      IF(INDEX-KNTPRT)26,26,45
C
C     OUTPUT SINGLE LINE OF DIMENSION STATEMENT
   44 IF(LINE-MAXLIN)46,45,45
   45 KOUNT=KOUNT-1
   46 IF(LINE-1)47,47,50
   47 IF(KOUNT-10)48,48,49
   48 WRITE(IOUT,116)
      GO TO 52
   49 WRITE(IOUT,116)(IBUFFR(LEAST),LEAST=11,KOUNT)
      GO TO 52
   50 IF(KOUNT)112,112,51
   51 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)53,53,52
   52 MANY=1
   53 IF(INDEX-KNTPRT)54,54,58
   54 IF(LINE-MAXLIN)56,55,55
   55 IF(INDEX-LAST)112,112,24
   56 LINE=LINE+1
      IF(IFORMT)25,57,25
   57 KOUNT=0
      GO TO 26
C
C     CONSTRUCT SINGLE LINE OF EQUIVALENCE STATEMENT
   58 IF(JPART)59,59,113
   59 INDEX=1
      DO 60 LEAST=1,12
   60 IBUFFR(LEAST)=IBLANK
   61 LINE=1
      LAST=INDEX
   62 KOUNT=12
C
C     INSERT NAME OF SMALL ARRAY
   63 KOUNT=KOUNT+1
      LEAST=KOUNT
      CALL DABOTH(LENGTH,0,NAME,KNTNAM,ISTORE(INDEX),1,
     1IBUFFR,KOUNT,MAX2)
      IF(KOUNT-LEAST)66,66,64
C
C     INSERT NAME OF MAIN ARRAY
   64 KOUNT=KOUNT+1
      LIMIT=KOUNT
      CALL DABOTH(0,ITEST,NAME,KNTNAM,0,ISTORE(INDEX),
     1IBUFFR,KOUNT,MAX2)
      IF(KOUNT-LIMIT)66,66,65
   65 IBUFFR(LEAST)=ILPR
      IBUFFR(LIMIT)=KOMMA
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IRPR
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      INDEX=INDEX+1
      IF(INDEX-KNTPRT)63,63,67
C
C     OUTPUT SINGLE LINE OF EQUIVALENCE STATEMENT
   66 KOUNT=LEAST-1
      IF(LINE-MAXLIN)68,67,67
   67 KOUNT=KOUNT-1
   68 IF(LINE-1)69,69,72
   69 IF(KOUNT-12)70,70,71
   70 WRITE(IOUT,117)
      GO TO 74
   71 WRITE(IOUT,117)(IBUFFR(LEAST),LEAST=13,KOUNT)
      GO TO 74
   72 IF(KOUNT)112,112,73
   73 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)75,75,74
   74 MANY=1
   75 IF(INDEX-KNTPRT)76,76,80
   76 IF(LINE-MAXLIN)78,77,77
   77 IF(INDEX-LAST)112,112,61
   78 LINE=LINE+1
      IF(IFORMT)62,79,62
   79 KOUNT=0
      GO TO 63
C
C     CONSTRUCT SINGLE LINE OF DATA STATEMENT
   80 IF(JPART)113,81,113
   81 INDEX=1
      KNTPRT=0
   82 LINE=1
      LAST=INDEX+1
      KOUNT=5
   83 LIMIT=KOUNT+MOST
   84 LEAST=KOUNT
      IF(LAST-INDEX)88,88,85
C
C     INSERT NAME OF SMALL ARRAY
   85 CALL DABOTH(LENGTH,-1,NAME,KNTNAM,INDEX,0,IBUFFR,
     1KOUNT,MAX1)
      IF(KOUNT-LEAST)97,97,86
   86 LAST=INDEX
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=ISLASH
      IF(KNTPRT-JSTORE)87,111,111
   87 KNTPRT=KNTPRT+1
      ISTORE(KNTPRT)=INDEX
      GO TO 83
C
C     INSERT INTEGER ENTRY
   88 IF(IFORMT)90,89,89
   89 CALL DANUMB(IFORMT,IDATA(INDEX),10,IBUFFR,KOUNT,
     1LIMIT,MAX1)
      IF(KOUNT-LEAST)95,95,94
      GO TO 94
   90 IF(LIMIT-MAX1)91,91,95
   91 IF(KOUNT-(LIMIT-3))92,93,93
   92 KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IBLANK
      GO TO 91
   93 KOUNT=KOUNT+3
      IBUFFR(KOUNT-2)=IONE
      IBUFFR(KOUNT-1)=IHOLLR
      IBUFFR(KOUNT)=LETTER(INDEX)
   94 KOUNT=KOUNT+1
      IBUFFR(KOUNT)=KOMMA
      INDEX=INDEX+1
      IF(INDEX-NEEDED)83,83,96
C
C     OUTPUT SINGLE LINE OF DATA STATEMENT
   95 IF(LINE-MAXLIN)97,96,96
   96 IBUFFR(KOUNT)=ISLASH
   97 IF(LOCK)98,98,105
   98 IF(LINE-1)99,99,102
   99 IF(KOUNT-5)100,100,101
  100 WRITE(IOUT,118)
      GO TO 104
  101 WRITE(IOUT,118)(IBUFFR(LEAST),LEAST=6,KOUNT)
      GO TO 104
  102 IF(KOUNT)112,112,103
  103 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
      MANY=MANY+1
      IF(MANY-9)105,105,104
  104 MANY=1
  105 IF(INDEX-NEEDED)106,106,110
  106 IF(LINE-MAXLIN)108,107,107
  107 IF(INDEX-LAST)112,112,82
  108 LINE=LINE+1
      KOUNT=0
      IF(IFORMT)109,83,109
  109 LIMIT=6+LENGTH+MOST
      GO TO 84
  110 IF(LOCK)113,113,17
C
C     RETURN TO CALLING PROGRAM
  111 WRITE(IOUT,114)JSTORE
      IERR=2
      GO TO 113
  112 WRITE(IOUT,115)MAXCLM
      IERR=1
  113 RETURN
  114 FORMAT(19H DASAVE - MORE THAN,1I4,11H STATEMENTS)
  115 FORMAT(21H DASAVE - FIELD WIDTH,1I3,10H TOO SHORT)
  116 FORMAT(6X,10HDIMENSION ,66A1)
  117 FORMAT(6X,12HEQUIVALENCE ,66A1)
  118 FORMAT(6X,5HDATA ,61A1)
  119 FORMAT(5X,1I1,66A1)
  120 FORMAT(1HC,5X,10HDIMENSION ,66A1)
  121 FORMAT(1HC,4X,1I1,66A1)
C985104445547
      END
      SUBROUTINE DABOTH(INDEX,IFORMT,NAME,KNTLTR,NUMBER,
     1IVALUE,LETTER,KOUNT,MAX)
C
C     ROUTINE TO CREATE ARRAY NAMES WITH DIMENSION NUMBERS
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C     INDEX  = NEGATIVE OR 0, A SYMBOL CONTAINING AT LEAST
C              -INDEX CHARACTERS IS PRODUCED IN LETTER
C              ARRAY BY COPYING LOCATIONS 1 THRU KNTLTR OF
C              NAME ARRAY AND INSERTING RIGHT BLANKS IF
C              NECESSARY.
C            = 1 OR GREATER, IS LENGTH OF SYMBOL TO BE
C              OUTPUT IN LETTER ARRAY BY RIGHT JUSTIFYING
C              DIGITS OF NUMBER AND MAKING LEFT CHARACTERS
C              BE THOSE IN NAME ARRAY OR THE LETTER ZERO.
C     IFORMT = -1, NO NUMBER IS GIVEN ENCLOSED IN
C              PARENTHESES.
C            = 0, IVALUE IS REPRESENTED ENCLOSED IN
C              PARENTHESES TO RIGHT OF SYMBOL.
C            = 1 OR GREATER, IVALUE IS REPRESENTED RIGHT
C              JUSTIFIED IN A FIELD OF IFORMT LOCATIONS AND
C              ENCLOSED IN PARENTHESES TO RIGHT OF SYMBOL.
C     NAME   = ALPHAMERIC ARRAY READ BY MULTIPLE OF A1
C              FORMAT AND CONTAINING LETTERS OF SYMBOL.
C     KNTLTR = NUMBER OF SYMBOL CHARACTERS IN NAME ARRAY.
C     NUMBER = NUMBER TO BECOME PART OF SYMBOL IF INDEX=1
C              OR GREATER.
C     IVALUE = NUMBER TO FOLLOW SYMBOL IF IFORMT=1 OR
C              GREATER.
C     LETTER = ARRAY TO RECEIVE SYMBOL.
C     KOUNT  = NUMBER OF LOCATIONS OF LETTER ARRAY IN USE.
C     MAX    = MAXIMUM NUMBER OF LOCATIONS IN LETTER WHICH
C              CAN BE FILLED.
C
      DIMENSION LETTER(MAX),NAME(KNTLTR)
      DATA IBLANK,IZERO,ILPR,IRPR/1H ,1H0,1H(,1H)/
C
C     COPY SYMBOL WITHOUT RIGHT JUSTIFIED NUMBER
      INIT=KOUNT
      IF(INDEX)1,1,8
    1 IF(KOUNT+KNTLTR-MAX)2,2,17
    2 KOLUMN=0
    3 IF(KOLUMN-KNTLTR)4,5,5
    4 KOUNT=KOUNT+1
      KOLUMN=KOLUMN+1
      LETTER(KOUNT)=NAME(KOLUMN)
      GO TO 3
    5 IF(KOUNT-INDEX-KNTLTR-MAX)7,7,15
    6 KOUNT=KOUNT+1
      KOLUMN=KOLUMN+1
      LETTER(KOUNT)=IBLANK
    7 IF(KOLUMN+INDEX)6,13,13
C
C     COPY SYMBOL WITH RIGHT JUSTIFIED NUMBER
    8 KOLUMN=KOUNT+INDEX
      IF(KOLUMN-MAX)9,9,17
    9 LONG=KOUNT
      CALL DANUMB(1,NUMBER,10,LETTER,KOUNT,KOLUMN,MAX)
      KOLUMN=0
   10 LONG=LONG+1
      IF(LETTER(LONG).NE.IBLANK)GO TO 13
      IF(KOLUMN-KNTLTR)12,11,11
   11 LETTER(LONG)=IZERO
      GO TO 10
   12 KOLUMN=KOLUMN+1
      LETTER(LONG)=NAME(KOLUMN)
      GO TO 10
C
C     INSERT NUMBER ENCLOSED IN PARENTHESES
   13 IF(IFORMT)17,14,14
   14 KOLUMN=KOUNT+IFORMT+1
      CALL DANUMB(IFORMT,IVALUE,10,LETTER,KOUNT,KOLUMN,
     1MAX-1)
      IF(KOUNT-KOLUMN)15,16,16
   15 KOUNT=INIT
      GO TO 17
   16 KOLUMN=KOLUMN-IFORMT
      LETTER(KOLUMN)=ILPR
      KOUNT=KOUNT+1
      LETTER(KOUNT)=IRPR
C
C     RETURN TO CALLING PROGRAM
   17 RETURN
C353052349589
      END
      SUBROUTINE DANUMB(KONTRL,NUMBER,IRADIX,LETTER,
     1KOUNT,LFTCOL,MAX)
C     RENBR(/REPRESENT INTEGER VALUE)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JAN 2, 1970
C
C     KONTRL = 0 LEFT JUSTIFIES AT LFTCOL OR AT KOUNT+1
C              IF KOUNT IS GREATER THAN LFTCOL.
C     KONTRL = 1 RIGHT JUSTIFIES AT LFTCOL.
C     NUMBER = NUMBER TO BE INSERTED.
C     IRADIX = BASE TO WHICH NUMBER WILL BE EXPRESSED.
C     LETTER = ALPHAMERIC BUFFER ARRAY TO BE CODED.
C     KOUNT  = NUMBER OF LOCATIONS IN LETTER IN USE.
C     LFTCOL = LOCATION OF NEW NUMBER.
C     LFTCOL = CHARACTERS LEFT OF NUMBER IF KONTRL = 0.
C     LFTCOL = POSITION OF RIGHT DIGIT IF KONTRL = 1.
C     MAX    = DIMENSION OF LETTER ARRAY.
C
C     THE ONLY ARGUMENTS RETURNED CHANGED ARE THE
C     LETTER ARRAY WHICH IS RETURNED WITH THE NEW NUMBER
C     REPRESENTED AT ITS RIGHT END, AND KOUNT WHICH IS
C     RETURNED CONTAINING THE NUMBER OF CHARACTERS IN THE
C     LETTER ARRAY.
C
      DIMENSION LETTER(MAX),IDGT(10)
      DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA IBLANK,IMINUS/1H ,1H-/
C
C     EVEN UP RIGHT MARGIN IF NEEDED
      KSAVE=KOUNT
      KOLLFT=LFTCOL
      IF(KOLLFT-MAX)1,1,26
    1 IF(KOUNT-MAX)2,26,26
    2 IF(KONTRL)26,4,3
    3 IF(KOUNT-KOLLFT)6,26,26
    4 IF(KOUNT-KOLLFT)5,6,5
    5 KOUNT=KOUNT+1
      LETTER(KOUNT)=IBLANK
      IF(KOUNT-KOLLFT)5,6,6
C
C     SET INITIAL POINTERS
    6 KNT=0
      KEEP=KOUNT+1
      IF(NUMBER)8,7,7
C
C     POSITIVE NUMBER
    7 NUMB=NUMBER
      IF(KOUNT-MAX)12,25,25
C
C     NEGATIVE NUMBER
    8 IF(KEEP-MAX)9,25,25
    9 KOUNT=KOUNT+1
      LETTER(KOUNT)=IMINUS
C     ABSOLUTE VALUE OF A NEGATIVE NUMBER IS DECREMENTED
C     BY ONE SINCE, ON A TWO'S COMPLEMENT COMPUTER, THE
C     ABSOLUTE VALUE OF THE LARGEST NEGATIVE NUMBER (SIGN
C     BIT ON AND ALL OTHER BITS OFF) CANNOT BE REPRESENTED.
C     THIS NUMBER CAN BE EASILY OBTAINED IF SIGN BIT IS
C     USED FOR STORING INFORMATION IN SETS.
      INDEX=NUMBER+1
      NUMB=-INDEX
      GO TO 12
C
C     INSERT DIGITS OF NUMBER
   10 INDEX=KOUNT+KNT
   11 LETTER(INDEX+1)=LETTER(INDEX)
      INDEX=INDEX-1
      IF(INDEX-KOUNT)26,12,11
   12 KNT=KNT+1
      INDEX=NUMB
      NUMB=NUMB/IRADIX
      INDEX=INDEX-IRADIX*NUMB
      IF(NUMBER)13,16,16
   13 IF(KNT-1)26,14,16
   14 INDEX=INDEX+1
      IF(INDEX-IRADIX)16,15,26
   15 INDEX=0
      NUMB=NUMB+1
   16 LETTER(KOUNT+1)=IDGT(INDEX+1)
      IF(NUMB)26,18,17
   17 IF(KNT+KOUNT-MAX)10,25,25
   18 KOUNT=KOUNT+KNT
C
C     EVEN UP LEFT MARGIN IF NEEDED
      IF(KONTRL)26,26,19
   19 IF(KOUNT-KOLLFT)20,26,23
C
C     ADD BLANKS TO LEFT MARGIN
   20 DO 21 KNT=KEEP,KOUNT
      INDEX=KOLLFT-KNT+KEEP
      NUMB=KOUNT-KNT+KEEP
   21 LETTER(INDEX)=LETTER(NUMB)
      INDEX=KOLLFT-KOUNT+KEEP-1
      DO 22 KNT=KEEP,INDEX
   22 LETTER(KNT)=IBLANK
      KOUNT=KOLLFT
      GO TO 26
C
C     REMOVE EXCESS DIGITS FROM LEFT MARGIN
   23 DO 24 KNT=KEEP,KOLLFT
      INDEX=KNT+KOUNT-KOLLFT
   24 LETTER(KNT)=LETTER(INDEX)
      KOUNT=KOLLFT
      GO TO 26
   25 KOUNT=KSAVE
   26 RETURN
C     KEEP   = SUBSCRIPT AT WHICH INSERT 1ST CHARACTER.
C     KNT    = NUMBER OF DIGITS ADDED TO ARRAY.
C     KSAVE  = NUMBER OF CHARACTERS IN ORIGINAL ARRAY.
C     NUMB   = ABSOLUTE VALUE OF UNUSED PART OF NUMBER.
C423899686864
      END
      SUBROUTINE DAMOVE(JSTIFY,IFILL ,LFTCOL,LTREND,IERR  ,
     1    IBUFFR,KOUNT )
C     RENBR(/JUSTIFY ITEM IN FIELD OF SPACES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     JSTIFY = -1, DO NOT  MOVE  ITEM  IN  IBUFFR(LFTCOL+1)
C              THROUGH IBUFFR(KOUNT).
C            = 0,  THE  ITEM  IN  IBUFFR(LFTCOL+1)  THROUGH
C              IBUFFR(KOUNT) IS TO BE CENTERED IN THE FIELD
C              STARTING AT IBUFFR(LFTCOL+1)  AND  EXTENDING
C              THROUGH  IBUFFR(LTREND).   THE  IBUFFR ARRAY
C              LOCATIONS TO THE LEFT OF THE ITEM  ARE  THEN
C              FILLED WITH SPACES.
C            = 1,  THE  ITEM  IN  IBUFFR(LFTCOL+1)  THROUGH
C              IBUFFR(KOUNT) IS TO BE MOVED TO THE RIGHT SO
C              THAT THE CHARACTER INPUT IN IBUFFR(KOUNT) IS
C              PLACED   INTO  IBUFFR(LTREND).   THE  IBUFFR
C              ARRAY LOCATIONS TO THE LEFT OF THE ITEM  ARE
C              THEN FILLED WITH SPACES.
C     IFILL  = 0, DO NOT FILL PORTION  OF  FIELD  RIGHT  OF
C              ITEM WITH SPACES.  THE VALUE OF IFILL HAS NO
C              EFFECT ON THE CHARACTERS OF THE ITEM ITSELF.
C              KOUNT  WILL  BE  RETURNED  POINTING  TO  THE
C              RIGHTMOST CHARACTER OF THE ITEM.
C            = 1, FILL THE FIELD  RIGHT  OF  THE  ITEM  AND
C              EXTENDING    THROUGH   IBUFFR(LTREND)   WITH
C              SPACES.  KOUNT  WILL  BE  RETURNED  RETURNED
C              POINTING TO IBUFFR(LTREND).
C     LFTCOL = SUBSCRIPT OF THE IBUFFR ARRAY ENTRY  TO  THE
C              IMMEDIATE LEFT OF THE FIRST CHARACTER IN THE
C              ITEM.
C     LTREND = SUBSCRIPT OF THE IBUFFR  ARRAY  ENTRY  WHICH
C              FORMS THE RIGHT END OF THE FIELD WHICH IS TO
C              CONTAIN THE ITEM.   IF  JSTIFY=1,  THEN  THE
C              RIGHTMOST  CHARACTER  OF  THE  ITEM  WILL BE
C              PLACED INTO IBUFFR(LTREND).
C     IERR   = -1,   FILL   THE   FIELD    STARTING    WITH
C              IBUFFR(LFTCOL+1)   AND   EXTENDING   THROUGH
C              IBUFFR(LTREND)  WITH  ASTERISKS  AND  RETURN
C              KOUNT POINTING TO IBUFFR(LTREND).
C            = ZERO OR GREATER,  MOVE  THE  ITEM  INPUT  IN
C              IBUFFR(LFTCOL+1)  THROUGH IBUFFR(KOUNT) INTO
C              THE POSITION INDICATED BY JSTIFY.
C     IBUFFR = INPUT CONTAINING THE ITEM  TO  BE  MOVED  IN
C              LOCATIONS      IBUFFR(LFTCOL+1)      THROUGH
C              IBUFFR(KOUNT).  THIS ITEM IS  POSITIONED  IN
C              THE  FIELD  STARTING AT IBUFFR(LFTCOL+1) AND
C              EXTENDING THROUGH IBUFFR(LTREND) AS DIRECTED
C              BY JSTIFY.
C     KOUNT  = INPUT CONTAINING THE SUBSCRIPT IN THE IBUFFR
C              ARRAY OF THE RIGHTMOST CHARACTER OF THE ITEM
C              TO BE POSITIONED AS DIRECTED BY JSTIFY.
C            = RETURNED POINTING TO THE RIGHTMOST CHARACTER
C              DEFINED IN THE FIELD AFTER THE ITEM HAS BEEN
C              MOVED, AND  SPACES  ADDED  IF  REQUESTED  BY
C              IFILL.
C
      DIMENSION IBUFFR(LTREND)
      DATA ISTAR,IBLANK/1H*,1H /
C
C     DETERMINE HOW FAR TO SHIFT ITEM TO RIGHT
      IF(IERR.LT.0)GO TO 5
      IF(KOUNT.LE.LFTCOL)GO TO 3
      IF(JSTIFY.LT.0)GO TO 3
      J=LTREND-KOUNT
      IF(JSTIFY.EQ.0)J=J/2
      IF(J.LE.0)GO TO 3
      I=KOUNT
      J=J+KOUNT
      KOUNT=J
C
C     SHIFT ITEM TO RIGHT IF CENTERING OR RIGHT JUSTIFYING
    1 IF(I.LE.LFTCOL)GO TO 2
      IBUFFR(J)=IBUFFR(I)
      J=J-1
      I=I-1
      GO TO 1
C
C     INSERT BLANKS TO LEFT OF RIGHT SHIFTED ITEM
    2 IF(J.LE.LFTCOL)GO TO 3
      IBUFFR(J)=IBLANK
      J=J-1
      GO TO 2
C
C     FILL OUT REST OF FIELD WITH BLANKS
    3 IF(IFILL.LE.0)GO TO 7
    4 IF(KOUNT.GE.LTREND)GO TO 7
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IBLANK
      GO TO 4
C
C     FILL FIELD WITH ASTERISKS IF ITEM CANNOT FIT
    5 KOUNT=LFTCOL
    6 IF(KOUNT.GE.LTREND)GO TO 7
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=ISTAR
      GO TO 6
C
C     RETURN TO CALLING PROGRAM
    7 RETURN
C165672143471
      END
      SUBROUTINE PLTCUT(IPLCUT,IX,IY,JX,JY,MINX,MINY,
     1MAXX,MAXY)
C     RENBR(/CLIP PORTION OF LINE OUTSIDE WINDOW)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     ROUTINE BASED ON GENPLT-II PLOTTER COUPLING
C     ROUTINES PUBLISHED IN VOLUME 3 OF COMPUTER
C     PROGRAMS FOR CHEMISTRY
C
C     IPLCUT = RETURNED AS 0 IF LINE DOES NOT PASS THRU
C              WINDOW.
C            = RETURNED AS 1 IF LINE PASSES THRU WINDOW
C
C     IX     = HORIZONTAL COORDINATE OF START OF LINE
C     IY     = VERTICAL COORDINATE OF START OF LINE
C     JX     = HORIZONTAL COORDINATE OF END OF LINE
C     JY     = VERTICAL COORDINATE OF END OF LINE
C     MINX   = HORIZONTAL COORDINATE OF LOWER LEFT
C              CORNER OF WINDOW
C     MINY   = VERTICAL COORDINATE OF LOWER LEFT CORNER
C              OF WINDOW
C     MAXX   = HORIZONTAL COORDINATE OF UPPER RIGHT
C              CORNER OF WINDOW
C     MAXY   = VERTICAL COORDINATE OF UPPER RIGHT CORNER
C              OF WINDOW
C
C     ROUTINE RETURNS JX, JY, IX AND IY CHANGED IF
C     WINDOWING IS NECESSARY
C
C     TEST IF LINE NEEDS TO BE WINDOWED
      IF(IX-MINX)8,1,1
    1 IF(IX-MAXX)2,2,8
    2 IF(JX-MINX)8,3,3
    3 IF(JX-MAXX)4,4,8
    4 IF(IY-MINY)8,5,5
    5 IF(IY-MAXY)6,6,8
    6 IF(JY-MINY)8,7,7
    7 IF(JY-MAXY)38,38,8
    8 IIX=IX
      IIY=IY
      IJX=JX
      IJY=JY
      MOVEX=JX-IX
      MOVEY=JY-IY
C
C     INTERSECTION WITH LEFT AND RIGHT BORDERS
      IF(IIX-MINX)9,10,10
    9 IIX=MINX
      IF(IJX-MINX)36,14,14
   10 IF(IIX-MAXX)12,12,11
   11 IIX=MAXX
      IF(IJX-MAXX)12,12,36
   12 IF(IJX-MINX)13,14,14
   13 IJX=MINX
      GO TO 16
   14 IF(IJX-MAXX)16,16,15
   15 IJX=MAXX
   16 IF(MOVEX)17,18,17
   17 IIY=IY+((MOVEY*(IIX-IX))/MOVEX)
      IJY=JY-((MOVEY*(JX-IJX))/MOVEX)
C
C     INTERSECTION WITH LOWER AND UPPER BORDERS
   18 IF(IIY-MINY)19,20,20
   19 IIY=MINY
      IF(IJY-MINY)36,24,24
   20 IF(IIY-MAXY)22,22,21
   21 IIY=MAXY
      IF(IJY-MAXY)22,22,36
   22 IF(IJY-MINY)23,24,24
   23 IJY=MINY
      GO TO 26
   24 IF(IJY-MAXY)26,26,25
   25 IJY=MAXY
   26 IF(MOVEY)27,28,27
   27 IIX=IX+((MOVEX*(IIY-IY))/MOVEY)
      IJX=JX-((MOVEX*(JY-IJY))/MOVEY)
   28 IF(IIX-MINX)29,30,30
   29 IIX=MINX
   30 IF(IIX-MAXX)32,32,31
   31 IIX=MAXX
   32 IF(IJX-MINX)33,34,34
   33 IJX=MINX
   34 IF(IJX-MAXX)37,37,35
   35 IJX=MAXX
      GO TO 37
C
C     IPLCUT=0 IF LINE NOT WITHIN WINDOW
   36 IPLCUT=0
      GO TO 39
C
C     IPLCUT=1 IF LINE IS WITHIN WINDOW
   37 JX=IJX
      JY=IJY
      IX=IIX
      IY=IIY
   38 IPLCUT=1
C
C     RETURN TO CALLING PROGRAM
   39 RETURN
C372613660265
      END

