      LOGICAL FUNCTION A4SSOI(WV, RV, IV, LV, TSTART, TSTOP, BETA,
     1   GAMMA, DELTA, NX, DT, N, KMAX, MMAX, XPOLY, ERRPAR, PESPAR,
     2   HFRACT, KINIT)
      INTEGER MMAX
      INTEGER IV(40), NX, N(MMAX), KMAX, KINIT
      REAL WV(30), RV(30), TSTART, TSTOP, BETA, GAMMA
      REAL DELTA, DT, ERRPAR(2), PESPAR, HFRACT
      LOGICAL LV(20), XPOLY
      COMMON /CSTAK/ DS
      DOUBLE PRECISION DS(500)
      INTEGER IFA, ING, ILW, ISLOGN, IHOPTO, ILOZNG
      INTEGER ISTKGT, ILWORK, I, J, IPOW, IW
      INTEGER IS(1000), MUSED, IRCNT, ICOST, IHOPT, MRCNT
      INTEGER IWORK, KOPTO, IX1
      REAL ABS, HUP, RNDING, LOGRND, HUPMAX, HUP0
      REAL ALOG, T0, T1, RS(1000), LOGHI, CLOSE
      REAL FLOAT, WS(500), LOGLO, R1MACH
      LOGICAL PRSTRT, LS(1000)
      LOGICAL TEMP, TEMP1
      EQUIVALENCE (DS(1), WS(1), RS(1), IS(1), LS(1))
      DATA CLOSE/1E-2/
      DATA MRCNT/3/
      DATA HUP0/1E-1/
C INITIALIZATION.
      IF (TSTART .NE. TSTOP) GOTO 1
         A4SSOI = .TRUE.
         RETURN
   1     A4SSOI = .FALSE.
C CHECK THE INPUT.
C/6S
C  2  IF (BETA .LE. 0.) CALL SETERR(18H ESSOM - BETA.LE.0, 18, 1, 2)
C     IF (GAMMA .LE. 0.) CALL SETERR(19H ESSOM - GAMMA.LE.0, 19, 2, 2)
C     IF (DELTA .LT. 0.) CALL SETERR(19H ESSOM - DELTA.LT.0, 19, 3, 2)
C     IF (NX .LT. 1) CALL SETERR(16H ESSOM - NX.LT.1, 16, 4, 2)
C     IF (TSTART+DT .EQ. TSTART) CALL SETERR(22H ESSOM - DT=0 ON INPUT
C    1   , 22, 5, 2)
C     IF (N(1) .LT. 1) CALL SETERR(18H ESSOM - N(1).LT.1, 18, 6, 2)
C     IF (KMAX .LT. 1) CALL SETERR(18H ESSOM - KMAX.LT.1, 18, 7, 2)
C/7S
   2  IF (BETA .LE. 0.) CALL SETERR(' ESSOM - BETA.LE.0', 18, 1, 2)
      IF (GAMMA .LE. 0.) CALL SETERR(' ESSOM - GAMMA.LE.0', 19, 2, 2)
      IF (DELTA .LT. 0.) CALL SETERR(' ESSOM - DELTA.LT.0', 19, 3, 2)
      IF (NX .LT. 1) CALL SETERR(' ESSOM - NX.LT.1', 16, 4, 2)
      IF (TSTART+DT .EQ. TSTART) CALL SETERR(' ESSOM - DT=0 ON INPUT'
     1   , 22, 5, 2)
      IF (N(1) .LT. 1) CALL SETERR(' ESSOM - N(1).LT.1', 18, 6, 2)
      IF (KMAX .LT. 1) CALL SETERR(' ESSOM - KMAX.LT.1', 18, 7, 2)
C/
      TEMP = MMAX .LT. KMAX+2
      IF (.NOT. TEMP) GOTO 3
         TEMP1 = KMAX .GT. 1
         IF (.NOT. TEMP1) TEMP1 = MMAX .NE. 1
         TEMP = TEMP1
