      SUBROUTINE DSXTRP(TSTART,TSTOP,XA,F,BETA,GAMMA,DELTA,X,NX,DT,N,
     1                  KMAX,MMAX,XPOLY,ERROR,SERROR,ERRPAR,OUTPUT,SOUT,
     2                  PESPAR)
C
C  LET A VECTOR VALUED FUNCTION A(H) OF LENGTH NX PRODUCE AN
C  APPROXIMATION TO X(T1) WHEN GIVEN T0, X(T0) AND H=(T1-T0)/N WHERE
C  N IS AN INTEGER AND X(T) IS SOME UNKNOWN VECTOR-VALUED FUNCTION
C  OF TIME.
C
C  ASSUME THAT
C
C  A(H) = X(T1) +
C
C         ABS(T1-T0)**BETA * SUM(J=1,...,INFINITY)(C(J)*H**(J*GAMMA))
C
C  WHERE THE C(J) ARE UNKNOWN VECTORS INDEPENDENT OF H.
C
C  THIS ROUTINE THEN TAKES THE VALUE X=X(TSTART) AND, USING AN INITIAL
C  VALUE OF T1=TSTART+DT, SEQUENTIALLY EVALUATES X(T1) UNTIL T1=TSTOP.
C
C  THE EVALUATION OF X(T1) IS ACCOMPLISHED USING EXTRAPOLATION TO
C  THE LIMIT OF THE RESULTS OF A(H) FOR H=DT/N(M), M=1,...,MMAX.
C
C  INPUT
C
C    TSTART - THE INITIAL VALUE FOR TIME.
C    TSTOP  - THE FINAL VALUE FOR TIME.
C    XA     - CALL XA(T0,X0,T1,X1,NX,N,F,OK) SHOULD RETURN THE
C             APPROXIMATION X1=A(H) TO X(T1) GIVEN T0, X0=X(T0) AND N.
C             OK=.TRUE. SHOULD BE RETURNED IF X1 HAS BEEN SUCCESSFULLY
C             COMPUTED. OTHERWISE, OK=.FALSE. SHOULD BE RETURNED.
C             THIS WILL CAUSE A RESTART OF THE PROCESS FROM TIME T=T0,
C             WITH A DEFAULT LOWERING OF DT BY 10**3.
C             F IS A SUBPROGRAM NAME, AS PASSED TO DSXTRP.
C    F      - A SUBPROGRAM NAME WHICH IS PASSED TO XA.
C    BETA   - THE POWER SERIES FOR THE ERROR IN A(H) HAS A
C             MULTIPLICATIVE FACTOR OF ABS(T1-T0)**BETA IN FRONT OF IT.
C    GAMMA  - THE POWER SERIES FOR THE ERROR IN A(H) IS IN THE
C             VARIABLE H**GAMMA.
C    DELTA  - THE ERROR CRITERION IS PROPORTIONAL TO
C             ABS(T1-T0)**DELTA.
C    X      - THE INITIAL VALUES X=X(TSTART).
C    NX     - THE LENGTH OF THE SOLUTION VECTOR X.
C    DT     - THE INITIAL TIME-STEP TO BE USED.
C             THE PERFORMANCE OF DSXTRP IS SUBSTANTIALLY
C             INDEPENDENT OF THE VALUE OF DT CHOSEN BY THE USER.
C             IT IS SUFFICIENT THAT THE USERS CHOICE FOR DT MERELY BE
C             WITHIN SEVERAL ORDERS OF MAGNITUDE OF BEING CORRECT.
C             THE VALUE OF DT WILL BE AUTOMATICALLY CHANGED BY DSXTRP
C             DURING THE INTEGRATION PROCESS IN SUCH A WAY AS TO GET
C             THE SOLUTION, TO THE DESIRED ACCURACY, AT THE LEAST
C             POSSIBLE COST.
C    N      - H=(T1-T0)/N(M) WILL BE USED AT THE M-TH LEVEL OF
C             EXTRAPOLATION, M=1,...,MMAX.
C    KMAX   - THE MAXIMAL NUMBER OF COLUMNS KEPT IN THE EXTRAPOLATION
C             PROCESS.
C    MMAX   - THE MAXIMUM LEVEL OF EXTRAPOLATION TO BE USED.
C             MMAX.GE.KMAX+2 IS REQUIRED.
C    XPOLY  - IF (XPOLY) THEN USE POLYNOMIAL EXTRAPOLATION.
C             IF (.NOT.XPOLY) THEN USE RATIONAL EXTRAPOLATION.
C    ERROR  - A SUBPROGRAM NAME WHICH IS PASSED TO SERROR.
C    SERROR - A LOGICAL FUNCTION OF THE FORM
C
C              LOGICAL FUNCTION SERROR(X1,NX,T1,DT,ERRPAR,DELTA,E,ERROR)
C
C             THE INPUT TO SERROR IS
C
C               X1     - X1=X(T1), THE APPROXIMATE SOLUTION FOR WHICH
C                        AN ERROR CRITERION IS DESIRED.
C               NX     - THE LENGTH OF THE SOLUTION VECTOR.
C               T1     - THE CURRENT VALUE OF TIME, X1=X(T1).
C               DT     - DT=T1-T0.
C               ERRPAR - TWO PARAMETERS, AS PASSED TO DSXTRP.
C               DELTA  - AS PASSED TO DSXTRP.
C               E      - E(I) IS THE REAL ABSOLUTE ERROR IN X1(I),
C                        I=1,...,NX, FOR THE SINGLE CURRENT TIME-STEP.
C               ERROR  - THE NAME OF A SUBPROGRAM, AS PASSED TO DSXTRP.
C
C             THE OUTPUT FROM SERROR IS
C
C               E      - E(I) GIVES THE DESIRED REAL ABSOLUTE ERROR
C                        IN THE I-TH COMPONENT OF X1=X(T1), I=1,...,NX.
C               ERRPAR - MAY BE ALTERED IF DESIRED.
C
C             FUNCTION VALUE -
C
C               SERROR - SERROR.TRUE. IF CONVERGED.
C                        SERROR=.FALSE. IF NOT.
C
C    ERRPAR - A VECTOR OF LENGTH TWO TO BE PASSED TO ERROR.
C    OUTPUT - A SUBPROGRAM NAME TO BE PASSED TO SOUT.
C    SOUT   - THE OUTPUT SUBROUTINE
C
C                 SOUT(T0,X0,T1,X1,NX,DT,TSTOP,OK,OUTPUT,E)
C
C             WILL BE CALLED AT THE END OF EACH TIME STEP.
C
C             THE INPUT TO SOUT IS
C
C               T0     - THE OLD VALUE OF T1.
C               X0     - X0=X(T0)
C               T1     - CURRENT VALUE OF TIME.
C               X1     - X1=X(T1).
C               NX     - THE LENGTH OF THE SOLUTION VECTOR.
C               DT     - THE PROPOSED TIME-STEP FOR THE NEXT STEP.
C               TSTOP  - THE CURRENT VALUE OF THE FINAL-TIME.
C               OK     - AS RETURNED BY XA.
C               OUTPUT - A SUBPROGRAM NAME, AS PASSED TO DSXTRP.
C               E      - THE REAL ABSOLUTE ERROR IN X1(I)=X(T1)(I)
C                        IS E(I), I=1,...,NX, FOR THE SINGLE TIME-STEP
C                        FROM T0 TO T1.
C
C             THE OUTPUT FROM SOUT MAY BE ANY OF
C
C               X1     - X1=X(T1).
C               DT     - THE PROPOSED TIME-STEP FOR THE NEXT STEP.
C               TSTOP  - THE FINAL-TIME VALUE.
C
C    PESPAR - THE OPTIMAL TIME-STEP DT IS MULTIPLIED BY PESPAR
C             BEFORE BEING USED FOR THE NEXT STEP.
C             0.LT.PESPAR.LE.1 IS REQUIRED.
C
C  OUTPUT
C
C    X      - X=X(TSTOP), THE FINAL VALUE FOR THE SOLUTION.
C    DT     - THE PROPOSED TIME-STEP FOR THE NEXT STEP, IF ANY.
C    TSTOP  - MAY BE ALTERED BY USER SUPPLIED ROUTINE SOUT.
C    ERRPAR - MAY BE ALTERED BY USER SUPPLIED ROUTINE ERROR.
C
C  SCRATCH SPACE OF LENGTH
C
C                   S(DSXTRP) .LE.
C
C    2*MMAX + NX*(KMAX+1)
C
C  DOUBLE PRECISION WORDS +
C
C    5*KMAX + 2*MMAX + 3 +
C
C    MAX( S(XA), NX*(KMAX+1) +
C
C         MAX( KMAX DOUBLE PRECISION + KMAX , S(ERROR) ) ,
C
C         NX + S(SOUT) )
C
C  INTEGER WORDS IS ALLOCATED.
C
C  ERROR STATES
C
C     1 - BETA.LT.0.
C     2 - GAMMA.LE.0.
C     3 - DELTA.LT.0.
C     4 - NX.LT.1.
C     5 - DT=0 ON INPUT.
C     6 - N(1).LT.1.
C     7 - KMAX.LT.1.
C     8 - MMAX.LT.KMAX+2.
C     9 - PESPAR NOT IN (0,1).
C    10 - BETA-DELTA+GAMMA.LE.0.
C    11 - N IS NOT MONOTONE INCREASING.
C    12 - DT HAS THE WRONG SIGN.
C    13 - DT=0. (RECOVERABLE)
C    14 - DT=0 RETURNED BY SOUT. (RECOVERABLE)
C    15 - DT RETURNED BY SOUT HAS THE WRONG SIGN.
C    16 - DT RAISED BY SOUT WHEN OK=.FALSE..
C    17 - E(I).LE.0 RETURNED BY ERROR. (RECOVERABLE)
C    18 - SOMEBODY IS LEAVING STUFF ON THE STACK.
C
C  WHILE DSXTRP IS EXECUTING, COMMON /D9XTRP/ CONTAINS THE FOLLOWING
C  INFORMATION -
C
C    MC     - THE CURRENT LEVEL OF EXTRAPOLATION.
C    KOPTC  - THE OPTIMAL NUMBER OF COLUMNS IN THE LOZENGE.
C             IF KOPTC IS ZERO, THEN THE NEXT THREE ITEMS ARE
C             MEANINGLESS.
C    ICOST  - THE POINTER TO THE REAL COST/UNIT TIME-STEP ARRAY.
C    KHIC   - THE ACTIVE LENGTH OF THE COST ARRAY.
C    IHOPT  - THE POINTER TO THE REAL ARRAY OF OPTIMAL STEP-SIZES
C             FOR A GIVEN NUMBER OF COLUMNS, ITS LENGTH IS KHIC.
C    IRCNT  - IRCNT LOGARITHMIC BISECTION STEPS ARE TO BE DONE.
C    HUP    - DT CANNOT GROW BY MORE THAN EXP(HUP) PER STEP.
C             HUP WILL BE MULTIPLIED BY 2 AFTER EACH SUCCESSFUL
C             TIME STEP. THIS VALUE IS TYPE REAL.
C    ILOZNG - THE POINTER TO THE LOWER EDGE OF THE DOUBLE PRECISION
C             EXTRAPOLATION LOZENGE.
C    KMAXC  - THE LENGTH OF THE BOTTOM EDGE OF THE LOZENGE IS
C             MIN(KMAXC,MC).
C
      COMMON /D9XTRP/MC,KOPTC,ICOST,KHIC,IHOPT,IRCNT,HUP,ILOZNG,KMAXC
