C       MAIN PROGRAM TO TEST FIXPQS, FIXPNS, AND FIXPDS
C
C       THIS PROGRAM TESTS THE HOMPACK ROUTINES FIXPNS, FIXPQS, AND
C       FIXPDS.  THE USER MAY INSERT CALLS TO A SYSTEM TIMER AT THE
C       DESIGNATED LOCATIONS IN ORDER TO GET EXECUTION TIME FOR THESE
C       ROUTINES.
C
C       THE MODIFICATIONS TO BE MADE FOR THE SYSTEM TIMER ARE INDICATED
C       BY A LINE OF M'S, E.G.
CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
C
C
C       THE OUTPUT FROM THIS ROUTINE SHOULD BE AS FOLLOWS, WITH THE
C       EXECUTION TIMES CORRESPONDING TO A VAX 11/785.
C
C       TESTING FIXPQS
C
C LAMBDA = 1.00000000  FLAG = 1      33 JACOBIAN EVALUATIONS
C ARC LENGTH =   1.274   EXECUTION TIME(SECS) =      2.31
C   4.00864019E-01  2.65454893E-01  8.40421103E-02  4.83042527E-01
C   3.01797132E-01  2.32508994E-01  4.96639853E-01  3.00908894E-01
C
C       TESTING FIXPNS
C
C LAMBDA = 1.00000000  FLAG = 1      20 JACOBIAN EVALUATIONS
C ARC LENGTH =   1.275   EXECUTION TIME(SECS) =      1.04
C   4.00864019E-01  2.65454893E-01  8.40421103E-02  4.83042527E-01
C   3.01797132E-01  2.32508994E-01  4.96639853E-01  3.00908894E-01
C
C       TESTING FIXPDS
C
C LAMBDA = 1.00000000  FLAG = 1      70 JACOBIAN EVALUATIONS
C ARC LENGTH =   1.281   EXECUTION TIME(SECS) =      1.78
C   4.00864019E-01  2.65454893E-01  8.40421103E-02  4.83042527E-01
C   3.01797132E-01  2.32508994E-01  4.96639853E-01  3.00908894E-01
C
C
        PROGRAM TEST1
        IMPLICIT DOUBLE PRECISION(A-H,O-Z)
        DOUBLE PRECISION Y(9),
     +  YP(9),YOLD(9),YPOLD(9),A(8),QR(18),WORK(200),
     +  SSPAR(8),PAR(1),PP(8),RHOVEC(9),Z0(9),DZ(9),T(9),
     +  WT(9),PHI(9,16),P(9)
        INTEGER PIVOT(10),IPAR(1)
        INTEGER IFLAG,II,J,LENQR,N,NFE,NP1,NDIMA,TRACE
        DOUBLE PRECISION ARCRE,ARCAE,ANSRE,ANSAE,ARCLEN
        CHARACTER*6 NAME
        INTEGER TIME,CODE
        REAL DTIME
C
C TEST EACH OF THE THREE ALGORITHMS.
C
        DO 60 II=1,3
C
C INITIALIZE TIMER VARIABLES.
C
           CODE=2
           TIME=0
           DTIME=0.0
C
C DFEFINE ARGUMENTS FOR CALL TO HOMPACK PROCEDURE.
C
           N=8
           DO 7 J=1,8
7             SSPAR(J)=0.0D0
           ARCRE=.5D-4
           ARCAE=.5D-4
           ANSRE=1.0D-12
           ANSAE=1.0D-12
	   TRACE=0
           IFLAG=-1
           LENQR=18
           NP1=N+1
           DO 40 J=1,N
40            Y(J)=0.5D0
C
CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
C
C INSERT CALL TO INITIALIZE SYSTEM TIMER HERE.  FOR EXAMPLE, FOR
C THE VAX, THE FOLLOWING STATEMENT IS USED.
C
C         CALL LIB$INIT_TIMER
C
CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
C
C CALL TO HOMPACK ROUTINE.
C
C
          IF (II .EQ. 1) THEN
             NAME='FIXPQS'
             CALL FIXPQS(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,
     +         A,NFE,ARCLEN,YP,YOLD,YPOLD,QR,LENQR,PIVOT,PP,RHOVEC,
     +         Z0,DZ,T,WORK,SSPAR,PAR,IPAR)
          ELSE IF (II .EQ. 2) THEN
             NAME='FIXPNS'
             CALL FIXPNS(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A,
     +         NFE,ARCLEN,YP,YOLD,YPOLD,QR,LENQR,PIVOT,WORK,
     +         SSPAR,PAR,IPAR)
          ELSE
             NAME='FIXPDS'
             CALL FIXPDS(N,Y,IFLAG,ARCRE,ANSRE,TRACE,A,NDIMA,NFE,
     +         ARCLEN,YP,YPOLD,QR,LENQR,PIVOT,PP,WORK,WT,PHI,P,
     +         PAR,IPAR)
          END IF
