C **********
C
C THIS PROGRAM TESTS CODES FOR THE SOLUTION OF N NONLINEAR
C EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER AND AN
C INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA, CALLS THE
C NONLINEAR EQUATION SOLVER, AND FINALLY PRINTS OUT INFORMATION
C ON THE PERFORMANCE OF THE SOLVER. THIS IS ONLY A SAMPLE DRIVER,
C MANY OTHER DRIVERS ARE POSSIBLE. THE INTERFACE SUBROUTINE FCN
C IS NECESSARY TO TAKE INTO ACCOUNT THE FORMS OF CALLING
C SEQUENCES USED BY THE FUNCTION AND JACOBIAN SUBROUTINES IN
C THE VARIOUS NONLINEAR EQUATION SOLVERS.
C
C SUBPROGRAMS CALLED
C
C USER-SUPPLIED ...... FCN
C
C MINPACK-SUPPLIED ... SPMPAR,ENORM,HYBRJ1,INITPT,VECFCN
C
C FORTRAN-SUPPLIED ... SQRT
C
C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER I,IC,INFO,K,LDFJAC,LWA,N,NFEV,NJEV,NPROB,NREAD,NTRIES,
* NWRITE
INTEGER NA(60),NF(60),NJ(60),NP(60),NX(60)
REAL FACTOR,FNORM1,FNORM2,ONE,TEN,TOL
REAL FNM(60),FJAC(40,40),FVEC(40),WA(1060),X(40)
REAL SPMPAR,ENORM
EXTERNAL FCN
COMMON /REFNUM/ NPROB,NFEV,NJEV
C
C LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.
C LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.
C
DATA NREAD,NWRITE /5,6/
C
DATA ONE,TEN /1.0E0,1.0E1/
TOL = SQRT(SPMPAR(1))
LDFJAC = 40
LWA = 1060
IC = 0
10 CONTINUE
READ (NREAD,50) NPROB,N,NTRIES
IF (NPROB .LE. 0) GO TO 30
FACTOR = ONE
DO 20 K = 1, NTRIES
IC = IC + 1
CALL INITPT(N,X,NPROB,FACTOR)
CALL VECFCN(N,X,FVEC,NPROB)
FNORM1 = ENORM(N,FVEC)
WRITE (NWRITE,60) NPROB,N
NFEV = 0
NJEV = 0
CALL HYBRJ1(FCN,N,X,FVEC,FJAC,LDFJAC,TOL,INFO,WA,LWA)
FNORM2 = ENORM(N,FVEC)
NP(IC) = NPROB
NA(IC) = N
NF(IC) = NFEV
NJ(IC) = NJEV
NX(IC) = INFO
FNM(IC) = FNORM2
WRITE (NWRITE,70)
* FNORM1,FNORM2,NFEV,NJEV,INFO,(X(I), I = 1, N)
FACTOR = TEN*FACTOR
20 CONTINUE
GO TO 10
30 CONTINUE
WRITE (NWRITE,80) IC
WRITE (NWRITE,90)
DO 40 I = 1, IC
WRITE (NWRITE,100) NP(I),NA(I),NF(I),NJ(I),NX(I),FNM(I)
40 CONTINUE
STOP
50 FORMAT (3I5)
60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 10H DIMENSION, I5, 5X //)
70 FORMAT (5X, 33H INITIAL L2 NORM OF THE RESIDUALS, E15.7 // 5X,
* 33H FINAL L2 NORM OF THE RESIDUALS , E15.7 // 5X,
* 33H NUMBER OF FUNCTION EVALUATIONS , I10 // 5X,
* 33H NUMBER OF JACOBIAN EVALUATIONS , I10 // 5X,
* 15H EXIT PARAMETER, 18X, I10 // 5X,
* 27H FINAL APPROXIMATE SOLUTION // (5X, 5E15.7))
80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO HYBRJ1 /)
90 FORMAT (46H NPROB N NFEV NJEV INFO FINAL L2 NORM /)
100 FORMAT (I4, I6, 2I7, I6, 1X, E15.7)
C
C LAST CARD OF DRIVER.
C
END
SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG)
INTEGER N,LDFJAC,IFLAG
REAL X(N),FVEC(N),FJAC(LDFJAC,N)
C **********
C
C THE CALLING SEQUENCE OF FCN SHOULD BE IDENTICAL TO THE
C CALLING SEQUENCE OF THE FUNCTION SUBROUTINE IN THE NONLINEAR
C EQUATION SOLVER. FCN SHOULD ONLY CALL THE TESTING FUNCTION
C AND JACOBIAN SUBROUTINES VECFCN AND VECJAC WITH THE
C APPROPRIATE VALUE OF PROBLEM NUMBER (NPROB).
C
C SUBPROGRAMS CALLED
C
C MINPACK-SUPPLIED ... VECFCN,VECJAC
C
C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER NPROB,NFEV,NJEV
COMMON /REFNUM/ NPROB,NFEV,NJEV
IF (IFLAG .EQ. 1) CALL VECFCN(N,X,FVEC,NPROB)
IF (IFLAG .EQ. 2) CALL VECJAC(N,X,FJAC,LDFJAC,NPROB)
IF (IFLAG .EQ. 1) NFEV = NFEV + 1
IF (IFLAG .EQ. 2) NJEV = NJEV + 1
RETURN
C
C LAST CARD OF INTERFACE SUBROUTINE FCN.
C
END
SUBROUTINE VECJAC(N,X,FJAC,LDFJAC,NPROB)
INTEGER N,LDFJAC,NPROB
REAL X(N),FJAC(LDFJAC,N)
C **********
C
C SUBROUTINE VECJAC
C
C THIS SUBROUTINE DEFINES THE JACOBIAN MATRICES OF FOURTEEN
C TEST FUNCTIONS. THE PROBLEM DIMENSIONS ARE AS DESCRIBED
C IN THE PROLOGUE COMMENTS OF VECFCN.
C
C THE SUBROUTINE STATEMENT IS
C
C SUBROUTINE VECJAC(N,X,FJAC,LDFJAC,NPROB)
C
C WHERE
C
C N IS A POSITIVE INTEGER VARIABLE.
C
C X IS AN ARRAY OF LENGTH N.
C
C FJAC IS AN N BY N ARRAY. ON OUTPUT FJAC CONTAINS THE
C JACOBIAN MATRIX OF THE NPROB FUNCTION EVALUATED AT X.
C
C LDFJAC IS A POSITIVE INTEGER VARIABLE NOT LESS THAN N
C WHICH SPECIFIES THE LEADING DIMENSION OF THE ARRAY FJAC.
C
C NPROB IS A POSITIVE INTEGER VARIABLE WHICH DEFINES THE
C NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 14.
C
C SUBPROGRAMS CALLED
C
C FORTRAN-SUPPLIED ... ATAN,COS,EXP,AMIN1,SIN,SQRT,
C MAX0,MIN0
C
C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER I,IVAR,J,K,K1,K2,ML,MU
REAL C1,C3,C4,C5,C6,C9,EIGHT,FIFTN,FIVE,FOUR,H,HUNDRD,ONE,PROD,
* SIX,SUM,SUM1,SUM2,TEMP,TEMP1,TEMP2,TEMP3,TEMP4,TEN,THREE,
* TI,TJ,TK,TPI,TWENTY,TWO,ZERO
REAL FLOAT
DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,EIGHT,TEN,FIFTN,TWENTY,
* HUNDRD
* /0.0E0,1.0E0,2.0E0,3.0E0,4.0E0,5.0E0,6.0E0,8.0E0,1.0E1,
* 1.5E1,2.0E1,1.0E2/
DATA C1,C3,C4,C5,C6,C9 /1.0E4,2.0E2,2.02E1,1.98E1,1.8E2,2.9E1/
FLOAT(IVAR) = IVAR
C
C JACOBIAN ROUTINE SELECTOR.
C
GO TO (10,20,50,60,90,100,200,230,290,320,350,380,420,450),
* NPROB
C
C ROSENBROCK FUNCTION.
C
10 CONTINUE
FJAC(1,1) = -ONE
FJAC(1,2) = ZERO
FJAC(2,1) = -TWENTY*X(1)
FJAC(2,2) = TEN
GO TO 490
C
C POWELL SINGULAR FUNCTION.
C
20 CONTINUE
DO 40 K = 1, 4
DO 30 J = 1, 4
FJAC(K,J) = ZERO
30 CONTINUE
40 CONTINUE
FJAC(1,1) = ONE
FJAC(1,2) = TEN
FJAC(2,3) = SQRT(FIVE)
FJAC(2,4) = -FJAC(2,3)
FJAC(3,2) = TWO*(X(2) - TWO*X(3))
FJAC(3,3) = -TWO*FJAC(3,2)
FJAC(4,1) = TWO*SQRT(TEN)*(X(1) - X(4))
FJAC(4,4) = -FJAC(4,1)
GO TO 490
C
C POWELL BADLY SCALED FUNCTION.
C
50 CONTINUE
FJAC(1,1) = C1*X(2)
FJAC(1,2) = C1*X(1)
FJAC(2,1) = -EXP(-X(1))
FJAC(2,2) = -EXP(-X(2))
GO TO 490
C
C WOOD FUNCTION.
C
60 CONTINUE
DO 80 K = 1, 4
DO 70 J = 1, 4
FJAC(K,J) = ZERO
70 CONTINUE
80 CONTINUE
TEMP1 = X(2) - THREE*X(1)**2
TEMP2 = X(4) - THREE*X(3)**2
FJAC(1,1) = -C3*TEMP1 + ONE
FJAC(1,2) = -C3*X(1)
FJAC(2,1) = -TWO*C3*X(1)
FJAC(2,2) = C3 + C4
FJAC(2,4) = C5
FJAC(3,3) = -C6*TEMP2 + ONE
FJAC(3,4) = -C6*X(3)
FJAC(4,2) = C5
FJAC(4,3) = -TWO*C6*X(3)
FJAC(4,4) = C6 + C4
GO TO 490
C
C HELICAL VALLEY FUNCTION.
C
90 CONTINUE
TPI = EIGHT*ATAN(ONE)
TEMP = X(1)**2 + X(2)**2
TEMP1 = TPI*TEMP
TEMP2 = SQRT(TEMP)
FJAC(1,1) = HUNDRD*X(2)/TEMP1
FJAC(1,2) = -HUNDRD*X(1)/TEMP1
FJAC(1,3) = TEN
FJAC(2,1) = TEN*X(1)/TEMP2
FJAC(2,2) = TEN*X(2)/TEMP2
FJAC(2,3) = ZERO
FJAC(3,1) = ZERO
FJAC(3,2) = ZERO
FJAC(3,3) = ONE
GO TO 490
C
C WATSON FUNCTION.
C
100 CONTINUE
DO 120 K = 1, N
DO 110 J = K, N
FJAC(K,J) = ZERO
110 CONTINUE
120 CONTINUE
DO 170 I = 1, 29
TI = FLOAT(I)/C9
SUM1 = ZERO
TEMP = ONE
DO 130 J = 2, N
SUM1 = SUM1 + FLOAT(J-1)*TEMP*X(J)
TEMP = TI*TEMP
130 CONTINUE
SUM2 = ZERO
TEMP = ONE
DO 140 J = 1, N
SUM2 = SUM2 + TEMP*X(J)
TEMP = TI*TEMP
140 CONTINUE
TEMP1 = TWO*(SUM1 - SUM2**2 - ONE)
TEMP2 = TWO*SUM2
TEMP = TI**2
TK = ONE
DO 160 K = 1, N
TJ = TK
DO 150 J = K, N
FJAC(K,J) = FJAC(K,J)
* + TJ
* *((FLOAT(K-1)/TI - TEMP2)
* *(FLOAT(J-1)/TI - TEMP2) - TEMP1)
TJ = TI*TJ
150 CONTINUE
TK = TEMP*TK
160 CONTINUE
170 CONTINUE
FJAC(1,1) = FJAC(1,1) + SIX*X(1)**2 - TWO*X(2) + THREE
FJAC(1,2) = FJAC(1,2) - TWO*X(1)
FJAC(2,2) = FJAC(2,2) + ONE
DO 190 K = 1, N
DO 180 J = K, N
FJAC(J,K) = FJAC(K,J)
180 CONTINUE
190 CONTINUE
GO TO 490
C
C CHEBYQUAD FUNCTION.
C
200 CONTINUE
TK = ONE/FLOAT(N)
DO 220 J = 1, N
TEMP1 = ONE
TEMP2 = TWO*X(J) - ONE
TEMP = TWO*TEMP2
TEMP3 = ZERO
TEMP4 = TWO
DO 210 K = 1, N
FJAC(K,J) = TK*TEMP4
TI = FOUR*TEMP2 + TEMP*TEMP4 - TEMP3
TEMP3 = TEMP4
TEMP4 = TI
TI = TEMP*TEMP2 - TEMP1
TEMP1 = TEMP2
TEMP2 = TI
210 CONTINUE
220 CONTINUE
GO TO 490
C
C BROWN ALMOST-LINEAR FUNCTION.
C
230 CONTINUE
PROD = ONE
DO 250 J = 1, N
PROD = X(J)*PROD
DO 240 K = 1, N
FJAC(K,J) = ONE
240 CONTINUE
FJAC(J,J) = TWO
250 CONTINUE
DO 280 J = 1, N
TEMP = X(J)
IF (TEMP .NE. ZERO) GO TO 270
TEMP = ONE
PROD = ONE
DO 260 K = 1, N
IF (K .NE. J) PROD = X(K)*PROD
260 CONTINUE
270 CONTINUE
FJAC(N,J) = PROD/TEMP
280 CONTINUE
GO TO 490
C
C DISCRETE BOUNDARY VALUE FUNCTION.
C
290 CONTINUE
H = ONE/FLOAT(N+1)
DO 310 K = 1, N
TEMP = THREE*(X(K) + FLOAT(K)*H + ONE)**2
DO 300 J = 1, N
FJAC(K,J) = ZERO
300 CONTINUE
FJAC(K,K) = TWO + TEMP*H**2/TWO
IF (K .NE. 1) FJAC(K,K-1) = -ONE
IF (K .NE. N) FJAC(K,K+1) = -ONE
310 CONTINUE
GO TO 490
C
C DISCRETE INTEGRAL EQUATION FUNCTION.
C
320 CONTINUE
H = ONE/FLOAT(N+1)
DO 340 K = 1, N
TK = FLOAT(K)*H
DO 330 J = 1, N
TJ = FLOAT(J)*H
TEMP = THREE*(X(J) + TJ + ONE)**2
FJAC(K,J) = H*AMIN1(TJ*(ONE-TK),TK*(ONE-TJ))*TEMP/TWO
330 CONTINUE
FJAC(K,K) = FJAC(K,K) + ONE
340 CONTINUE
GO TO 490
C
C TRIGONOMETRIC FUNCTION.
C
350 CONTINUE
DO 370 J = 1, N
TEMP = SIN(X(J))
DO 360 K = 1, N
FJAC(K,J) = TEMP
360 CONTINUE
FJAC(J,J) = FLOAT(J+1)*TEMP - COS(X(J))
370 CONTINUE
GO TO 490
C
C VARIABLY DIMENSIONED FUNCTION.
C
380 CONTINUE
SUM = ZERO
DO 390 J = 1, N
SUM = SUM + FLOAT(J)*(X(J) - ONE)
390 CONTINUE
TEMP = ONE + SIX*SUM**2
DO 410 K = 1, N
DO 400 J = K, N
FJAC(K,J) = FLOAT(K*J)*TEMP
FJAC(J,K) = FJAC(K,J)
400 CONTINUE
FJAC(K,K) = FJAC(K,K) + ONE
410 CONTINUE
GO TO 490
C
C BROYDEN TRIDIAGONAL FUNCTION.
C
420 CONTINUE
DO 440 K = 1, N
DO 430 J = 1, N
FJAC(K,J) = ZERO
430 CONTINUE
FJAC(K,K) = THREE - FOUR*X(K)
IF (K .NE. 1) FJAC(K,K-1) = -ONE
IF (K .NE. N) FJAC(K,K+1) = -TWO
440 CONTINUE
GO TO 490
C
C BROYDEN BANDED FUNCTION.
C
450 CONTINUE
ML = 5
MU = 1
DO 480 K = 1, N
DO 460 J = 1, N
FJAC(K,J) = ZERO
460 CONTINUE
K1 = MAX0(1,K-ML)
K2 = MIN0(K+MU,N)
DO 470 J = K1, K2
IF (J .NE. K) FJAC(K,J) = -(ONE + TWO*X(J))
470 CONTINUE
FJAC(K,K) = TWO + FIFTN*X(K)**2
480 CONTINUE
490 CONTINUE
RETURN
C
C LAST CARD OF SUBROUTINE VECJAC.
C
END
SUBROUTINE INITPT(N,X,NPROB,FACTOR)
INTEGER N,NPROB
REAL FACTOR
REAL X(N)
C **********
C
C SUBROUTINE INITPT
C
C THIS SUBROUTINE SPECIFIES THE STANDARD STARTING POINTS FOR
C THE FUNCTIONS DEFINED BY SUBROUTINE VECFCN. THE SUBROUTINE
C RETURNS IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING
C POINT. FOR THE SIXTH FUNCTION THE STANDARD STARTING POINT IS
C ZERO, SO IN THIS CASE, IF FACTOR IS NOT UNITY, THEN THE
C SUBROUTINE RETURNS THE VECTOR X(J) = FACTOR, J=1,...,N.
C
C THE SUBROUTINE STATEMENT IS
C
C SUBROUTINE INITPT(N,X,NPROB,FACTOR)
C
C WHERE
C
C N IS A POSITIVE INTEGER INPUT VARIABLE.
C
C X IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE STANDARD
C STARTING POINT FOR PROBLEM NPROB MULTIPLIED BY FACTOR.
C
C NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 14.
C
C FACTOR IS AN INPUT VARIABLE WHICH SPECIFIES THE MULTIPLE OF
C THE STANDARD STARTING POINT. IF FACTOR IS UNITY, NO
C MULTIPLICATION IS PERFORMED.
C
C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER IVAR,J
REAL C1,H,HALF,ONE,THREE,TJ,ZERO
REAL FLOAT
DATA ZERO,HALF,ONE,THREE,C1 /0.0E0,5.0E-1,1.0E0,3.0E0,1.2E0/
FLOAT(IVAR) = IVAR
C
C SELECTION OF INITIAL POINT.
C
GO TO (10,20,30,40,50,60,80,100,120,120,140,160,180,180), NPROB
C
C ROSENBROCK FUNCTION.
C
10 CONTINUE
X(1) = -C1
X(2) = ONE
GO TO 200
C
C POWELL SINGULAR FUNCTION.
C
20 CONTINUE
X(1) = THREE
X(2) = -ONE
X(3) = ZERO
X(4) = ONE
GO TO 200
C
C POWELL BADLY SCALED FUNCTION.
C
30 CONTINUE
X(1) = ZERO
X(2) = ONE
GO TO 200
C
C WOOD FUNCTION.
C
40 CONTINUE
X(1) = -THREE
X(2) = -ONE
X(3) = -THREE
X(4) = -ONE
GO TO 200
C
C HELICAL VALLEY FUNCTION.
C
50 CONTINUE
X(1) = -ONE
X(2) = ZERO
X(3) = ZERO
GO TO 200
C
C WATSON FUNCTION.
C
60 CONTINUE
DO 70 J = 1, N
X(J) = ZERO
70 CONTINUE
GO TO 200
C
C CHEBYQUAD FUNCTION.
C
80 CONTINUE
H = ONE/FLOAT(N+1)
DO 90 J = 1, N
X(J) = FLOAT(J)*H
90 CONTINUE
GO TO 200
C
C BROWN ALMOST-LINEAR FUNCTION.
C
100 CONTINUE
DO 110 J = 1, N
X(J) = HALF
110 CONTINUE
GO TO 200
C
C DISCRETE BOUNDARY VALUE AND INTEGRAL EQUATION FUNCTIONS.
C
120 CONTINUE
H = ONE/FLOAT(N+1)
DO 130 J = 1, N
TJ = FLOAT(J)*H
X(J) = TJ*(TJ - ONE)
130 CONTINUE
GO TO 200
C
C TRIGONOMETRIC FUNCTION.
C
140 CONTINUE
H = ONE/FLOAT(N)
DO 150 J = 1, N
X(J) = H
150 CONTINUE
GO TO 200
C
C VARIABLY DIMENSIONED FUNCTION.
C
160 CONTINUE
H = ONE/FLOAT(N)
DO 170 J = 1, N
X(J) = ONE - FLOAT(J)*H
170 CONTINUE
GO TO 200
C
C BROYDEN TRIDIAGONAL AND BANDED FUNCTIONS.
C
180 CONTINUE
DO 190 J = 1, N
X(J) = -ONE
190 CONTINUE
200 CONTINUE
C
C COMPUTE MULTIPLE OF INITIAL POINT.
C
IF (FACTOR .EQ. ONE) GO TO 250
IF (NPROB .EQ. 6) GO TO 220
DO 210 J = 1, N
X(J) = FACTOR*X(J)
210 CONTINUE
GO TO 240
220 CONTINUE
DO 230 J = 1, N
X(J) = FACTOR
230 CONTINUE
240 CONTINUE
250 CONTINUE
RETURN
C
C LAST CARD OF SUBROUTINE INITPT.
C
END
SUBROUTINE VECFCN(N,X,FVEC,NPROB)
INTEGER N,NPROB
REAL X(N),FVEC(N)
C **********
C
C SUBROUTINE VECFCN
C
C THIS SUBROUTINE DEFINES FOURTEEN TEST FUNCTIONS. THE FIRST
C FIVE TEST FUNCTIONS ARE OF DIMENSIONS 2,4,2,4,3, RESPECTIVELY,
C WHILE THE REMAINING TEST FUNCTIONS ARE OF VARIABLE DIMENSION
C N FOR ANY N GREATER THAN OR EQUAL TO 1 (PROBLEM 6 IS AN
C EXCEPTION TO THIS, SINCE IT DOES NOT ALLOW N = 1).
C
C THE SUBROUTINE STATEMENT IS
C
C SUBROUTINE VECFCN(N,X,FVEC,NPROB)
C
C WHERE
C
C N IS A POSITIVE INTEGER INPUT VARIABLE.
C
C X IS AN INPUT ARRAY OF LENGTH N.
C
C FVEC IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE NPROB
C FUNCTION VECTOR EVALUATED AT X.
C
C NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 14.
C
C SUBPROGRAMS CALLED
C
C FORTRAN-SUPPLIED ... ATAN,COS,EXP,SIGN,SIN,SQRT,
C MAX0,MIN0
C
C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER I,IEV,IVAR,J,K,K1,K2,KP1,ML,MU
REAL C1,C2,C3,C4,C5,C6,C7,C8,C9,EIGHT,FIVE,H,ONE,PROD,SUM,SUM1,
* SUM2,TEMP,TEMP1,TEMP2,TEN,THREE,TI,TJ,TK,TPI,TWO,ZERO
REAL FLOAT
DATA ZERO,ONE,TWO,THREE,FIVE,EIGHT,TEN
* /0.0E0,1.0E0,2.0E0,3.0E0,5.0E0,8.0E0,1.0E1/
DATA C1,C2,C3,C4,C5,C6,C7,C8,C9
* /1.0E4,1.0001E0,2.0E2,2.02E1,1.98E1,1.8E2,2.5E-1,5.0E-1,
* 2.9E1/
FLOAT(IVAR) = IVAR
C
C PROBLEM SELECTOR.
C
GO TO (10,20,30,40,50,60,120,170,200,220,270,300,330,350), NPROB
C
C ROSENBROCK FUNCTION.
C
10 CONTINUE
FVEC(1) = ONE - X(1)
FVEC(2) = TEN*(X(2) - X(1)**2)
GO TO 380
C
C POWELL SINGULAR FUNCTION.
C
20 CONTINUE
FVEC(1) = X(1) + TEN*X(2)
FVEC(2) = SQRT(FIVE)*(X(3) - X(4))
FVEC(3) = (X(2) - TWO*X(3))**2
FVEC(4) = SQRT(TEN)*(X(1) - X(4))**2
GO TO 380
C
C POWELL BADLY SCALED FUNCTION.
C
30 CONTINUE
FVEC(1) = C1*X(1)*X(2) - ONE
FVEC(2) = EXP(-X(1)) + EXP(-X(2)) - C2
GO TO 380
C
C WOOD FUNCTION.
C
40 CONTINUE
TEMP1 = X(2) - X(1)**2
TEMP2 = X(4) - X(3)**2
FVEC(1) = -C3*X(1)*TEMP1 - (ONE - X(1))
FVEC(2) = C3*TEMP1 + C4*(X(2) - ONE) + C5*(X(4) - ONE)
FVEC(3) = -C6*X(3)*TEMP2 - (ONE - X(3))
FVEC(4) = C6*TEMP2 + C4*(X(4) - ONE) + C5*(X(2) - ONE)
GO TO 380
C
C HELICAL VALLEY FUNCTION.
C
50 CONTINUE
TPI = EIGHT*ATAN(ONE)
TEMP1 = SIGN(C7,X(2))
IF (X(1) .GT. ZERO) TEMP1 = ATAN(X(2)/X(1))/TPI
IF (X(1) .LT. ZERO) TEMP1 = ATAN(X(2)/X(1))/TPI + C8
TEMP2 = SQRT(X(1)**2+X(2)**2)
FVEC(1) = TEN*(X(3) - TEN*TEMP1)
FVEC(2) = TEN*(TEMP2 - ONE)
FVEC(3) = X(3)
GO TO 380
C
C WATSON FUNCTION.
C
60 CONTINUE
DO 70 K = 1, N
FVEC(K) = ZERO
70 CONTINUE
DO 110 I = 1, 29
TI = FLOAT(I)/C9
SUM1 = ZERO
TEMP = ONE
DO 80 J = 2, N
SUM1 = SUM1 + FLOAT(J-1)*TEMP*X(J)
TEMP = TI*TEMP
80 CONTINUE
SUM2 = ZERO
TEMP = ONE
DO 90 J = 1, N
SUM2 = SUM2 + TEMP*X(J)
TEMP = TI*TEMP
90 CONTINUE
TEMP1 = SUM1 - SUM2**2 - ONE
TEMP2 = TWO*TI*SUM2
TEMP = ONE/TI
DO 100 K = 1, N
FVEC(K) = FVEC(K) + TEMP*(FLOAT(K-1) - TEMP2)*TEMP1
TEMP = TI*TEMP
100 CONTINUE
110 CONTINUE
TEMP = X(2) - X(1)**2 - ONE
FVEC(1) = FVEC(1) + X(1)*(ONE - TWO*TEMP)
FVEC(2) = FVEC(2) + TEMP
GO TO 380
C
C CHEBYQUAD FUNCTION.
C
120 CONTINUE
DO 130 K = 1, N
FVEC(K) = ZERO
130 CONTINUE
DO 150 J = 1, N
TEMP1 = ONE
TEMP2 = TWO*X(J) - ONE
TEMP = TWO*TEMP2
DO 140 I = 1, N
FVEC(I) = FVEC(I) + TEMP2
TI = TEMP*TEMP2 - TEMP1
TEMP1 = TEMP2
TEMP2 = TI
140 CONTINUE
150 CONTINUE
TK = ONE/FLOAT(N)
IEV = -1
DO 160 K = 1, N
FVEC(K) = TK*FVEC(K)
IF (IEV .GT. 0) FVEC(K) = FVEC(K) + ONE/(FLOAT(K)**2 - ONE)
IEV = -IEV
160 CONTINUE
GO TO 380
C
C BROWN ALMOST-LINEAR FUNCTION.
C
170 CONTINUE
SUM = -FLOAT(N+1)
PROD = ONE
DO 180 J = 1, N
SUM = SUM + X(J)
PROD = X(J)*PROD
180 CONTINUE
DO 190 K = 1, N
FVEC(K) = X(K) + SUM
190 CONTINUE
FVEC(N) = PROD - ONE
GO TO 380
C
C DISCRETE BOUNDARY VALUE FUNCTION.
C
200 CONTINUE
H = ONE/FLOAT(N+1)
DO 210 K = 1, N
TEMP = (X(K) + FLOAT(K)*H + ONE)**3
TEMP1 = ZERO
IF (K .NE. 1) TEMP1 = X(K-1)
TEMP2 = ZERO
IF (K .NE. N) TEMP2 = X(K+1)
FVEC(K) = TWO*X(K) - TEMP1 - TEMP2 + TEMP*H**2/TWO
210 CONTINUE
GO TO 380
C
C DISCRETE INTEGRAL EQUATION FUNCTION.
C
220 CONTINUE
H = ONE/FLOAT(N+1)
DO 260 K = 1, N
TK = FLOAT(K)*H
SUM1 = ZERO
DO 230 J = 1, K
TJ = FLOAT(J)*H
TEMP = (X(J) + TJ + ONE)**3
SUM1 = SUM1 + TJ*TEMP
230 CONTINUE
SUM2 = ZERO
KP1 = K + 1
IF (N .LT. KP1) GO TO 250
DO 240 J = KP1, N
TJ = FLOAT(J)*H
TEMP = (X(J) + TJ + ONE)**3
SUM2 = SUM2 + (ONE - TJ)*TEMP
240 CONTINUE
250 CONTINUE
FVEC(K) = X(K) + H*((ONE - TK)*SUM1 + TK*SUM2)/TWO
260 CONTINUE
GO TO 380
C
C TRIGONOMETRIC FUNCTION.
C
270 CONTINUE
SUM = ZERO
DO 280 J = 1, N
FVEC(J) = COS(X(J))
SUM = SUM + FVEC(J)
280 CONTINUE
DO 290 K = 1, N
FVEC(K) = FLOAT(N+K) - SIN(X(K)) - SUM - FLOAT(K)*FVEC(K)
290 CONTINUE
GO TO 380
C
C VARIABLY DIMENSIONED FUNCTION.
C
300 CONTINUE
SUM = ZERO
DO 310 J = 1, N
SUM = SUM + FLOAT(J)*(X(J) - ONE)
310 CONTINUE
TEMP = SUM*(ONE + TWO*SUM**2)
DO 320 K = 1, N
FVEC(K) = X(K) - ONE + FLOAT(K)*TEMP
320 CONTINUE
GO TO 380
C
C BROYDEN TRIDIAGONAL FUNCTION.
C
330 CONTINUE
DO 340 K = 1, N
TEMP = (THREE - TWO*X(K))*X(K)
TEMP1 = ZERO
IF (K .NE. 1) TEMP1 = X(K-1)
TEMP2 = ZERO
IF (K .NE. N) TEMP2 = X(K+1)
FVEC(K) = TEMP - TEMP1 - TWO*TEMP2 + ONE
340 CONTINUE
GO TO 380
C
C BROYDEN BANDED FUNCTION.
C
350 CONTINUE
ML = 5
MU = 1
DO 370 K = 1, N
K1 = MAX0(1,K-ML)
K2 = MIN0(K+MU,N)
TEMP = ZERO
DO 360 J = K1, K2
IF (J .NE. K) TEMP = TEMP + X(J)*(ONE + X(J))
360 CONTINUE
FVEC(K) = X(K)*(TWO + FIVE*X(K)**2) + ONE - TEMP
370 CONTINUE
380 CONTINUE
RETURN
C
C LAST CARD OF SUBROUTINE VECFCN.
C
END