SUBROUTINE ISTKRL(NUMBER)
C
C  DE-ALLOCATES THE LAST (NUMBER) ALLOCATIONS MADE IN THE STACK
C  BY ISTKGT.
C
C  ERROR STATES -
C
C    1 - NUMBER .LT. 0
C    2 - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN
C    3 - ATTEMPT TO DE-ALLOCATE NON-EXISTENT ALLOCATION
C    4 - THE POINTER AT ISTAK(LNOW) OVERWRITTEN
C
      COMMON /CSTAK/DSTAK
C
      DOUBLE PRECISION DSTAK(500)
      INTEGER ISTAK(1000)
      LOGICAL INIT
C
      EQUIVALENCE (DSTAK(1),ISTAK(1))
      EQUIVALENCE (ISTAK(1),LOUT)
      EQUIVALENCE (ISTAK(2),LNOW)
      EQUIVALENCE (ISTAK(3),LUSED)
      EQUIVALENCE (ISTAK(4),LMAX)
      EQUIVALENCE (ISTAK(5),LBOOK)
C
      DATA INIT/.TRUE./
C
      IF (INIT) CALL I0TK00(INIT,500,4)
C
C/6S
C     IF (NUMBER.LT.0) CALL SETERR(20HISTKRL - NUMBER.LT.0,20,1,2)
C/7S
      IF (NUMBER.LT.0) CALL SETERR('ISTKRL - NUMBER.LT.0',20,1,2)
C/
C
C/6S
C     IF (LNOW.LT.LBOOK.OR.LNOW.GT.LUSED.OR.LUSED.GT.LMAX) CALL SETERR
C    1   (47HISTKRL - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN,
C    2    47,2,2)
C/7S
      IF (LNOW.LT.LBOOK.OR.LNOW.GT.LUSED.OR.LUSED.GT.LMAX) CALL SETERR
     1   ('ISTKRL - LNOW, LUSED, LMAX OR LBOOK OVERWRITTEN',
     2    47,2,2)
C/
C
      IN = NUMBER
 10      IF (IN.EQ.0) RETURN
C
C/6S
C        IF (LNOW.LE.LBOOK) CALL SETERR
C    1   (55HISTKRL - ATTEMPT TO DE-ALLOCATE NON-EXISTENT ALLOCATION,
C    2    55,3,2)
C/7S
         IF (LNOW.LE.LBOOK) CALL SETERR
     1   ('ISTKRL - ATTEMPT TO DE-ALLOCATE NON-EXISTENT ALLOCATION',
     2    55,3,2)
C/
C
C     CHECK TO MAKE SURE THE BACK POINTERS ARE MONOTONE.
C
C/6S
C        IF (ISTAK(LNOW).LT.LBOOK.OR.ISTAK(LNOW).GE.LNOW-1) CALL SETERR
C    1   (47HISTKRL - THE POINTER AT ISTAK(LNOW) OVERWRITTEN,
C    2    47,4,2)
C/7S
         IF (ISTAK(LNOW).LT.LBOOK.OR.ISTAK(LNOW).GE.LNOW-1) CALL SETERR
     1   ('ISTKRL - THE POINTER AT ISTAK(LNOW) OVERWRITTEN',
     2    47,4,2)
C/
C
         LOUT = LOUT-1
         LNOW = ISTAK(LNOW)
         IN = IN-1
         GO TO 10
C
      END

.