SUBROUTINE GS

$INSERT SYSCOM>KEYS.F

      COMMON /GS$COM/ SEGBF0, SEGBF1, SEGBUF(1024)
      INTEGER*2 SEGBF0, SEGBF1, SEGBUF

      INTEGER*2 FILE(40),  INFO(8),  DAT(2),  RECN(5),  I
      INTEGER*2 DUNIT,     SUNIT,    ITYP,    CODE,     MODULO
      INTEGER*2 MODULO,    IRET,     RNW,     OUTIDX,   OUT(100)
      INTEGER*2 OUTC(4),   SMPLS,    SMPLN,   SMPLI,    NLEN$A
      INTEGER*2 SEGNUM,    SEGLEN

      INTEGER*4 SEGPOS,    LOC0,     LOC1,    LOC2,     KLEN
      INTEGER*4 IDX,       INFO2,    DATA,    RECL(6),  I4
      INTEGER*4 RLEN

      LOGICAL*2 EOS,       ERR,      OVER

      EQUIVALENCE (DAT,DATA)

      OUTC(1) = '.>'
      OUTC(2) = '.<'
      OUTC(3) = '.+'
      OUTC(4) = '.-'

      DUNIT = 1
      SUNIT = 2

      CALL SRCH$$(K$CLOS, 0, 0, DUNIT, ITYP, CODE)
      CALL SRCH$$(K$CLOS, 0, 0, SUNIT, ITYP, CODE)

10    CONTINUE

      CALL TNOUA('Enter filename: ',16)
      CALL COMANL
      CALL RDTK$$(1, INFO, FILE, 40, CODE)
      IF (INFO(1) .EQ. 6) GOTO 900
      INFO2 = INFO(2)
      CALL TSRC$$(K$GETU + K$READ, FILE, DUNIT, INFO2, I, CODE)
      IF (CODE .NE. 0) GOTO 10

      CALL TNOUA('Enter starting group (after 1st): ',34)
      CALL TIDEC(SMPLS)
      CALL TNOUA('Enter number of groups to sample: ',34)
      CALL TIDEC(SMPLN)
      CALL TNOUA('Enter group increment:            ',34)
      CALL TIDEC(SMPLI)

      IF (SMPLS .LE. 2) SMPLS = 2
      IF (SMPLN .LE. 0) SMPLN = 32767
      IF (SMPLI .LE. 0) SMPLI = 1

      SEGNUM = -1
      MODULO = -1

20    CONTINUE
      CALL SRCH$$(K$CLOS, 0, 0, SUNIT, ITYP, CODE)
      IF (SEGNUM .EQ. 0) SEGNUM = SMPLS - SMPLI - 1
      IF (SEGNUM .EQ. -1) SEGNUM = SEGNUM - SMPLI + 1
      SMPLN = SMPLN - 1
      IF (SMPLN .EQ. -1) GOTO 900

      SEGNUM = SEGNUM + SMPLI
      SEGPOS = 0
      SEGLEN = 1024
      EOS = .FALSE.

      LOC0 = INTL(3 + 1024)

      OUTIDX = 0

      DO 25 I = 1,6
      RECL(I) = 0
25    CONTINUE
      DO 26 I = 1,5
      RECN(I) = 0
26    CONTINUE

      IF ((SEGNUM .GE. MODULO) .AND. (MODULO .NE. -1)) GOTO 900
      IF (SEGNUM .LI. 0) GOTO 900

      CALL SGDR$$(K$SPOS, DUNIT, SEGNUM, IRET, CODE)
      ERR = (CODE .NE. 0) .OR. (IRET .EQ. 0)
      IF .NOT.(ERR) GOTO 27
      EOS = .TRUE.
      RNW = 0
      GOTO 40
27    CONTINUE

      CALL SRCH$$(K$READ + K$GETU + K$ISEG, DUNIT, 0, SUNIT, ITYP, CODE)
      ERR = (CODE .NE. 0)
      IF .NOT.(ERR) GOTO 28
      EOS = .TRUE.
      RNW = 0
      GOTO 40
28    CONTINUE

      SEGPOS = -1024
      SEGLEN = 1024

30    CONTINUE
      IF (EOS) GOTO 100

      SEQPOS = SEQPOS + SEGLEN
      CALL PRWF$$(K$PREA + K$READ, SUNIT, LOC(SEGBUF), SEGLEN,
     $       SEGPOS, RNW, CODE)

      EOS = CODE .EQ. 1
      ERR = ((CODE .NE. 0) .AND. (.NOT. EOS))
      EOS = ERR .OR. EOS
      IF (ERR) RNW = 0

