share/hompack/fortran/mainf.f

   1 C      MAIN PROGRAM TO TEST FIXPNF, FIXPQF, AND FIXPDF
   2 C       BROWN'S FUNCTION, ZERO FINDING.
   3 C
   4 C       THIS PROGRAM TESTS THE HOMPACK ROUTINES FIXPNF, FIXPQF, AND
   5 C       FIXPDF.  THE USER MAY INSERT CALLS TO A SYSTEM TIMER AT THE
   6 C       DESIGNATED LOCATIONS IN ORDER TO GET EXECUTION TIME FOR THESE
   7 C       ROUTINES.
   8 C
   9 C       THE MODIFICATIONS TO BE MADE FOR THE SYSTEM TIMER ARE INDICATED
  10 C       BY A LINE OF M'S, E.G.
  11 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
  12 C
  13 C
  14 C       THE OUTPUT FROM THIS ROUTINE SHOULD BE AS FOLLOWS, WITH THE
  15 C       EXECUTION TIMES CORRESPONDING TO A VAX 11/785.
  16 C
  17 C       TESTING FIXPQF
  18 C
  19 C LAMBDA = 1.00000000  FLAG = 1       6 JACOBIAN EVALUATIONS
  20 C EXECUTION TIME(SECS) =      0.44    ARCLEN =     2.693
  21 C   1.00000000E+00  1.00000000E+00  1.00000000E+00
  22 C   1.00000000E+00  1.00000000E+00
  23 C
  24 C       TESTING FIXPNF
  25 C
  26 C LAMBDA = 1.00000000  FLAG = 1      22 JACOBIAN EVALUATIONS
  27 C EXECUTION TIME(SECS) =      0.19   ARCLEN =     2.682
  28 C   1.00000000E+00  1.00000000E+00  1.00000000E+00
  29 C   1.00000000E+00  1.00000000E+00
  30 C
  31 C       TESTING FIXPDF
  32 C
  33 C LAMBDA = 1.00000000  FLAG = 1      71 JACOBIAN EVALUATIONS
  34 C EXECUTION TIME(SECS) =      0.57   ARCLEN =     2.712
  35 C   1.00000000E+00  1.00000000E+00  1.00000000E+00
  36 C   1.00000000E+00  1.00000000E+00
  37 C
  38 C
  39 C
  40        PROGRAM MAINF
  41        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  42        DOUBLE PRECISION WT(101),PHI(101,16),P(101)
  43        DOUBLE PRECISION ARCLEN,QT(101,101),R(101*52),F0(101)
  44        DOUBLE PRECISION F1(101),DZ(101),T(101)
  45        DOUBLE PRECISION Y(101),W(101),WP(101),Z0(101),Z1(101),
  46      + YP(101),YOLD(101),YPOLD(101),A(100),QR(101,102),
  47      + ALPHA(100),TZ(101),SSPAR(8),YSAV(101),PAR(1)
  48        INTEGER PIVOT(101),CODE,TIME,IPAR(1),N,NDIMA,NFE,TRACE,
  49      +   IFLAG,II,J,NP1
  50        CHARACTER*6 NAME
  51        REAL DTIME
  52        COMMON /SIZE/ N
  53 C
  54 C TEST EACH OF THE THREE ALGORITHMS.
  55 C
  56        DO 60 II=1,3
  57 C
  58 C INITIALIZE TIMER VARIABLES.
  59 C
  60           CODE=2
  61           TIME=0
  62           DTIME=0.0
  63 C
  64 C DEFINE ARGUMENTS FOR CALL TO HOMPACK PROCEDURE.
  65 C
  66           N=5
  67           NP1=N+1
  68           ARCRE=0.5D-4
  69           ARCAE=0.5D-4
  70           ANSRE=1.0D-10
  71           ANSAE=1.0D-10
  72           TRACE=0
  73           DO 30 J=1,8
  74 30           SSPAR(J)=0.0
  75           IFLAG=-1
  76           DO 40 J=2,NP1
  77 40           Y(J)=0.0D0
  78 C
  79 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
  80 C
  81 C INSERT CALL TO INITIALIZE SYSTEM TIMER HERE.  FOR EXAMPLE, FOR
  82 C THE VAX, THE FOLLOWING STATEMENT IS USED.
  83 C
  84 C         CALL LIB$INIT_TIMER
  85 C
  86 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
  87 C
  88 C CALL TO HOMPACK ROUTINE.
  89 C
  90         IF (II .EQ. 1) THEN
  91            NAME='FIXPQF'
  92            CALL FIXPQF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A,NFE,
  93      +       ARCLEN,YP,YOLD,YPOLD,QT,R,F0,F1,Z0,DZ,W,T,YSAV,
  94      +       SSPAR,PAR,IPAR)
  95         ELSE IF (II .EQ. 2) THEN
  96            NAME='FIXPNF'
  97            CALL FIXPNF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A,NFE,
  98      +       ARCLEN,YP,YOLD,YPOLD,QR,ALPHA,TZ,PIVOT,W,WP,Z0,Z1,
  99      +       SSPAR,PAR,IPAR)
 100         ELSE
 101            NAME='FIXPDF'
 102            CALL FIXPDF(N,Y,IFLAG,ARCRE,ANSRE,TRACE,A,NDIMA,NFE,
 103      +       ARCLEN,YP,YPOLD,QR,ALPHA,TZ,PIVOT,WT,PHI,P,PAR,IPAR)
 104         END IF
 105 C
 106 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
 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 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
 114 C
 115           WRITE (6,45) NAME
 116 45        FORMAT (//,8X,'TESTING',1X,6A)
 117           WRITE (6,50) Y(1),IFLAG,NFE,DTIME,ARCLEN,(Y(J),J=2,NP1)
 118 50        FORMAT(//' LAMBDA =',F11.8,'  FLAG =',I2,I8,' JACOBIAN ',
 119      +    'EVALUATIONS',/,1X,'EXECUTION TIME(SECS) =',F10.2,4X,
 120      +     'ARCLEN =',F10.3/(1X,1P,3E16.8))
 121 60     CONTINUE
 122 400    STOP
 123        END
 124        SUBROUTINE F(X,V)
 125 C********************************************************************
 126 C
 127 C      SUBROUTINE F(X,V) -- EVALUATES BROWN'S FUNCTION AT THE POINT
 128 C         X, AND RETURNS THE VALUE IN V.
 129 C
 130 C********************************************************************
 131 C
 132        DOUBLE PRECISION X(1),V(1),PROD,SUM
 133        INTEGER J,N
 134        COMMON /SIZE/ N
 135        PROD=1.0D0
 136        DO 10 J=1,N
 137 10     PROD=PROD*X(J)
 138        V(1)=PROD-1.0D0
 139        SUM=0.0D0
 140        DO 20 J=1,N
 141 20     SUM=SUM+X(J)
 142        SUM=SUM-DBLE(N+1)
 143        DO 30 J=2,N
 144 30     V(J)=SUM+X(J)
 145        RETURN
 146        END
 147        SUBROUTINE FJAC(X,V,K)
 148 C********************************************************************
 149 C
 150 C      SUBROUTINE FJAC(X,V,K)  --  EVALUATES THE K-TH COLUMN OF
 151 C         THE JACOBIAN MATRIX FOR BROWN'S FUNCTION EVALUATED AT
 152 C         THE POINT X, RETURNING THE VALUE IN V.
 153 C
 154 C********************************************************************
 155 C
 156        DOUBLE PRECISION X(1),V(1),PROD
 157        INTEGER J,K,N
 158        COMMON /SIZE/ N
 159        PROD=1.0D0
 160        DO 10 J=1,K-1
 161 10     PROD=PROD*X(J)
 162        DO 15 J=K+1,N
 163 15     PROD=PROD*X(J)
 164        V(1)=PROD
 165        DO 20 J=2,N
 166 20     V(J)=1.0D0
 167        IF (K .GT. 1) V(K)=V(K)+1.0D0
 168        RETURN
 169        END