C
      DOUBLE PRECISION TSTART,TSTOP,BETA,GAMMA,DELTA,X(NX),DT
      REAL ERRPAR(2),PESPAR
      INTEGER N(MMAX)
      LOGICAL XPOLY,ERROR,SERROR
      EXTERNAL XA,F,ERROR,SERROR,OUTPUT,SOUT
C
      DOUBLE PRECISION DFLOAT, DLOG
      REAL HUP
C
      COMMON /CSTAK/DS
      DOUBLE PRECISION DS(500)
      DOUBLE PRECISION WS(1)
      REAL RS(1000)
      EQUIVALENCE (DS(1),WS(1)),(DS(1),RS(1))
C
      DFLOAT(IDUMMY)=DBLE(FLOAT(IDUMMY))
C
      IF (TSTART.EQ.TSTOP) GO TO 50
C
      CALL ENTER(1)
C
C ... CHECK THE INPUT.
C
C/6S
C     IF (BETA.LT.0.0D0) CALL SETERR(18HDSXTRP - BETA.LT.0,18,1,2)
C     IF (GAMMA.LE.0.0D0) CALL SETERR(19HDSXTRP - GAMMA.LE.0,19,2,2)
C     IF (DELTA.LT.0.0D0) CALL SETERR(19HDSXTRP - DELTA.LT.0,19,3,2)
C     IF (NX.LT.1) CALL SETERR(16HDSXTRP - NX.LT.1,16,4,2)
C     IF (DT.EQ.0.0D0) CALL SETERR(22HDSXTRP - DT=0 ON INPUT,22,5,2)
C     IF (N(1).LT.1) CALL SETERR(18HDSXTRP - N(1).LT.1,18,6,2)
C     IF (KMAX.LT.1) CALL SETERR(18HDSXTRP - KMAX.LT.1,18,7,2)
C     IF (MMAX.LT.KMAX+2) CALL SETERR(23HDSXTRP - MMAX.LT.KMAX+2,23,8,2)
C     IF (PESPAR.LE.0.0E0.OR.PESPAR.GT.1.0E0) CALL SETERR
C    1   (28HDSXTRP - PESPAR NOT IN (0,1),28,9,2)
C     IF (BETA-DELTA+GAMMA.LE.0.0D0) CALL SETERR
C    1   (30HDSXTRP - BETA-DELTA+GAMMA.LE.0,30,10,2)
C/7S
      IF (BETA.LT.0.0D0) CALL SETERR('DSXTRP - BETA.LT.0',18,1,2)
      IF (GAMMA.LE.0.0D0) CALL SETERR('DSXTRP - GAMMA.LE.0',19,2,2)
      IF (DELTA.LT.0.0D0) CALL SETERR('DSXTRP - DELTA.LT.0',19,3,2)
      IF (NX.LT.1) CALL SETERR('DSXTRP - NX.LT.1',16,4,2)
      IF (DT.EQ.0.0D0) CALL SETERR('DSXTRP - DT=0 ON INPUT',22,5,2)
      IF (N(1).LT.1) CALL SETERR('DSXTRP - N(1).LT.1',18,6,2)
      IF (KMAX.LT.1) CALL SETERR('DSXTRP - KMAX.LT.1',18,7,2)
      IF (MMAX.LT.KMAX+2) CALL SETERR('DSXTRP - MMAX.LT.KMAX+2',23,8,2)
      IF (PESPAR.LE.0.0E0.OR.PESPAR.GT.1.0E0) CALL SETERR
     1   ('DSXTRP - PESPAR NOT IN (0,1)',28,9,2)
      IF (BETA-DELTA+GAMMA.LE.0.0D0) CALL SETERR
     1   ('DSXTRP - BETA-DELTA+GAMMA.LE.0',30,10,2)