40    CONTINUE
      IF (EOS) SEGLEN = RNW

      RECL(6) = RECL(6) + INTL(SEGLEN)

      OVER = RECL(6) .GT. 1024

      LOC0 = LOC0 - INTL(1024)

      IF ((SEGNUM .NE. 0) .OR. OVER) GOTO 45
      ERR = SEGLEN .LT. 5
      IF (ERR) CALL TNOU('Group 1 has less than 10 bytes.',31)
      IF (ERR) GOTO 900

      MODULO = SEGBUF(3)
      CALL TNOUA('File ',5)
      CALL TNOUA(FILE, NLEN$A(FILE, 80))
      CALL TNOUA(  Type (hex) = ',15)
      CALL TOHEX(SEGBUF(1))
      CALL TOHEX(SEGBUF(2))
      CALL TNOUA(  Modulo (dec) = ',17)
      CALL TOVFD$(MODULO)
      CALL TONL
      CALL TONL
      CALL TNOUA(' Group       Bytes        Used',30)
      CALL TONL
      CALL TONL
45    CONTINUE
      IF ((SEGPOS .NE. 0) .OR. (LOC0 .NE. 3)) GOTO 50
      LOC0 = 3
      LOC1 = 4
      LOC2 = 5
      GOTO 60
50    CONTINUE
      LOC1 = LOC0 + 1
      LOC2 = LOC1 + 1

      ERR = (LOC2 .GT. 1024)
      IF .NOT.(ERR) GOTO 55
      SEGBF0 = SEGBUF(1023)
      SEGBF1 = SEGBUF(1024)
      GOTO 30
55    CONTINUE
      IF ((SEGBUF(LOC0) .NE. 0) .AND. (SEGBUF(LOC0) .NE. 512) .AND.
     $    (SEGPOS .NE. 0) .AND. (LOC0 .NE. 3)) GOTO 100

      KLEN = RT(DAT(2), 8)
      RLEN = RS(DATA, 8)

      IDX = 1
      IF (KLEN .EQ. 0) IDX = IDX + 1
      IF (OVER) IDX = IDX + 2

      IF (OUTIDX .EQ. 100) GOTO 81
      OUTIDX = OUTIDX + 1
      OUT(OUTIDX) = IDX
81    CONTINUE

      RECL(IDX) = RECL(IDX) + RLEN
      RECL(5) + RECL(5) + RLEN
      RECN(IDX) = RECN(IDX) + 1
      RECN(5) = RECN(5) + 1

60    CONTINUE
      IF (LOC0 .GT. 1024) GOTO 30

      DAT(1) = SEGBUF(LOC1)
      DAT(2) = SEGBUF(LOC2

      IF (DATA .EQ. 0) GOTO 100

      LOC0 = LOC0 + RS(DATA, 8)
      IF (LOC0 .GT. 1024) GOTO 30
      GOTO 50

100   CONTINUE
      ERR = (RECL(6) .NE. 0) .AND. (RECL(5) + 5 .NE. RECL(6))

      CALL TODEC(SEGNUM + 1)
      CALL TNOUA('  ',2)
      CALL CNVB$A(1, INTL(2 * RECL(6)), SEGBUF, 10)
      CALL TNOUA(SEGBUF, 10)
      I4 = RECL(1) + RECL(3)
      IF (I4 .NE. 0) I4 = I4 + 5
      CALL TNOUA('  ',2)
      CALL CNVB$A(1, INTL(2 * I4), SEGBUF, 10)
      IF (OUTIDX .EQ. 0) GOTO 130
      CALL TNOUA('  ',2)
      DO 120 IDX = 1,OUTIDX
      CALL T1OU(OUTC(OUT(IDX)))
120   CONTINUE
      IF (OUTIDX .EQ. RECN(5)) GOTO 130
      CALL TNOUA('  ',2)
      CALL TOVFD$(RECN(1) + RECN(3))
      CALL TNOUA('+',1)
      CALL TOVFD$(RRECN(2) + RECN(4))
130   CONTINUE
      IF (ERR) CALL TNOUA('  ERR',5)
      CALL TONL
      GOTO 20

900   CONTINUE
      CALL SRCH$$(K$CLOS, 0, 0, DUNIT, ITYP, CODE)
      CALL SRCH$$(K$CLOS, 0, 0, SUNIT, ITYP, CODE)
      RETURN
   END