share/hompack/fortran/mains.f

   1 C       MAIN PROGRAM TO TEST FIXPQS, FIXPNS, AND FIXPDS
   2 C
   3 C       THIS PROGRAM TESTS THE HOMPACK ROUTINES FIXPNS, FIXPQS, AND
   4 C       FIXPDS.  THE USER MAY INSERT CALLS TO A SYSTEM TIMER AT THE
   5 C       DESIGNATED LOCATIONS IN ORDER TO GET EXECUTION TIME FOR THESE
   6 C       ROUTINES.
   7 C
   8 C       THE MODIFICATIONS TO BE MADE FOR THE SYSTEM TIMER ARE INDICATED
   9 C       BY A LINE OF M'S, E.G.
  10 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
  11 C
  12 C
  13 C       THE OUTPUT FROM THIS ROUTINE SHOULD BE AS FOLLOWS, WITH THE
  14 C       EXECUTION TIMES CORRESPONDING TO A VAX 11/785.
  15 C
  16 C       TESTING FIXPQS
  17 C
  18 C LAMBDA = 1.00000000  FLAG = 1      33 JACOBIAN EVALUATIONS
  19 C ARC LENGTH =   1.274   EXECUTION TIME(SECS) =      2.31
  20 C   4.00864019E-01  2.65454893E-01  8.40421103E-02  4.83042527E-01
  21 C   3.01797132E-01  2.32508994E-01  4.96639853E-01  3.00908894E-01
  22 C
  23 C       TESTING FIXPNS
  24 C
  25 C LAMBDA = 1.00000000  FLAG = 1      20 JACOBIAN EVALUATIONS
  26 C ARC LENGTH =   1.275   EXECUTION TIME(SECS) =      1.04
  27 C   4.00864019E-01  2.65454893E-01  8.40421103E-02  4.83042527E-01
  28 C   3.01797132E-01  2.32508994E-01  4.96639853E-01  3.00908894E-01
  29 C
  30 C       TESTING FIXPDS
  31 C
  32 C LAMBDA = 1.00000000  FLAG = 1      70 JACOBIAN EVALUATIONS
  33 C ARC LENGTH =   1.281   EXECUTION TIME(SECS) =      1.78
  34 C   4.00864019E-01  2.65454893E-01  8.40421103E-02  4.83042527E-01
  35 C   3.01797132E-01  2.32508994E-01  4.96639853E-01  3.00908894E-01
  36 C
  37 C
  38         PROGRAM MAINS
  39         IMPLICIT DOUBLE PRECISION(A-H,O-Z)
  40         DOUBLE PRECISION Y(9),
  41      +  YP(9),YOLD(9),YPOLD(9),A(8),QR(18),WORK(200),
  42      +  SSPAR(8),PAR(1),PP(8),RHOVEC(9),Z0(9),DZ(9),T(9),
  43      +  WT(9),PHI(9,16),P(9)
  44         INTEGER PIVOT(10),IPAR(1)
  45         INTEGER IFLAG,II,J,LENQR,N,NFE,NP1,NDIMA,TRACE
  46         DOUBLE PRECISION ARCRE,ARCAE,ANSRE,ANSAE,ARCLEN
  47         CHARACTER*6 NAME
  48         INTEGER TIME,CODE
  49         REAL DTIME
  50 C
  51 C TEST EACH OF THE THREE ALGORITHMS.
  52 C
  53         DO 60 II=1,3
  54 C
  55 C INITIALIZE TIMER VARIABLES.
  56 C
  57            CODE=2
  58            TIME=0
  59            DTIME=0.0
  60 C
  61 C DFEFINE ARGUMENTS FOR CALL TO HOMPACK PROCEDURE.
  62 C
  63            N=8
  64            DO 7 J=1,8
  65 7             SSPAR(J)=0.0D0
  66            ARCRE=.5D-4
  67            ARCAE=.5D-4
  68            ANSRE=1.0D-12
  69            ANSAE=1.0D-12
  70            TRACE=0
  71            IFLAG=-1
  72            LENQR=18
  73            NP1=N+1
  74            DO 40 J=1,N
  75 40            Y(J)=0.5D0
  76 C
  77 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
  78 C
  79 C INSERT CALL TO INITIALIZE SYSTEM TIMER HERE.  FOR EXAMPLE, FOR
  80 C THE VAX, THE FOLLOWING STATEMENT IS USED.
  81 C
  82 C         CALL LIB$INIT_TIMER
  83 C
  84 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
  85 C
  86 C CALL TO HOMPACK ROUTINE.
  87 C
  88 C
  89           IF (II .EQ. 1) THEN
  90              NAME='FIXPQS'
  91              CALL FIXPQS(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,
  92      +         A,NFE,ARCLEN,YP,YOLD,YPOLD,QR,LENQR,PIVOT,PP,RHOVEC,
  93      +         Z0,DZ,T,WORK,SSPAR,PAR,IPAR)
  94           ELSE IF (II .EQ. 2) THEN
  95              NAME='FIXPNS'
  96              CALL FIXPNS(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A,
  97      +         NFE,ARCLEN,YP,YOLD,YPOLD,QR,LENQR,PIVOT,WORK,
  98      +         SSPAR,PAR,IPAR)
  99           ELSE
 100              NAME='FIXPDS'
 101              CALL FIXPDS(N,Y,IFLAG,ARCRE,ANSRE,TRACE,A,NDIMA,NFE,
 102      +         ARCLEN,YP,YPOLD,QR,LENQR,PIVOT,PP,WORK,WT,PHI,P,
 103      +         PAR,IPAR)
 104           END IF
 105 C
 106 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
 107 C
 108 C INSERT CALL TO RETURN EXECUTION TIME IN SECONDS IN DTIME.
 109 C FOR EXAMPLE, THE VAX STATEMENTS ARE AS FOLLOWS.
 110 C      CALL LIB$STAT_TIMER(CODE,TIME)
 111 C      DTIME=TIME/100.0
 112 C
 113 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
 114 C
 115           WRITE (6,45) NAME
 116 45        FORMAT(//,8X,'TESTING',1X,6A)
 117           WRITE (6,50) Y(NP1),IFLAG,NFE,ARCLEN,DTIME,(Y(J),J=1,N)
 118 50        FORMAT(/' LAMBDA =',F11.8,'  FLAG =',I2,I8,' JACOBIAN ',
 119      +    'EVALUATIONS',/,1X,'  ARC LENGTH =',F8.3,
 120      +    '   EXECUTION TIME(SECS) =',F10.2/(1X,1P,4E16.8))
 121 60     CONTINUE
 122        STOP
 123        END
 124        SUBROUTINE F(X,V)
 125 C
 126 C****************************************************************
 127 C
 128 C      SUBROUTINE F(X,V)  --  COMPUTES F AT THE POINT X,
 129 C        RETURNING THE VALUE IN V.
 130 C
 131 C****************************************************************
 132        DOUBLE PRECISION X(8),V(8)
 133        V(1)=X(1)**3+6.0*X(2)*X(3)-1+2.0*X(1)
 134        V(2)=6.0*X(1)*X(3)+X(2)**4*X(5)-1+3.0*X(2)
 135        V(3)=6.0*X(1)*X(2)+X(3)*X(5)-1+4.0*X(3)
 136        V(4)=X(4)**3*X(8)-1+2.0*X(4)
 137        V(5)=X(2)**5/5.0 + X(3)**2/2.0 + X(8)*X(5)-1+3.0*X(5)
 138        V(6)=X(6)*X(8)-1+4.0*X(6)
 139        V(7)=X(7)**2*X(8)**3-1+2.0*X(7)
 140        V(8)=X(4)**4/4.0 + X(5)**2/2.0 + X(6)**2/2.0 + X(7)**3*
 141      +    X(8)**2-1+3.0*X(8)
 142        RETURN
 143        END
 144        SUBROUTINE FJACS(X,QR,LENQR,PIVOT)
 145 C******************************************************************
 146 C
 147 C      SUBROUTINE FJACS(X,QR,LENQR,PIVOT)
 148 C
 149 C         -- COMPUTES THE JACOBIAN OF F AT THE POINT X, RETURNING
 150 C            THE JACOBIAN MATRIX IN PACKED SKYLINE FORM IN THE
 151 C            ARRAYS QR, AND PIVOT.
 152 C
 153 C*****************************************************************
 154        DOUBLE PRECISION X(8),QR(LENQR)
 155        INTEGER LENQR,PIVOT(9)
 156        PIVOT(1)=1
 157        PIVOT(2)=2
 158        PIVOT(3)=4
 159        PIVOT(4)=7
 160        PIVOT(5)=8
 161        PIVOT(6)=12
 162        PIVOT(7)=13
 163        PIVOT(8)=14
 164        PIVOT(9)=19
 165        QR(1)=3.0*X(1)**2+2.0
 166        QR(2)=4.0*X(2)**3*X(5)+3.0
 167        QR(3)=6.0*X(3)
 168        QR(4)=X(5)+4.0
 169        QR(5)=6.0*X(1)
 170        QR(6)=6.0*X(2)
 171        QR(7)=3.0*X(4)**2*X(8)+2.0
 172        QR(8)=X(8)+3.0
 173        QR(9)=.0
 174        QR(10)=X(3)
 175        QR(11)=X(2)**4
 176        QR(12)=X(8)+4.0
 177        QR(13)=2.0*X(7)*X(8)**3+2.0
 178        QR(14)=2.0*X(7)**3*X(8)+3.0
 179        QR(15)=3.0*X(7)**2*X(8)**2
 180        QR(16)=X(6)
 181        QR(17)=X(5)
 182        QR(18)=X(4)**3
 183        RETURN
 184        END