C     **********
C
C     THIS PROGRAM TESTS THE ABILITY OF CHKDER TO DETECT
C     INCONSISTENCIES BETWEEN FUNCTIONS AND THEIR FIRST DERIVATIVES.
C     FOURTEEN TEST FUNCTION VECTORS AND JACOBIANS ARE USED. ELEVEN OF
C     THE TESTS ARE FALSE(F), I.E. THERE ARE INCONSISTENCIES BETWEEN
C     THE FUNCTION VECTORS AND THE CORRESPONDING JACOBIANS. THREE OF
C     THE TESTS ARE TRUE(T), I.E. THERE ARE NO INCONSISTENCIES. THE
C     DRIVER READS IN DATA, CALLS CHKDER AND PRINTS OUT INFORMATION
C     REQUIRED BY AND RECEIVED FROM CHKDER.
C
C     SUBPROGRAMS CALLED
C
C       MINPACK SUPPLIED ... CHKDER,ERRJAC,INITPT,VECFCN
C
C     ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,LDFJAC,LNP,MODE,N,NPROB,NREAD,NWRITE
      INTEGER NA(14),NP(14)
      LOGICAL A(14)
      DOUBLE PRECISION CP,ONE
      DOUBLE PRECISION DIFF(10),ERR(10),ERRMAX(14),ERRMIN(14),
     *                 FJAC(10,10),FVEC1(10),FVEC2(10),X1(10),X2(10)
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 A(1),A(2),A(3),A(4),A(5),A(6),A(7),A(8),A(9),A(10),A(11),
     *     A(12),A(13),A(14)
     *     /.FALSE.,.FALSE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.,.FALSE.,
     *      .TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE.,.FALSE./
      DATA CP,ONE /1.23D-1,1.0D0/
      LDFJAC = 10
   10 CONTINUE
         READ (NREAD,60) NPROB,N
         IF (NPROB .LE. 0) GO TO 40
         CALL INITPT(N,X1,NPROB,ONE)
         DO 20 I = 1, N
            X1(I) = X1(I) + CP
            CP = -CP
   20       CONTINUE
         WRITE (NWRITE,70) NPROB,N,A(NPROB)
         MODE = 1
         CALL CHKDER(N,N,X1,FVEC1,FJAC,LDFJAC,X2,FVEC2,MODE,ERR)
         MODE = 2
         CALL VECFCN(N,X1,FVEC1,NPROB)
         CALL ERRJAC(N,X1,FJAC,LDFJAC,NPROB)
         CALL VECFCN(N,X2,FVEC2,NPROB)
         CALL CHKDER(N,N,X1,FVEC1,FJAC,LDFJAC,X2,FVEC2,MODE,ERR)
         ERRMIN(NPROB) = ERR(1)
         ERRMAX(NPROB) = ERR(1)
         DO 30 I = 1, N
            DIFF(I) = FVEC2(I) - FVEC1(I)
            IF (ERRMIN(NPROB) .GT. ERR(I)) ERRMIN(NPROB) = ERR(I)
            IF (ERRMAX(NPROB) .LT. ERR(I)) ERRMAX(NPROB) = ERR(I)
   30       CONTINUE
         NP(NPROB) = NPROB
         LNP = NPROB
         NA(NPROB) = N
         WRITE (NWRITE,80) (FVEC1(I), I = 1, N)
         WRITE (NWRITE,90) (DIFF(I), I = 1, N)
         WRITE (NWRITE,100) (ERR(I), I = 1, N)
         GO TO 10
   40 CONTINUE
      WRITE (NWRITE,110) LNP
      WRITE (NWRITE,120)
      DO 50 I = 1, LNP
         WRITE (NWRITE,130) NP(I),NA(I),A(I),ERRMIN(I),ERRMAX(I)
   50    CONTINUE
      STOP
   60 FORMAT (2I5)
   70 FORMAT ( /// 5X, 8H PROBLEM, I5, 5X, 15H WITH DIMENSION, I5, 2X,
     *         5H IS  , L1)
   80 FORMAT ( // 5X, 25H FIRST FUNCTION VECTOR    // (5X, 5D15.7))
   90 FORMAT ( // 5X, 27H FUNCTION DIFFERENCE VECTOR // (5X, 5D15.7))
  100 FORMAT ( // 5X, 13H ERROR VECTOR // (5X, 5D15.7))
  110 FORMAT (12H1SUMMARY OF , I3, 16H TESTS OF CHKDER /)
  120 FORMAT (46H NPROB   N    STATUS     ERRMIN         ERRMAX /)
  130 FORMAT (I4, I6, 6X, L1, 3X, 2D15.7)
C
C     LAST CARD OF DERIVATIVE CHECK TEST DRIVER.
C
      END
      SUBROUTINE ERRJAC(N,X,FJAC,LDFJAC,NPROB)
      INTEGER N,LDFJAC,NPROB
      DOUBLE PRECISION X(N),FJAC(LDFJAC,N)
C     **********
C
C     SUBROUTINE ERRJAC
C
C     THIS SUBROUTINE IS DERIVED FROM VECJAC WHICH DEFINES THE
C     JACOBIAN MATRICES OF FOURTEEN TEST FUNCTIONS. THE PROBLEM
C     DIMENSIONS ARE AS DESCRIBED IN THE PROLOGUE COMMENTS OF VECFCN.
C     VARIOUS ERRORS ARE DELIBERATELY INTRODUCED TO PROVIDE A TEST
C     FOR CHKDER.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE ERRJAC(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, WITH VARIOUS ERRORS DELIBERATELY
C         INTRODUCED, 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 ... DATAN,DCOS,DEXP,DMIN1,DSIN,DSQRT,
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
      DOUBLE PRECISION 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
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,EIGHT,TEN,FIFTN,TWENTY,
     *     HUNDRD
     *     /0.0D0,1.0D0,2.0D0,3.0D0,4.0D0,5.0D0,6.0D0,8.0D0,1.0D1,
     *      1.5D1,2.0D1,1.0D2/
      DATA C1,C3,C4,C5,C6,C9 /1.0D4,2.0D2,2.02D1,1.98D1,1.8D2,2.9D1/
      DFLOAT(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 WITH SIGN REVERSAL AFFECTING ELEMENT (1,1).
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 WITH SIGN REVERSAL AFFECTING ELEMENT
C     (3,3).
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) = DSQRT(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*DSQRT(TEN)*(X(1) - X(4))
      FJAC(4,4) = -FJAC(4,1)
      GO TO 490
C
C     POWELL BADLY SCALED FUNCTION WITH THE SIGN OF THE JACOBIAN
C     REVERSED.
C
   50 CONTINUE
      FJAC(1,1) = -C1*X(2)
      FJAC(1,2) = -C1*X(1)
      FJAC(2,1) = DEXP(-X(1))
      FJAC(2,2) = DEXP(-X(2))
      GO TO 490
C
C     WOOD FUNCTION WITHOUT ERROR.
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 WITH MULTIPLICATIVE ERROR AFFECTING
C     ELEMENTS (2,1) AND (2,2).
C
   90 CONTINUE
      TPI = EIGHT*DATAN(ONE)
      TEMP = X(1)**2 + X(2)**2
      TEMP1 = TPI*TEMP
      TEMP2 = DSQRT(TEMP)
      FJAC(1,1) = HUNDRD*X(2)/TEMP1
      FJAC(1,2) = -HUNDRD*X(1)/TEMP1
      FJAC(1,3) = TEN
      FJAC(2,1) = FIVE*X(1)/TEMP2
      FJAC(2,2) = FIVE*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 WITH SIGN REVERSALS AFFECTING THE COMPUTATION OF
C     TEMP1.
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 = DFLOAT(I)/C9
         SUM1 = ZERO
         TEMP = ONE
         DO 130 J = 2, N
            SUM1 = SUM1 + DFLOAT(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
     *                       *((DFLOAT(K-1)/TI - TEMP2)
     *                         *(DFLOAT(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 WITH JACOBIAN TWICE CORRECT SIZE.
C
  200 CONTINUE
      TK = ONE/DFLOAT(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) = TWO*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 WITHOUT ERROR.
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 WITH MULTIPLICATIVE ERROR
C     AFFECTING THE JACOBIAN DIAGONAL.
C
  290 CONTINUE
      H = ONE/DFLOAT(N+1)
      DO 310 K = 1, N
         TEMP = THREE*(X(K) + DFLOAT(K)*H + ONE)**2
         DO 300 J = 1, N
            FJAC(K,J) = ZERO
  300       CONTINUE
         FJAC(K,K) = FOUR + TEMP*H**2
         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 WITH SIGN ERROR AFFECTING
C     THE JACOBIAN DIAGONAL.
C
  320 CONTINUE
      H = ONE/DFLOAT(N+1)
      DO 340 K = 1, N
         TK = DFLOAT(K)*H
         DO 330 J = 1, N
            TJ = DFLOAT(J)*H
            TEMP = THREE*(X(J) + TJ + ONE)**2
            FJAC(K,J) = H*DMIN1(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 WITH SIGN ERRORS AFFECTING THE
C     OFFDIAGONAL ELEMENTS OF THE JACOBIAN.
C
  350 CONTINUE
      DO 370 J = 1, N
         TEMP = DSIN(X(J))
         DO 360 K = 1, N
            FJAC(K,J) = -TEMP
  360       CONTINUE
         FJAC(J,J) = DFLOAT(J+1)*TEMP - DCOS(X(J))
  370    CONTINUE
      GO TO 490
C
C     VARIABLY DIMENSIONED FUNCTION WITH OPERATION ERROR AFFECTING
C     THE UPPER TRIANGULAR ELEMENTS OF THE JACOBIAN.
C
  380 CONTINUE
      SUM = ZERO
      DO 390 J = 1, N
         SUM = SUM + DFLOAT(J)*(X(J) - ONE)
  390    CONTINUE
      TEMP = ONE + SIX*SUM**2
      DO 410 K = 1, N
         DO 400 J = K, N
            FJAC(K,J) = DFLOAT(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 WITHOUT ERROR.
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 WITH SIGN ERROR AFFECTING THE JACOBIAN
C     DIAGONAL.
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 ERRJAC.
C
      END
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)
      INTEGER N,NPROB
      DOUBLE PRECISION FACTOR
      DOUBLE PRECISION 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
      DOUBLE PRECISION C1,H,HALF,ONE,THREE,TJ,ZERO
      DOUBLE PRECISION DFLOAT
      DATA ZERO,HALF,ONE,THREE,C1 /0.0D0,5.0D-1,1.0D0,3.0D0,1.2D0/
      DFLOAT(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/DFLOAT(N+1)
      DO 90 J = 1, N
         X(J) = DFLOAT(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/DFLOAT(N+1)
      DO 130 J = 1, N
         TJ = DFLOAT(J)*H
         X(J) = TJ*(TJ - ONE)
  130    CONTINUE
      GO TO 200
C
C     TRIGONOMETRIC FUNCTION.
C
  140 CONTINUE
      H = ONE/DFLOAT(N)
      DO 150 J = 1, N
         X(J) = H
  150    CONTINUE
      GO TO 200
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  160 CONTINUE
      H = ONE/DFLOAT(N)
      DO 170 J = 1, N
         X(J) = ONE - DFLOAT(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
      DOUBLE PRECISION 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 ... DATAN,DCOS,DEXP,DSIGN,DSIN,DSQRT,
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
      DOUBLE PRECISION 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
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FIVE,EIGHT,TEN
     *     /0.0D0,1.0D0,2.0D0,3.0D0,5.0D0,8.0D0,1.0D1/
      DATA C1,C2,C3,C4,C5,C6,C7,C8,C9
     *     /1.0D4,1.0001D0,2.0D2,2.02D1,1.98D1,1.8D2,2.5D-1,5.0D-1,
     *      2.9D1/
      DFLOAT(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) = DSQRT(FIVE)*(X(3) - X(4))
      FVEC(3) = (X(2) - TWO*X(3))**2
      FVEC(4) = DSQRT(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) = DEXP(-X(1)) + DEXP(-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*DATAN(ONE)
      TEMP1 = DSIGN(C7,X(2))
      IF (X(1) .GT. ZERO) TEMP1 = DATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TEMP1 = DATAN(X(2)/X(1))/TPI + C8
      TEMP2 = DSQRT(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 = DFLOAT(I)/C9
         SUM1 = ZERO
         TEMP = ONE
         DO 80 J = 2, N
            SUM1 = SUM1 + DFLOAT(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*(DFLOAT(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/DFLOAT(N)
      IEV = -1
      DO 160 K = 1, N
         FVEC(K) = TK*FVEC(K)
         IF (IEV .GT. 0) FVEC(K) = FVEC(K) + ONE/(DFLOAT(K)**2 - ONE)
         IEV = -IEV
  160    CONTINUE
      GO TO 380
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  170 CONTINUE
      SUM = -DFLOAT(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/DFLOAT(N+1)
      DO 210 K = 1, N
         TEMP = (X(K) + DFLOAT(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/DFLOAT(N+1)
      DO 260 K = 1, N
         TK = DFLOAT(K)*H
         SUM1 = ZERO
         DO 230 J = 1, K
            TJ = DFLOAT(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 = DFLOAT(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) = DCOS(X(J))
         SUM = SUM + FVEC(J)
  280    CONTINUE
      DO 290 K = 1, N
         FVEC(K) = DFLOAT(N+K) - DSIN(X(K)) - SUM - DFLOAT(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 + DFLOAT(J)*(X(J) - ONE)
  310    CONTINUE
      TEMP = SUM*(ONE + TWO*SUM**2)
      DO 320 K = 1, N
         FVEC(K) = X(K) - ONE + DFLOAT(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
