C MAIN PROGRAM TO TEST FIXPNF, FIXPQF, AND FIXPDF C BROWN'S FUNCTION, ZERO FINDING. C C THIS PROGRAM TESTS THE HOMPACK ROUTINES FIXPNF, FIXPQF, AND C FIXPDF. 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 FIXPQF C C LAMBDA = 1.00000000 FLAG = 1 6 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.44 ARCLEN = 2.693 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 1.00000000E+00 C C TESTING FIXPNF C C LAMBDA = 1.00000000 FLAG = 1 22 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.19 ARCLEN = 2.682 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 1.00000000E+00 C C TESTING FIXPDF C C LAMBDA = 1.00000000 FLAG = 1 71 JACOBIAN EVALUATIONS C EXECUTION TIME(SECS) = 0.57 ARCLEN = 2.712 C 1.00000000E+00 1.00000000E+00 1.00000000E+00 C 1.00000000E+00 1.00000000E+00 C C C PROGRAM TEST1 IMPLICIT DOUBLE PRECISION (A-H,O-Z) DOUBLE PRECISION WT(101),PHI(101,16),P(101) DOUBLE PRECISION ARCLEN,QT(101,101),R(101*52),F0(101) DOUBLE PRECISION F1(101),DZ(101),T(101) DOUBLE PRECISION Y(101),W(101),WP(101),Z0(101),Z1(101), + YP(101),YOLD(101),YPOLD(101),A(100),QR(101,102), + ALPHA(100),TZ(101),SSPAR(8),YSAV(101),PAR(1) INTEGER PIVOT(101),CODE,TIME,IPAR(1),N,NDIMA,NFE,TRACE, + IFLAG,II,J,NP1 CHARACTER*6 NAME REAL DTIME COMMON /SIZE/ N 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 DEFINE ARGUMENTS FOR CALL TO HOMPACK PROCEDURE. C N=5 NP1=N+1 ARCRE=0.5D-4 ARCAE=0.5D-4 ANSRE=1.0D-10 ANSAE=1.0D-10 TRACE=0 DO 30 J=1,8 30 SSPAR(J)=0.0 IFLAG=-1 DO 40 J=2,NP1 40 Y(J)=0.0D0 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 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM C C CALL TO HOMPACK ROUTINE. C IF (II .EQ. 1) THEN NAME='FIXPQF' CALL FIXPQF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A,NFE, + ARCLEN,YP,YOLD,YPOLD,QT,R,F0,F1,Z0,DZ,W,T,YSAV, + SSPAR,PAR,IPAR) ELSE IF (II .EQ. 2) THEN NAME='FIXPNF' CALL FIXPNF(N,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE,A,NFE, + ARCLEN,YP,YOLD,YPOLD,QR,ALPHA,TZ,PIVOT,W,WP,Z0,Z1, + SSPAR,PAR,IPAR) ELSE NAME='FIXPDF' CALL FIXPDF(N,Y,IFLAG,ARCRE,ANSRE,TRACE,A,NDIMA,NFE, + ARCLEN,YP,YPOLD,QR,ALPHA,TZ,PIVOT,WT,PHI,P,PAR,IPAR) END IF C CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM 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 CMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM C WRITE (6,45) NAME 45 FORMAT (//,8X,'TESTING',1X,6A) WRITE (6,50) Y(1),IFLAG,NFE,DTIME,ARCLEN,(Y(J),J=2,NP1) 50 FORMAT(//' LAMBDA =',F11.8,' FLAG =',I2,I8,' JACOBIAN ', + 'EVALUATIONS',/,1X,'EXECUTION TIME(SECS) =',F10.2,4X, + 'ARCLEN =',F10.3/(1X,1P,3E16.8)) 60 CONTINUE 400 STOP END SUBROUTINE F(X,V) C******************************************************************** C C SUBROUTINE F(X,V) -- EVALUATES BROWN'S FUNCTION AT THE POINT C X, AND RETURNS THE VALUE IN V. C C******************************************************************** C DOUBLE PRECISION X(1),V(1),PROD,SUM INTEGER J,N COMMON /SIZE/ N PROD=1.0D0 DO 10 J=1,N 10 PROD=PROD*X(J) V(1)=PROD-1.0D0 SUM=0.0D0 DO 20 J=1,N 20 SUM=SUM+X(J) SUM=SUM-DBLE(N+1) DO 30 J=2,N 30 V(J)=SUM+X(J) RETURN END SUBROUTINE FJAC(X,V,K) C******************************************************************** C C SUBROUTINE FJAC(X,V,K) -- EVALUATES THE K-TH COLUMN OF C THE JACOBIAN MATRIX FOR BROWN'S FUNCTION EVALUATED AT C THE POINT X, RETURNING THE VALUE IN V. C C******************************************************************** C DOUBLE PRECISION X(1),V(1),PROD INTEGER J,K,N COMMON /SIZE/ N PROD=1.0D0 DO 10 J=1,K-1 10 PROD=PROD*X(J) DO 15 J=K+1,N 15 PROD=PROD*X(J) V(1)=PROD DO 20 J=2,N 20 V(J)=1.0D0 IF (K .GT. 1) V(K)=V(K)+1.0D0 RETURN END