C
CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
C
C INSERT CALL TO RETURN EXECUTION TIME IN SECONDS IN DTIME.
C FOR EXAMPLE, THE VAX STATEMENTS ARE AS FOLLOWS.
C      CALL LIB$STAT_TIMER(CODE,TIME)
C      DTIME=TIME/100.0
C
CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
C
          WRITE (6,45) NAME
45        FORMAT(//,8X,'TESTING',1X,6A)
          WRITE (6,50) Y(NP1),IFLAG,NFE,ARCLEN,DTIME,(Y(J),J=1,N)
50        FORMAT(/' LAMBDA =',F11.8,'  FLAG =',I2,I8,' JACOBIAN ',
     +    'EVALUATIONS',/,1X,'  ARC LENGTH =',F8.3,
     +    '   EXECUTION TIME(SECS) =',F10.2/(1X,1P,4E16.8))
60     CONTINUE
       STOP
       END
       SUBROUTINE F(X,V)
C
C****************************************************************
C
C      SUBROUTINE F(X,V)  --  COMPUTES F AT THE POINT X,
C        RETURNING THE VALUE IN V.
C
C****************************************************************
       DOUBLE PRECISION X(8),V(8)
       V(1)=X(1)**3+6.0*X(2)*X(3)-1+2.0*X(1)
       V(2)=6.0*X(1)*X(3)+X(2)**4*X(5)-1+3.0*X(2)
       V(3)=6.0*X(1)*X(2)+X(3)*X(5)-1+4.0*X(3)
       V(4)=X(4)**3*X(8)-1+2.0*X(4)
       V(5)=X(2)**5/5.0 + X(3)**2/2.0 + X(8)*X(5)-1+3.0*X(5)
       V(6)=X(6)*X(8)-1+4.0*X(6)
       V(7)=X(7)**2*X(8)**3-1+2.0*X(7)
       V(8)=X(4)**4/4.0 + X(5)**2/2.0 + X(6)**2/2.0 + X(7)**3*
     +    X(8)**2-1+3.0*X(8)
       RETURN
       END
       SUBROUTINE FJACS(X,QR,LENQR,PIVOT)
C******************************************************************
C
C      SUBROUTINE FJACS(X,QR,LENQR,PIVOT)
C
C         -- COMPUTES THE JACOBIAN OF F AT THE POINT X, RETURNING
C            THE JACOBIAN MATRIX IN PACKED SKYLINE FORM IN THE
C            ARRAYS QR, AND PIVOT.
C
C*****************************************************************
       DOUBLE PRECISION X(8),QR(LENQR)
       INTEGER LENQR,PIVOT(9)
       PIVOT(1)=1
       PIVOT(2)=2
       PIVOT(3)=4
       PIVOT(4)=7
       PIVOT(5)=8
       PIVOT(6)=12
       PIVOT(7)=13
       PIVOT(8)=14
       PIVOT(9)=19
       QR(1)=3.0*X(1)**2+2.0
       QR(2)=4.0*X(2)**3*X(5)+3.0
       QR(3)=6.0*X(3)
       QR(4)=X(5)+4.0
       QR(5)=6.0*X(1)
       QR(6)=6.0*X(2)
       QR(7)=3.0*X(4)**2*X(8)+2.0
       QR(8)=X(8)+3.0
       QR(9)=.0
       QR(10)=X(3)
       QR(11)=X(2)**4
       QR(12)=X(8)+4.0
       QR(13)=2.0*X(7)*X(8)**3+2.0
       QR(14)=2.0*X(7)**3*X(8)+3.0
       QR(15)=3.0*X(7)**2*X(8)**2
       QR(16)=X(6)
       QR(17)=X(5)
       QR(18)=X(4)**3
       RETURN
       END