C/
C
C ... ALLOCATE AND LOAD THE ARRAY LOGN WITH LOG(N(I)).
C
      ILOGN=ISTKGT(MMAX,4)
      WS(ILOGN)=DLOG(DFLOAT(N(1)))
      I=ILOGN+1
      DO 10 J=2,MMAX
C/6S
C        IF (N(J-1).GE.N(J)) CALL SETERR
C    1      (37HDSXTRP - N IS NOT MONOTONE INCREASING,37,11,2)
C/7S
         IF (N(J-1).GE.N(J)) CALL SETERR
     1      ('DSXTRP - N IS NOT MONOTONE INCREASING',37,11,2)
C/
         WS(I)=DLOG(DFLOAT(N(J)))
 10      I=I+1
C
C ... ALLOCATE CURRENT AND OLD OPTIMAL STEP-SIZE ARRAYS.
C
      IHOPT=ISTKGT(KMAX+1,3)
      IHOPTO=ISTKGT(KMAX+1,3)
C
C ... ALLOCATE AND LOAD THE ARRAY NG WITH N(J)**GAMMA.
C
      ING=ISTKGT(MMAX,4)
      I=ING
      DO 20 J=1,MMAX
         WS(I)=DFLOAT(N(J))**GAMMA
 20      I=I+1