C/6S
C  3  IF (TEMP) CALL SETERR(23H ESSOM - MMAX.LT.KMAX+2, 23, 8, 2)
C/7S
   3  IF (TEMP) CALL SETERR(' ESSOM - MMAX.LT.KMAX+2', 23, 8, 2)
C/
      TEMP = PESPAR .LE. 0.
      IF (.NOT. TEMP) TEMP = PESPAR .GT. 1.
C/6S
C     IF (TEMP) CALL SETERR(28H ESSOM - PESPAR NOT IN (0,1), 28, 9, 2)
C     IF (HFRACT .LE. 0.) CALL SETERR(20H ESSOM - HFRACT.LE.0, 20, 10, 2
C    1   )
C/7S
      IF (TEMP) CALL SETERR(' ESSOM - PESPAR NOT IN (0,1)', 28, 9, 2)
      IF (HFRACT .LE. 0.) CALL SETERR(' ESSOM - HFRACT.LE.0', 20, 10, 2
     1   )
C/
      TEMP = KINIT .LT. 1
      IF (.NOT. TEMP) TEMP = KINIT .GT. KMAX
C/6S
C     IF (TEMP) CALL SETERR(34H ESSOM - KINIT NOT IN (1,...,KMAX), 34,
C    1   11, 2)
C     IF (BETA-DELTA+GAMMA .LE. 0.) CALL SETERR(
C    1   30H ESSOM - BETA-DELTA+GAMMA.LE.0, 30, 12, 2)
C/7S
      IF (TEMP) CALL SETERR(' ESSOM - KINIT NOT IN (1,...,KMAX)', 34,
     1   11, 2)
      IF (BETA-DELTA+GAMMA .LE. 0.) CALL SETERR(
     1   ' ESSOM - BETA-DELTA+GAMMA.LE.0', 30, 12, 2)
C/
C ALLOCATE AND LOAD THE ARRAY SLOGN WITH LOG(N(1))+ ... +LOG(N(I-1)).
      ISLOGN = ISTKGT(MMAX+1, 3)
      WS(ISLOGN) = 0
      J = 2
         GOTO  5
   4     J = J+1
   5     IF (J .GT. MMAX) GOTO  6
C/6S
C        IF (N(J-1) .GE. N(J)) CALL SETERR(
C    1      37H ESSOM - N IS NOT MONOTONE INCREASING, 37, 13, 2)
C/7S
         IF (N(J-1) .GE. N(J)) CALL SETERR(
     1      ' ESSOM - N IS NOT MONOTONE INCREASING', 37, 13, 2)
C/
         I = ISLOGN+J-1
         WS(I) = WS(I-1)+ALOG(FLOAT(N(J-1)))
         GOTO  4
   6  I = ISLOGN+MMAX
      WS(I) = WS(I-1)+ALOG(FLOAT(N(MMAX)))
C/6S
C     IF (DT/ABS(DT)*(TSTOP-TSTART) .LE. 0.) CALL SETERR(
C    1   30H ESSOM - DT HAS THE WRONG SIGN, 30, 14, 2)
C/7S
      IF (DT/ABS(DT)*(TSTOP-TSTART) .LE. 0.) CALL SETERR(
     1   ' ESSOM - DT HAS THE WRONG SIGN', 30, 14, 2)
C/
C ALLOCATE CURRENT AND OLD OPTIMAL STEP-SIZE ARRAYS.
      IHOPT = ISTKGT(KMAX+1, 3)
      IHOPTO = ISTKGT(KMAX+1, 3)
C ALLOCATE AND LOAD THE ARRAY NG WITH N(J)**GAMMA.
      ING = ISTKGT(MMAX, 3)
      DO  7 J = 1, MMAX
         I = ING+J-1
         WS(I) = FLOAT(N(J))**GAMMA
   7     CONTINUE
C ALLOCATE SPACE FOR X1 (THE SOLUTION AT TIME T1) AND A SCRATCH ARRAY F.
      IX1 = ISTKGT(NX, 3)
      IFA = ISTKGT(KMAX, 3)
C ALLOCATE AND LOAD POW(J) WITH 1/(BETA-DELTA+J*GAMMA).
      IPOW = ISTKGT(KMAX, 3)
      DO  8 J = 1, KMAX
         I = IPOW+J-1
         RS(I) = 1./(BETA-DELTA+FLOAT(J)*GAMMA)
   8     CONTINUE
C ALLOCATE AND LOAD ARRAYS WORK AND LWORK WITH
C SUM(I=1,...,J)(N(I)) AND LOG(WORK(J)), RESPECTIVELY.
      IWORK = ISTKGT(MMAX, 3)
      ILWORK = ISTKGT(MMAX, 3)
      RS(IWORK) = N(1)
      RS(ILWORK) = ALOG(RS(IWORK))
      J = 2
         GOTO  10
   9     J = J+1
  10     IF (J .GT. MMAX) GOTO  11
         IW = IWORK+J-1
         RS(IW) = RS(IW-1)+FLOAT(N(J))
         ILW = ILWORK+J-1
         RS(ILW) = ALOG(RS(IW))
         GOTO  9
C ALLOCATE THE COST/UNIT TIME-STEP ARRAY.
  11  ICOST = ISTKGT(KMAX+1, 3)
C ALLOCATE THE EXTRAPOLATION LOZENGE LAST SO THAT ISTKMD CAN
C BE USED TO LET IT GROW ONLY AS NEEDED.
      ILOZNG = ISTKGT(1, 3)
C GET THE LOGARITHMS OF THE LARGEST AND SMALLEST NUMBERS,
C AS WELL AS THE ROUNDING ERROR LEVEL, OF THE MACHINE.
      LOGLO = ALOG(R1MACH(1))
      LOGHI = ALOG(R1MACH(2))
      RNDING = R1MACH(4)
      LOGRND = ALOG(RNDING)
      HUPMAX = (-(LOGRND+4.6))/(BETA+GAMMA)
      MUSED = 0
      IRCNT = 0
      KOPTO = KINIT
      HUP = HUPMAX
      PRSTRT = .FALSE.
      T0 = TSTART
      T1 = T0+DT
      TEMP = (DT/ABS(DT))*(T1-TSTOP) .GE. 0.
      IF (.NOT. TEMP) TEMP = ABS(T1-TSTOP) .LE. CLOSE*ABS(DT)
      IF (TEMP) T1 = TSTOP
      DT = T1-T0
C LOAD THE VARIABLE ARRAYS WITH THE APPROPRIATE VALUES.
      WV(1) = TSTART
      WV(2) = TSTOP
      WV(3) = BETA
      WV(4) = GAMMA
      WV(5) = DELTA
      WV(6) = DT
      WV(7) = CLOSE
      WV(9) = DT
      WV(10) = T0
      WV(11) = T1
      RV(1) = ERRPAR(1)
      RV(2) = ERRPAR(2)
      RV(3) = PESPAR
      RV(4) = HFRACT
      RV(5) = HUP0
      RV(6) = HUPMAX
      RV(7) = HUP
      RV(8) = LOGLO
      RV(9) = LOGHI
      RV(10) = LOGRND
      RV(11) = RNDING
      RV(12) = 1E-2
      IV(1) = NX
      IV(2) = KMAX
      IV(3) = MMAX
      IV(4) = KINIT
      IV(5) = ICOST
      IV(6) = IHOPT
      IV(7) = IHOPTO
      IV(8) = IWORK
      IV(9) = ILWORK
      IV(10) = IPOW
      IV(11) = ISLOGN
      IV(12) = IX1
      IV(13) = ILOZNG
      IV(14) = MRCNT
      IV(15) = 0
      IV(16) = KOPTO
      IV(17) = KOPTO
      IV(20) = MUSED
      IV(25) = IRCNT
      IV(26) = IFA
      IV(27) = ING
      LV(1) = XPOLY
      LV(3) = PRSTRT
      RETURN
      END