C
C ... ALLOCATE SPACE FOR X1 (THE SOLUTION AT TIME T1),
C ... AND A SCRATCH ARRAY F.
C
      IX1=ISTKGT(NX,4)
      KMAXC=KMAX
      IF=ISTKGT(KMAX,3)
C
C ... ALLOCATE AND LOAD POW(J) WITH 1/(BETA-DELTA+J*GAMMA).
C
      IPOW=ISTKGT(KMAX,3)
      I=IPOW
      DO 30 J=1,KMAX
         RS(I)=1.0E0/(BETA-DELTA+FLOAT(J)*GAMMA)
 30      I=I+1
C
C ... ALLOCATE AND LOAD ARRAYS WORK AND LWORK WITH
C ... SUM(I=1,...,J)(N(I)) AND LOG(WORK(J)), RESPECTIVELY.
C
      IWORK=ISTKGT(MMAX,3)
      ILWORK=ISTKGT(MMAX,3)
      IW=IWORK
      ILW=ILWORK
      RS(IW)=FLOAT(N(1))
      RS(ILW)=ALOG(RS(IW))
      DO 40 J=2,MMAX
         IW=IW+1
         ILW=ILW+1
         RS(IW)=RS(IW-1)+FLOAT(N(J))
 40      RS(ILW)=ALOG(RS(IW))
C
C ... ALLOCATE THE COST/UNIT TIME-STEP ARRAY.
C
      ICOST=ISTKGT(KMAX+1,3)
C
C ... ALLOCATE THE EXTRAPOLATION LOZENGE SO THAT ISTKMD CAN
C ... BE USED TO LET IT GROW ONLY AS NEEDED.
C
      ILOZNG=ISTKGT(1,4)
C
      CALL D8XTRP(TSTART,TSTOP,XA,F,BETA,GAMMA,DELTA,NX,DT,N,KMAX,MMAX,
     1            XPOLY,ERROR,SERROR,ERRPAR,OUTPUT,SOUT,PESPAR,
     2            WS(ILOGN),RS(IHOPT),RS(IHOPTO),WS(ING),X,WS(IX1),
     3            WS(ILOZNG),RS(IF),
     4            RS(IPOW),RS(IWORK),RS(ILWORK),RS(ICOST))
C
      CALL LEAVE
C
 50   RETURN
C
      END
