[CONTACT]

[ABOUT]

[POLICY]

[ADVERTISE]

C ALGORITHM COLLECTED ALGORITHMS FROM

Found at: ftp.icm.edu.pl:70/packages/netlib/toms-2014-06-10/566

C      ALGORITHM 566, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 20, NO. 3, SEPTEMBER, 1994, PP. 282-285.
C ----------------------------------------------------------
C THIS FILE CONTAINS THE PROGRAMS ASSOCIATED WITH A
C REMARK SUBMITTED BY V. AVERBUKH, S. FIGUEROA & T. SCHLICK
C TO ALGORITHM 566 (J. MORE', B. GARBOW & K. HILLSTROM,
C ACM TOMS, VOL. 7, PAGES 14-41 AND 136-140, 1981).
C OUR SUPPLEMENTARY PROGRAM, HESFCN, COMPUTES THE SECOND
C DERIVATIVES OF THE 18 TEST FUNCTIONS IN ALGORITHM 566
C FOR UNCONSTRAINED NONLINEAR OPTIMIZATION.
C INCLUDED IN THIS FILE ARE THE FORTRAN PROGRAM
C SEGMENTS OF HESFCN (DOUBLE AND SINGLE PRECISION),
C TESTING PROGRAMS, AND INPUT DATA FILES (SEE BELOW).
C
C A FULL DESCRIPTION OF THE DERIVATIVE FORMULAS PROGRAMMED
C IN HESFCN IS AVAILABLE IN TECHNICAL REPORT 610, COURANT
C INSTITUTE OF MATHEMATICAL SCIENCES, COMPUTER SCIENCE
C DEPARTMENT, NEW YORK UNIVERSITY, 1992,  ENTITLED:
C
C     "HESFCN --- A FORTRAN PACKAGE OF HESSIAN
C      SUBROUTINES FOR TESTING NONLINEAR OPTIMIZATION
C      SOFTWARE".
C
C BY   VICTORIA AVERBUKH, SAMUEL FIGUEROA, AND TAMAR SCHLICK,
C
C     COURANT INSTITUE OF MATHEMATICAL SCIENCES
C     251 MERCER STREET
C     NEW YORK UNIVERSITY
C     NEW YORK,  NEW YORK   10012.
C
C     --------------------------------
C
C COMMENTS CAN BE ADDRESSED TO T. SCHLICK AT THE ADDRESS ABOVE 
C OR BY:
C
C     E-MAIL:    SCHLICK@ACFCLU.NYU.EDU,
C     PHONE:     (212) 998 - 3116, OR
C     FAX:       (212) 995 - 4121.
C
C ----------------------------------------------------------
C THERE ARE FIVE PROGRAM SEGMENTS IN THIS FILE
C (FOLLOWING THESE COMMENTS):
C
C 1. THE HESFCN ROUTINE, DOUBLE PRECISION (A SUPPLEMENT
C    TO SECTION 4 OF ALGORITHM 566)
C
C 2. THE HESFCN ROUTINES, SINGLE PRECISION (A SUPPLEMENT
C    TO SECTION 7 OF ALGORITHM 566)
C
C 3. DRIVER AND ROUTINES FOR TESTING THE SECOND DERIVATIVES
C    OF HESFCN USING TAYLOR EXPANSIONS, DOUBLE PRECISION
C
C 4. DRIVER AND ROUTINES FOR TESTING THE SECOND DERIVATIVES
C    OF HESFCN USING TAYLOR EXPANSIONS, SINGLE PRECISION.
C    NOTE: THE SINGLE PRECISION VERSION OF THE TESTING PROGRAM
C    ----  WILL PROBABLY PERFORM SATISFACTORILY ONLY ON COMPUTERS
C    SUCH AS CRAY SUPERCOMPUTERS, IN WHICH SINGLE PRECISION IS
C    CLOSER TO THE WIDTH OF MANY COMPUTERS' DOUBLE PRECISION.
C
C 5. INPUT FILE FOR TESTING HESFCN (COMMENTED).
C    TO TEST HESFCN, USE AN UNCOMMENTED VERSION OF THIS FILE
C    (INPUT UNIT 5) WITH THE TESTING PROGRAM (SEGMENTS 3 OR
C    4) AND ALGORITHM 566.
C
C ----------------------------------------------------------
C SEGMENT 1: HESFCN, DOUBLE PRECISION
C ----------------------------------------------------------
      SUBROUTINE HESFCN (N,X,HESD,HESL,NPROB)
      INTEGER N,NPROB
      DOUBLE PRECISION X(N),HESD(N),HESL(*)
C     **********
C
C     SUBROUTINE HESFCN
C
C     THIS SUBROUTINE DEFINES THE HESSIAN MATRICES OF 18
C     NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS.  THE PROBLEM
C     DIMENSIONS ARE AS DESCRIBED IN OBJFCN.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE HESFCN (N, X, HESD, HESL, 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       HESD IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE
C         DIAGONAL COMPONENTS OF THE HESSIAN MATRIX OF THE NPROB
C         OBJECTIVE FUNCTION EVALUATED AT X.
C
C       HESL IS AN OUTPUT ARRAY OF LENGTH N*(N-1)/2 WHICH CONTAINS
C         THE LOWER TRIANGULAR PART OF THE HESSIAN MATRIX OF THE
C         NPROB OBJECTIVE FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM.  NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS CALLED
C
C       FORTRAN-SUPPLIED ... ABS, ATAN, COS, EXP, LOG, SIGN, SIN,
C                            SQRT
C
C       INTEGER INLINE FUNCTION IX GIVES THE LOCATION OF A HESSIAN
C       ELEMENT (I,J), I>J, IN HESL
C
C     VICTORIA Z. AVERBUKH, SAMUEL A. FIGUEROA, AND
C     TAMAR SCHLICK, 1993.
C     **********
      INTEGER I, J, K, M, II, JJ, IX, IVAR
      DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, EIGHT,
     1      NINE, TEN, FIFTY, CP0001, CP1, CP2, CP25, CP5, C1P5, C2P25,
     2      C2P625, C3P5, C12, C19P8, C25, C29, C50, C90, C100, C120,
     3      C180, C200, C200P2, C202, C220P2, C360, C400, C1000, C1080,
     4      C1200, C2000, C20000, C2E8, C4E8, AP, BP, PI
      PARAMETER (ZERO=0.0D0, ONE=1.0D0, TWO=2.0D0, THREE=3.0D0,
     1      FOUR=4.0D0, FIVE=5.0D0, SIX=6.0D0, EIGHT=8.0D0, NINE=9.0D0,
     2      TEN=1.0D1, FIFTY=5.0D1, CP0001=1.0D-4, CP1=1.0D-1,
     3      CP2=2.0D-1, CP25=2.5D-1, CP5=5.0D-1, C1P5=1.5D0,
     4      C2P25=2.25D0, C2P625=2.625D0, C3P5=3.5D0, C12=1.2D1,
     5      C19P8=1.98D1, C25=2.5D1, C29=2.9D1, C50=5.0D1, C90=9.0D1,
     6      C100=1.0D2, C120=1.2D2, C180=1.8D2, C200=2.0D2,
     7      C200P2=2.002D2, C202=2.02D2, C220P2=2.202D2, C360=3.6D2,
     8      C400=4.0D2, C1000=1.0D3, C1080=1.08D3, C1200=1.2D3,
     9      C2000=2.0D3, C20000=2.0D4, C2E8=2.0D8, C4E8=4.0D8,
     1      AP=1.0D-5, BP=ONE, PI=3.141592653589793D0)
      DOUBLE PRECISION ARG, D1, D2, D3, LOGR, P1, P2, PIARG, PIARG2,
     1      R, R3INV, S1, S2, S3, S1S2, S1S3, S2S3, SS1, SS2,
     2      T, T1, T2, T3, TH, TT, TT1, TT2, TTH
      DOUBLE PRECISION FVEC(50), GVEC(50), Y(15)
      LOGICAL IEV
      DOUBLE PRECISION DFLOAT
      IX(II,JJ)=(II-1)*(II-2)/2+JJ

		
      DFLOAT(IVAR) = IVAR
      DATA Y /9.0D-4, 4.4D-3, 1.75D-2, 5.4D-2, 1.295D-1, 2.42D-1,
     1      3.521D-1, 3.989D-1, 3.521D-1, 2.42D-1, 1.295D-1, 5.4D-2,
     2      1.75D-2, 4.4D-3, 9.0D-4/

		
C
C     HESSIAN ROUTINE SELECTOR.
C
      GO TO (100, 200, 300, 400, 500, 600, 700, 800, 900, 1000,
     1      1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
  100 CONTINUE
C
      IF (X(1) .EQ. ZERO) THEN
         TH = SIGN(CP25,X(2))
      ELSE
         TH = ATAN(X(2)/X(1)) / (TWO*PI)
         IF (X(1) .LT. ZERO) TH = TH + CP5
      END IF
      ARG = X(1)**2 + X(2)**2
      PIARG = PI * ARG
      PIARG2 = PIARG * ARG
      R3INV = ONE / SQRT(ARG)**3
      T = X(3) - TEN*TH
      S1 = FIVE*T / PIARG
      P1 = C2000*X(1)*X(2)*T / PIARG2
      P2 = (FIVE/PIARG)**2
      HESD(1) = C200 - C200*(R3INV-P2)*X(2)**2 - P1
      HESD(2) = C200 - C200*(R3INV-P2)*X(1)**2 + P1
      HESD(3) = C202
      HESL(1) = C200*X(1)*X(2)*R3INV +
     1      C1000/PIARG2 * ( T*(X(1)**2-X(2)**2) - FIVE*X(1)*X(2)/PI )
      HESL(2) =  C1000*X(2) / PIARG
      HESL(3) = -C1000*X(1) / PIARG
      RETURN
C
C     BIGGS EXP6 FUNCTION.
C
  200 CONTINUE
      DO 210 I = 1, 6
         HESD(I) = ZERO
  210 CONTINUE
      DO 220 I = 1, 15
         HESL(I) = ZERO
  220 CONTINUE
      DO 230 I = 1, 13
         D1 = DFLOAT(I)/TEN
         D2 = EXP(-D1) - FIVE*EXP(-TEN*D1) + THREE*EXP(-FOUR*D1)
         S1 = EXP(-D1*X(1))
         S2 = EXP(-D1*X(2))
         S3 = EXP(-D1*X(5))
         T = X(3)*S1 - X(4)*S2 + X(6)*S3 - D2
         D2 = D1**2
         S1S2 = S1 * S2
         S1S3 = S1 * S3
         S2S3 = S2 * S3
         HESD(1) = HESD(1) + D2*S1*(T+X(3)*S1)
         HESD(2) = HESD(2) - D2*S2*(T-X(4)*S2)
         HESD(3) = HESD(3) + S1**2
         HESD(4) = HESD(4) + S2**2
         HESD(5) = HESD(5) + D2*S3*(T+X(6)*S3)
         HESD(6) = HESD(6) + S3**2
         HESL(1) = HESL(1) - D2*S1S2
         HESL(2) = HESL(2) - D1*S1*(T+X(3)*S1)
         HESL(3) = HESL(3) + D1*S1S2
         HESL(4) = HESL(4) + D1*S1S2
         HESL(5) = HESL(5) + D1*S2*(T-X(4)*S2)
         HESL(6) = HESL(6) - S1S2
         HESL(7) = HESL(7) + D2*S1S3
         HESL(8) = HESL(8) - D2*S2S3
         HESL(9) = HESL(9) - D1*S1S3
         HESL(10) = HESL(10) + D1*S2S3
         HESL(11) = HESL(11) - D1*S1S3
         HESL(12) = HESL(12) + D1*S2S3
         HESL(13) = HESL(13) + S1S3
         HESL(14) = HESL(14) - S2S3
         HESL(15) = HESL(15) - D1*S3*(T+X(6)*S3)
  230 CONTINUE
      HESD(1) = X(3)*HESD(1)
      HESD(2) = X(4)*HESD(2)
      HESD(5) = X(6)*HESD(5)
      HESL(1) = X(3)*X(4)*HESL(1)
      HESL(3) = X(4)*HESL(3)
      HESL(4) = X(3)*HESL(4)
      HESL(7) = X(3)*X(6)*HESL(7)
      HESL(8) = X(4)*X(6)*HESL(8)
      HESL(9) = X(6)*HESL(9)
      HESL(10) = X(6)*HESL(10)
      HESL(11) = X(3)*HESL(11)
      HESL(12) = X(4)*HESL(12)
      DO 240 I = 1, 6
         HESD(I) = TWO*HESD(I)
  240 CONTINUE
      DO 250 I = 1, 15
         HESL(I) = TWO*HESL(I)
  250 CONTINUE
      RETURN
C
C     GAUSSIAN FUNCTION.
C
  300 CONTINUE
      HESD(1) = ZERO
      HESD(2) = ZERO
      HESD(3) = ZERO
      HESL(1) = ZERO
      HESL(2) = ZERO
      HESL(3) = ZERO
      DO 310 I = 1, 15
         D1 = CP5*DFLOAT(I-1)
         D2 = C3P5 - D1 - X(3)
         ARG = CP5*X(2)*D2**2
         R = EXP(-ARG)
         T = X(1)*R - Y(I)
         T1 = TWO*X(1)*R - Y(I)
         HESD(1) = HESD(1) + R**2
         HESD(2) = HESD(2) + R*T1*D2**4
         HESD(3) = HESD(3) + R*(X(2)*T1*D2**2-T)
         HESL(1) = HESL(1) - R*T1*D2**2
         HESL(2) = HESL(2) + D2*R*T1
         HESL(3) = HESL(3) + D2*R*(T-ARG*T1)
  310 CONTINUE
      HESD(1) = TWO*HESD(1)
      HESD(2) = CP5*X(1)*HESD(2)
      HESD(3) = TWO*X(1)*X(2)*HESD(3)
      HESL(2) = TWO*X(2)*HESL(2)
      HESL(3) = TWO*X(1)*HESL(3)
      RETURN
C
C     POWELL BADLY SCALED FUNCTION.
C
  400 CONTINUE
      S1 = EXP(-X(1))
      S2 = EXP(-X(2))
      T2 = S1 + S2 - ONE - CP0001
      HESD(1) = C2E8*X(2)**2 + TWO*S1*(S1+T2)
      HESD(2) = C2E8*X(1)**2 + TWO*S2*(S2+T2)
      HESL(1) = C4E8*X(1)*X(2) + TWO*S1*S2 - C20000
      RETURN
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  500 CONTINUE
      HESD(1) = ZERO
      HESD(2) = ZERO
      HESD(3) = ZERO
      HESL(1) = ZERO
      HESL(2) = ZERO
      HESL(3) = ZERO
      DO 510 I = 1, 10
         D1 = DFLOAT(I)
         D2 = D1/TEN
         S1 = EXP(-D2*X(1))
         S2 = EXP(-D2*X(2))
         S3 = EXP(-D2) - EXP(-D1)
         T = S1 - S2 - S3*X(3)
         TH = T*D2**2
         HESD(1) = HESD(1) + TH*S1 + (D2*S1)**2
         HESD(2) = HESD(2) - TH*S2 + (D2*S2)**2
         HESD(3) = HESD(3) + S3**2
         HESL(1) = HESL(1) - S1*S2*D2**2
         HESL(2) = HESL(2) + D2*S1*S3
         HESL(3) = HESL(3) - D2*S2*S3
  510 CONTINUE
      HESD(1) = TWO*HESD(1)
      HESD(2) = TWO*HESD(2)
      HESD(3) = TWO*HESD(3)
      HESL(1) = TWO*HESL(1)
      HESL(2) = TWO*HESL(2)
      HESL(3) = TWO*HESL(3)
      RETURN
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  600 CONTINUE
      T1 = ZERO
      DO 610 J = 1, N
         T1 = T1 + DFLOAT(J)*(X(J)-ONE)
  610 CONTINUE
      T = ONE + SIX*T1**2
      M = 0
      DO 630 J = 1, N
         HESD(J) = TWO + TWO*T*DFLOAT(J)**2
         DO 620 K = 1, J-1
            M = M + 1
            HESL(M) = TWO*T*DFLOAT(J*K)
  620    CONTINUE
  630 CONTINUE
      RETURN
C
C     WATSON FUNCTION.
C
  700 CONTINUE
      DO 710 J = 1, N
         HESD(J) = ZERO
  710 CONTINUE
      DO 720 J = 1, N*(N-1)/2
         HESL(J) = ZERO
  720 CONTINUE
      DO 760 I = 1, 29
         D1 = DFLOAT(I)/C29
         D2 = ONE
         S1 = ZERO
         S2 = X(1)
         DO 730 J = 2, N
            S1 = S1 + DFLOAT(J-1)*D2*X(J)
            D2 = D1*D2
            S2 = S2 + D2*X(J)
  730    CONTINUE
         T = TWO * (S1-S2**2-ONE) * D1**2
         S3 = TWO*D1*S2
         D2 = ONE/D1
         M = 0
         DO 750 J = 1, N
            T1 = DFLOAT(J-1) - S3
            HESD(J) = HESD(J) + (T1**2-T)*D2**2
            D3 = ONE/D1
            DO 740 K = 1, J-1
               M = M + 1
               HESL(M) = HESL(M) + (T1*(DFLOAT(K-1)-S3) - T) * D2*D3
               D3 = D1*D3
  740       CONTINUE
            D2 = D1*D2
  750    CONTINUE
  760 CONTINUE
      T3 = X(2) - X(1)**2 - ONE
      HESD(1) = HESD(1) + ONE - TWO*(T3-TWO*X(1)**2)
      HESD(2) = HESD(2) + ONE
      HESL(1) = HESL(1) - TWO*X(1)
      DO 770 J = 1, N
         HESD(J) = TWO * HESD(J)
  770 CONTINUE
      DO 780 J = 1, N*(N-1)/2
         HESL(J) = TWO * HESL(J)
  780 CONTINUE
      RETURN
C
C     PENALTY FUNCTION I.
C
  800 CONTINUE
      T1 = -CP25
      DO 810 J = 1, N
         T1 = T1 + X(J)**2
  810 CONTINUE
      D1 = TWO*AP
      TH = FOUR*BP*T1
      M = 0
      DO 830 J = 1, N
         HESD(J) = D1 + TH + EIGHT*X(J)**2
         DO 820 K = 1, J-1
            M = M + 1
            HESL(M) = EIGHT*X(J)*X(K)
  820    CONTINUE
  830 CONTINUE
      RETURN
C
C     PENALTY FUNCTION II.
C
  900 CONTINUE
      T1 = -ONE
      DO 910 J = 1, N
         T1 = T1 + DFLOAT(N-J+1)*X(J)**2
  910 CONTINUE
      D1 = EXP(CP1)
      D2 = ONE
      TH = FOUR*BP*T1
      M = 0
      DO 930 J = 1, N
         HESD(J) = EIGHT*BP*(DFLOAT(N-J+1)*X(J))**2 + DFLOAT(N-J+1)*TH
         S1 = EXP(X(J)/TEN)
         IF (J .GT. 1) THEN
            S3 = S1 + S2 - D2*(D1 + ONE)
            HESD(J) = HESD(J) + AP*S1*(S3 + S1 - ONE/D1 + TWO*S1)/C50
            HESD(J-1) = HESD(J-1) + AP*S2*(S2+S3)/C50
            DO 920 K = 1, J-1
               M = M + 1
               T1 = EXP(DFLOAT(K)/TEN)
               HESL(M) = EIGHT*DFLOAT(N-J+1)*DFLOAT(N-K+1)*X(J)*X(K)
  920       CONTINUE
            HESL(M) = HESL(M) + AP*S1*S2/C50
         END IF
         S2 = S1
         D2 = D1*D2
  930 CONTINUE
      HESD(1) = HESD(1) + TWO*BP
      RETURN
C
C     BROWN BADLY SCALED FUNCTION.
C
 1000 CONTINUE
      HESD(1) = TWO + TWO*X(2)**2
      HESD(2) = TWO + TWO*X(1)**2
      HESL(1) = FOUR*X(1)*X(2) - FOUR
      RETURN
C
C     BROWN AND DENNIS FUNCTION.
C
 1100 CONTINUE
      DO 1110 I = 1, 4
         HESD(I) = ZERO
 1110 CONTINUE
      DO 1120 I = 1, 6
         HESL(I) = ZERO
 1120 CONTINUE
      DO 1130 I = 1, 20
         D1 = DFLOAT(I)/FIVE
         D2 = SIN(D1)
         T1 = X(1) + D1*X(2) - EXP(D1)
         T2 = X(3) + D2*X(4) - COS(D1)
         T = EIGHT * T1 * T2
         S1 = C12*T1**2 + FOUR*T2**2
         S2 = C12*T2**2 + FOUR*T1**2
         HESD(1) = HESD(1) + S1
         HESD(2) = HESD(2) + S1*D1**2
         HESD(3) = HESD(3) + S2
         HESD(4) = HESD(4) + S2*D2**2
         HESL(1) = HESL(1) + S1*D1
         HESL(2) = HESL(2) + T
         HESL(4) = HESL(4) + T*D2
         HESL(3) = HESL(3) + T*D1
         HESL(5) = HESL(5) + T*D1*D2
         HESL(6) = HESL(6) + S2*D2
 1130 CONTINUE
      RETURN
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
 1200 CONTINUE
      DO 1210 I = 1, 3
         HESD(I) = ZERO
         HESL(I) = ZERO
 1210 CONTINUE
      D1 = TWO/THREE
      DO 1220 I = 1, 99
         ARG = DFLOAT(I)/C100
         R = (-FIFTY*LOG(ARG))**D1+C25-X(2)
         T1 = ABS(R)**X(3)/X(1)
         T2 = EXP(-T1)
         T3 = T1 * T2 * (T1*T2+(T1-ONE)*(T2-ARG))
         T = T1 * T2 * (T2-ARG)
         LOGR = LOG(ABS(R))
         HESD(1) = HESD(1) + T3 - T
         HESD(2) = HESD(2) + (T+X(3)*T3)/R**2
         HESD(3) = HESD(3) + T3*LOGR**2
         HESL(1) = HESL(1) + T3/R
         HESL(2) = HESL(2) - T3*LOGR
         HESL(3) = HESL(3) + (T-X(3)*T3*LOGR)/R
 1220 CONTINUE
      HESD(1) = HESD(1) / X(1)**2
      HESD(2) = HESD(2) * X(3)
      HESL(1) = HESL(1) * X(3)/X(1)
      HESL(2) = HESL(2) / X(1)
      DO 1230 I = 1, 3
         HESD(I) = TWO * HESD(I)
         HESL(I) = TWO * HESL(I)
 1230 CONTINUE
      RETURN
C
C     TRIGONOMETRIC FUNCTION.
C
 1300 CONTINUE
      S1 = ZERO
      DO 1310 J = 1, N
         HESD(J) = SIN(X(J))
         S1 = S1 + COS(X(J))
 1310 CONTINUE
      S2 = ZERO
      M = 0
      DO 1330 J = 1, N
         TH = COS(X(J))
         T = DFLOAT(N+J) - HESD(J) - S1 - DFLOAT(J)*TH
         S2 = S2 + T
         DO 1320 K = 1, J-1
            M = M + 1
            HESL(M) = SIN(X(K))*(DFLOAT(N+J+K)*HESD(J)-TH) -
     *            HESD(J)*COS(X(K))
            HESL(M) = TWO*HESL(M)
 1320    CONTINUE
         HESD(J) = DFLOAT(J*(J+2)+N)*HESD(J)**2 +
     *         TH*(TH-DFLOAT(2*J+2)*HESD(J)) + T*(DFLOAT(J)*TH+HESD(J))
 1330 CONTINUE
      DO 1340 J = 1, N
         HESD(J) = TWO*(HESD(J) + COS(X(J))*S2)
 1340 CONTINUE
      RETURN
C
C     EXTENDED ROSENBROCK FUNCTION.
C
 1400 CONTINUE
      DO 1410 J = 1, N*(N-1)/2
         HESL(J) = ZERO
 1410 CONTINUE
      DO 1420 J = 1, N, 2
         HESD(J+1) = C200
         HESD(J) = C1200*X(J)**2 - C400*X(J+1) + TWO
         HESL(IX(J+1,J)) = -C400*X(J)
 1420 CONTINUE
      RETURN
C
C     EXTENDED POWELL FUNCTION.
C
 1500 CONTINUE
      DO 1510 J = 1, N*(N-1)/2
         HESL(J) = ZERO
 1510 CONTINUE
      DO 1520 J = 1, N, 4
         T2 = X(J+1) - TWO*X(J+2)
         T3 = X(J) - X(J+3)
         S1 = C12 * T2**2
         S2 = C120 * T3**2
         HESD(J) = TWO + S2
         HESD(J+1) = C200 + S1
         HESD(J+2) = TEN + FOUR*S1
         HESD(J+3) = TEN + S2
         HESL(IX(J+1,J)) = TWO*TEN
         HESL(IX(J+2,J)) = ZERO
         HESL(IX(J+2,J+1)) = -TWO*S1
         HESL(IX(J+3,J)) = -S2
         HESL(IX(J+3,J+1)) = ZERO
         HESL(IX(J+3,J+2)) = -TEN
 1520 CONTINUE
      RETURN
C
C     BEALE FUNCTION.
C
 1600 CONTINUE
      S1 = ONE - X(2)
      T1 = C1P5 - X(1)*S1
      S2 = ONE - X(2)**2
      T2 = C2P25 - X(1)*S2
      S3 = ONE - X(2)**3
      T3 = C2P625 - X(1)*S3
      HESD(1) = TWO * (S1**2 + S2**2 + S3**2)
      HESD(2) = TWO*X(1) * (X(1) + TWO*T2 + FOUR*X(1)*X(2)**2 +
     1      SIX*X(2)*T3 + NINE*X(1)*X(2)**4)
      HESL(1) = TWO*(T1-X(1)*S1) + FOUR*X(2)*(T2-X(1)*S2) +
     2      SIX*(T3-X(1)*S3)*X(2)**2
      RETURN
C
C     WOOD FUNCTION.
C
 1700 CONTINUE
      HESD(1) = C1200*X(1)**2 - C400*X(2) + TWO
      HESD(2) = C220P2
      HESD(3) = C1080*X(3)**2 - C360*X(4) + TWO
      HESD(4) = C200P2
      HESL(1) = -C400*X(1)
      HESL(2) = ZERO
      HESL(3) = ZERO
      HESL(4) = ZERO
      HESL(5) = C19P8
      HESL(6) = -C360*X(3)
      RETURN
C
C     CHEBYQUAD FUNCTION.
C
 1800 CONTINUE
      DO 1810 I = 1, N
         FVEC(I) = ZERO
 1810 CONTINUE
      DO 1830 J = 1, N
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         DO 1820 I = 1, N
            FVEC(I) = FVEC(I) + T2
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
 1820    CONTINUE
 1830 CONTINUE
      D1 = ONE/FLOAT(N)
      IEV = .FALSE.
      DO 1840 I = 1, N
         FVEC(I) = D1*FVEC(I)
         IF (IEV) FVEC(I) = FVEC(I) + ONE/(DFLOAT(I)**2 - ONE)
         IEV = .NOT. IEV
 1840 CONTINUE
      D2 = TWO*D1
      M = 0
      DO 1880 J = 1, N
         HESD(J) = FOUR*D1
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         S1 = ZERO
         S2 = TWO
         P1 = ZERO
         P2 = ZERO
         GVEC(1) = S2
         DO 1850 I = 2, N
            TH = FOUR*T2 + T*S2 - S1
            S1 = S2
            S2 = TH
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
            TH = EIGHT*S1 + T*P2 - P1
            P1 = P2
            P2 = TH
            GVEC(I) = S2
            HESD(J) = HESD(J) + FVEC(I)*TH + D1*S2**2
 1850    CONTINUE
         HESD(J) = D2*HESD(J)
         DO 1870 K = 1, J-1
            M = M + 1
            HESL(M) = ZERO
            TT1 = ONE
            TT2 = TWO*X(K) - ONE
            TT = TWO*TT2
            SS1 = ZERO
            SS2 = TWO
            DO 1860 I = 1, N
               HESL(M) = HESL(M) + SS2*GVEC(I)
               TTH = FOUR*TT2 + TT*SS2 - SS1
               SS1 = SS2
               SS2 = TTH
               TTH = TT*TT2 - TT1
               TT1 = TT2
               TT2 = TTH
 1860       CONTINUE
            HESL(M) = D2*D1*HESL(M)
 1870    CONTINUE
 1880 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE HESFCN.
C
      END
C ----------------------------------------------------------
C SEGMENT 2: HESFCN, SINGLE PRECISION
C ----------------------------------------------------------
      SUBROUTINE HESFCN (N,X,HESD,HESL,NPROB)
      INTEGER N,NPROB
      REAL X(N),HESD(N),HESL(*)
C     **********
C
C     SUBROUTINE HESFCN
C
C     THIS SUBROUTINE DEFINES THE HESSIAN MATRICES OF 18
C     NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS.  THE PROBLEM
C     DIMENSIONS ARE AS DESCRIBED IN OBJFCN.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE HESFCN (N, X, HESD, HESL, 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       HESD IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE
C         DIAGONAL COMPONENTS OF THE HESSIAN MATRIX OF THE NPROB
C         OBJECTIVE FUNCTION EVALUATED AT X.
C
C       HESL IS AN OUTPUT ARRAY OF LENGTH N*(N-1)/2 WHICH CONTAINS
C         THE LOWER TRIANGULAR PART OF THE HESSIAN MATRIX OF THE
C         NPROB OBJECTIVE FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM.  NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS CALLED
C
C       FORTRAN-SUPPLIED ... ABS, ATAN, COS, EXP, LOG, SIGN, SIN,
C                            SQRT
C
C       INTEGER INLINE FUNCTION IX GIVES THE LOCATION OF A HESSIAN
C       ELEMENT (I,J), I>J, IN HESL
C
C     VICTORIA Z. AVERBUKH, SAMUEL A. FIGUEROA, AND
C     TAMAR SCHLICK, 1993.
C     **********
      INTEGER I, J, K, M, II, JJ, IX, IVAR
      REAL ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, EIGHT,
     1      NINE, TEN, FIFTY, CP0001, CP1, CP2, CP25, CP5, C1P5, C2P25,
     2      C2P625, C3P5, C12, C19P8, C25, C29, C50, C90, C100, C120,
     3      C180, C200, C200P2, C202, C220P2, C360, C400, C1000, C1080,
     4      C1200, C2000, C20000, C2E8, C4E8, AP, BP, PI
      PARAMETER (ZERO=0.0E0, ONE=1.0E0, TWO=2.0E0, THREE=3.0E0,
     1      FOUR=4.0E0, FIVE=5.0E0, SIX=6.0E0, EIGHT=8.0E0, NINE=9.0E0,
     2      TEN=1.0E1, FIFTY=5.0E1, CP0001=1.0E-4, CP1=1.0E-1,
     3      CP2=2.0E-1, CP25=2.5E-1, CP5=5.0E-1, C1P5=1.5E0,
     4      C2P25=2.25E0, C2P625=2.625E0, C3P5=3.5E0, C12=1.2E1,
     5      C19P8=1.98E1, C25=2.5E1, C29=2.9E1, C50=5.0E1, C90=9.0E1,
     6      C100=1.0E2, C120=1.2E2, C180=1.8E2, C200=2.0E2,
     7      C200P2=2.002E2, C202=2.02E2, C220P2=2.202E2, C360=3.6E2,
     8      C400=4.0E2, C1000=1.0E3, C1080=1.08E3, C1200=1.2E3,
     9      C2000=2.0E3, C20000=2.0E4, C2E8=2.0E8, C4E8=4.0E8,
     1      AP=1.0E-5, BP=ONE, PI=3.141592653589793E0)
      REAL ARG, D1, D2, D3, LOGR, P1, P2, PIARG, PIARG2,
     1      R, R3INV, S1, S2, S3, S1S2, S1S3, S2S3, SS1, SS2,
     2      T, T1, T2, T3, TH, TT, TT1, TT2, TTH
      REAL FVEC(50), GVEC(50), Y(15)
      LOGICAL IEV
      REAL DFLOAT
      IX(II,JJ)=(II-1)*(II-2)/2+JJ

		
      DFLOAT(IVAR) = IVAR
      DATA Y /9.0E-4, 4.4E-3, 1.75E-2, 5.4E-2, 1.295E-1, 2.42E-1,
     1      3.521E-1, 3.989E-1, 3.521E-1, 2.42E-1, 1.295E-1, 5.4E-2,
     2      1.75E-2, 4.4E-3, 9.0E-4/

		
C
C     HESSIAN ROUTINE SELECTOR.
C
      GO TO (100, 200, 300, 400, 500, 600, 700, 800, 900, 1000,
     1      1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
  100 CONTINUE
C
      IF (X(1) .EQ. ZERO) THEN
         TH = SIGN(CP25,X(2))
      ELSE
         TH = ATAN(X(2)/X(1)) / (TWO*PI)
         IF (X(1) .LT. ZERO) TH = TH + CP5
      END IF
      ARG = X(1)**2 + X(2)**2
      PIARG = PI * ARG
      PIARG2 = PIARG * ARG
      R3INV = ONE / SQRT(ARG)**3
      T = X(3) - TEN*TH
      S1 = FIVE*T / PIARG
      P1 = C2000*X(1)*X(2)*T / PIARG2
      P2 = (FIVE/PIARG)**2
      HESD(1) = C200 - C200*(R3INV-P2)*X(2)**2 - P1
      HESD(2) = C200 - C200*(R3INV-P2)*X(1)**2 + P1
      HESD(3) = C202
      HESL(1) = C200*X(1)*X(2)*R3INV +
     1      C1000/PIARG2 * ( T*(X(1)**2-X(2)**2) - FIVE*X(1)*X(2)/PI )
      HESL(2) =  C1000*X(2) / PIARG
      HESL(3) = -C1000*X(1) / PIARG
      RETURN
C
C     BIGGS EXP6 FUNCTION.
C
  200 CONTINUE
      DO 210 I = 1, 6
         HESD(I) = ZERO
  210 CONTINUE
      DO 220 I = 1, 15
         HESL(I) = ZERO
  220 CONTINUE
      DO 230 I = 1, 13
         D1 = DFLOAT(I)/TEN
         D2 = EXP(-D1) - FIVE*EXP(-TEN*D1) + THREE*EXP(-FOUR*D1)
         S1 = EXP(-D1*X(1))
         S2 = EXP(-D1*X(2))
         S3 = EXP(-D1*X(5))
         T = X(3)*S1 - X(4)*S2 + X(6)*S3 - D2
         D2 = D1**2
         S1S2 = S1 * S2
         S1S3 = S1 * S3
         S2S3 = S2 * S3
         HESD(1) = HESD(1) + D2*S1*(T+X(3)*S1)
         HESD(2) = HESD(2) - D2*S2*(T-X(4)*S2)
         HESD(3) = HESD(3) + S1**2
         HESD(4) = HESD(4) + S2**2
         HESD(5) = HESD(5) + D2*S3*(T+X(6)*S3)
         HESD(6) = HESD(6) + S3**2
         HESL(1) = HESL(1) - D2*S1S2
         HESL(2) = HESL(2) - D1*S1*(T+X(3)*S1)
         HESL(3) = HESL(3) + D1*S1S2
         HESL(4) = HESL(4) + D1*S1S2
         HESL(5) = HESL(5) + D1*S2*(T-X(4)*S2)
         HESL(6) = HESL(6) - S1S2
         HESL(7) = HESL(7) + D2*S1S3
         HESL(8) = HESL(8) - D2*S2S3
         HESL(9) = HESL(9) - D1*S1S3
         HESL(10) = HESL(10) + D1*S2S3
         HESL(11) = HESL(11) - D1*S1S3
         HESL(12) = HESL(12) + D1*S2S3
         HESL(13) = HESL(13) + S1S3
         HESL(14) = HESL(14) - S2S3
         HESL(15) = HESL(15) - D1*S3*(T+X(6)*S3)
  230 CONTINUE
      HESD(1) = X(3)*HESD(1)
      HESD(2) = X(4)*HESD(2)
      HESD(5) = X(6)*HESD(5)
      HESL(1) = X(3)*X(4)*HESL(1)
      HESL(3) = X(4)*HESL(3)
      HESL(4) = X(3)*HESL(4)
      HESL(7) = X(3)*X(6)*HESL(7)
      HESL(8) = X(4)*X(6)*HESL(8)
      HESL(9) = X(6)*HESL(9)
      HESL(10) = X(6)*HESL(10)
      HESL(11) = X(3)*HESL(11)
      HESL(12) = X(4)*HESL(12)
      DO 240 I = 1, 6
         HESD(I) = TWO*HESD(I)
  240 CONTINUE
      DO 250 I = 1, 15
         HESL(I) = TWO*HESL(I)
  250 CONTINUE
      RETURN
C
C     GAUSSIAN FUNCTION.
C
  300 CONTINUE
      HESD(1) = ZERO
      HESD(2) = ZERO
      HESD(3) = ZERO
      HESL(1) = ZERO
      HESL(2) = ZERO
      HESL(3) = ZERO
      DO 310 I = 1, 15
         D1 = CP5*DFLOAT(I-1)
         D2 = C3P5 - D1 - X(3)
         ARG = CP5*X(2)*D2**2
         R = EXP(-ARG)
         T = X(1)*R - Y(I)
         T1 = TWO*X(1)*R - Y(I)
         HESD(1) = HESD(1) + R**2
         HESD(2) = HESD(2) + R*T1*D2**4
         HESD(3) = HESD(3) + R*(X(2)*T1*D2**2-T)
         HESL(1) = HESL(1) - R*T1*D2**2
         HESL(2) = HESL(2) + D2*R*T1
         HESL(3) = HESL(3) + D2*R*(T-ARG*T1)
  310 CONTINUE
      HESD(1) = TWO*HESD(1)
      HESD(2) = CP5*X(1)*HESD(2)
      HESD(3) = TWO*X(1)*X(2)*HESD(3)
      HESL(2) = TWO*X(2)*HESL(2)
      HESL(3) = TWO*X(1)*HESL(3)
      RETURN
C
C     POWELL BADLY SCALED FUNCTION.
C
  400 CONTINUE
      S1 = EXP(-X(1))
      S2 = EXP(-X(2))
      T2 = S1 + S2 - ONE - CP0001
      HESD(1) = C2E8*X(2)**2 + TWO*S1*(S1+T2)
      HESD(2) = C2E8*X(1)**2 + TWO*S2*(S2+T2)
      HESL(1) = C4E8*X(1)*X(2) + TWO*S1*S2 - C20000
      RETURN
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  500 CONTINUE
      HESD(1) = ZERO
      HESD(2) = ZERO
      HESD(3) = ZERO
      HESL(1) = ZERO
      HESL(2) = ZERO
      HESL(3) = ZERO
      DO 510 I = 1, 10
         D1 = DFLOAT(I)
         D2 = D1/TEN
         S1 = EXP(-D2*X(1))
         S2 = EXP(-D2*X(2))
         S3 = EXP(-D2) - EXP(-D1)
         T = S1 - S2 - S3*X(3)
         TH = T*D2**2
         HESD(1) = HESD(1) + TH*S1 + (D2*S1)**2
         HESD(2) = HESD(2) - TH*S2 + (D2*S2)**2
         HESD(3) = HESD(3) + S3**2
         HESL(1) = HESL(1) - S1*S2*D2**2
         HESL(2) = HESL(2) + D2*S1*S3
         HESL(3) = HESL(3) - D2*S2*S3
  510 CONTINUE
      HESD(1) = TWO*HESD(1)
      HESD(2) = TWO*HESD(2)
      HESD(3) = TWO*HESD(3)
      HESL(1) = TWO*HESL(1)
      HESL(2) = TWO*HESL(2)
      HESL(3) = TWO*HESL(3)
      RETURN
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  600 CONTINUE
      T1 = ZERO
      DO 610 J = 1, N
         T1 = T1 + DFLOAT(J)*(X(J)-ONE)
  610 CONTINUE
      T = ONE + SIX*T1**2
      M = 0
      DO 630 J = 1, N
         HESD(J) = TWO + TWO*T*DFLOAT(J)**2
         DO 620 K = 1, J-1
            M = M + 1
            HESL(M) = TWO*T*DFLOAT(J*K)
  620    CONTINUE
  630 CONTINUE
      RETURN
C
C     WATSON FUNCTION.
C
  700 CONTINUE
      DO 710 J = 1, N
         HESD(J) = ZERO
  710 CONTINUE
      DO 720 J = 1, N*(N-1)/2
         HESL(J) = ZERO
  720 CONTINUE
      DO 760 I = 1, 29
         D1 = DFLOAT(I)/C29
         D2 = ONE
         S1 = ZERO
         S2 = X(1)
         DO 730 J = 2, N
            S1 = S1 + DFLOAT(J-1)*D2*X(J)
            D2 = D1*D2
            S2 = S2 + D2*X(J)
  730    CONTINUE
         T = TWO * (S1-S2**2-ONE) * D1**2
         S3 = TWO*D1*S2
         D2 = ONE/D1
         M = 0
         DO 750 J = 1, N
            T1 = DFLOAT(J-1) - S3
            HESD(J) = HESD(J) + (T1**2-T)*D2**2
            D3 = ONE/D1
            DO 740 K = 1, J-1
               M = M + 1
               HESL(M) = HESL(M) + (T1*(DFLOAT(K-1)-S3) - T) * D2*D3
               D3 = D1*D3
  740       CONTINUE
            D2 = D1*D2
  750    CONTINUE
  760 CONTINUE
      T3 = X(2) - X(1)**2 - ONE
      HESD(1) = HESD(1) + ONE - TWO*(T3-TWO*X(1)**2)
      HESD(2) = HESD(2) + ONE
      HESL(1) = HESL(1) - TWO*X(1)
      DO 770 J = 1, N
         HESD(J) = TWO * HESD(J)
  770 CONTINUE
      DO 780 J = 1, N*(N-1)/2
         HESL(J) = TWO * HESL(J)
  780 CONTINUE
      RETURN
C
C     PENALTY FUNCTION I.
C
  800 CONTINUE
      T1 = -CP25
      DO 810 J = 1, N
         T1 = T1 + X(J)**2
  810 CONTINUE
      D1 = TWO*AP
      TH = FOUR*BP*T1
      M = 0
      DO 830 J = 1, N
         HESD(J) = D1 + TH + EIGHT*X(J)**2
         DO 820 K = 1, J-1
            M = M + 1
            HESL(M) = EIGHT*X(J)*X(K)
  820    CONTINUE
  830 CONTINUE
      RETURN
C
C     PENALTY FUNCTION II.
C
  900 CONTINUE
      T1 = -ONE
      DO 910 J = 1, N
         T1 = T1 + DFLOAT(N-J+1)*X(J)**2
  910 CONTINUE
      D1 = EXP(CP1)
      D2 = ONE
      TH = FOUR*BP*T1
      M = 0
      DO 930 J = 1, N
         HESD(J) = EIGHT*BP*(DFLOAT(N-J+1)*X(J))**2 + DFLOAT(N-J+1)*TH
         S1 = EXP(X(J)/TEN)
         IF (J .GT. 1) THEN
            S3 = S1 + S2 - D2*(D1 + ONE)
            HESD(J) = HESD(J) + AP*S1*(S3 + S1 - ONE/D1 + TWO*S1)/C50
            HESD(J-1) = HESD(J-1) + AP*S2*(S2+S3)/C50
            DO 920 K = 1, J-1
               M = M + 1
               T1 = EXP(DFLOAT(K)/TEN)
               HESL(M) = EIGHT*DFLOAT(N-J+1)*DFLOAT(N-K+1)*X(J)*X(K)
  920       CONTINUE
            HESL(M) = HESL(M) + AP*S1*S2/C50
         END IF
         S2 = S1
         D2 = D1*D2
  930 CONTINUE
      HESD(1) = HESD(1) + TWO*BP
      RETURN
C
C     BROWN BADLY SCALED FUNCTION.
C
 1000 CONTINUE
      HESD(1) = TWO + TWO*X(2)**2
      HESD(2) = TWO + TWO*X(1)**2
      HESL(1) = FOUR*X(1)*X(2) - FOUR
      RETURN
C
C     BROWN AND DENNIS FUNCTION.
C
 1100 CONTINUE
      DO 1110 I = 1, 4
         HESD(I) = ZERO
 1110 CONTINUE
      DO 1120 I = 1, 6
         HESL(I) = ZERO
 1120 CONTINUE
      DO 1130 I = 1, 20
         D1 = DFLOAT(I)/FIVE
         D2 = SIN(D1)
         T1 = X(1) + D1*X(2) - EXP(D1)
         T2 = X(3) + D2*X(4) - COS(D1)
         T = EIGHT * T1 * T2
         S1 = C12*T1**2 + FOUR*T2**2
         S2 = C12*T2**2 + FOUR*T1**2
         HESD(1) = HESD(1) + S1
         HESD(2) = HESD(2) + S1*D1**2
         HESD(3) = HESD(3) + S2
         HESD(4) = HESD(4) + S2*D2**2
         HESL(1) = HESL(1) + S1*D1
         HESL(2) = HESL(2) + T
         HESL(4) = HESL(4) + T*D2
         HESL(3) = HESL(3) + T*D1
         HESL(5) = HESL(5) + T*D1*D2
         HESL(6) = HESL(6) + S2*D2
 1130 CONTINUE
      RETURN
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
 1200 CONTINUE
      DO 1210 I = 1, 3
         HESD(I) = ZERO
         HESL(I) = ZERO
 1210 CONTINUE
      D1 = TWO/THREE
      DO 1220 I = 1, 99
         ARG = DFLOAT(I)/C100
         R = (-FIFTY*LOG(ARG))**D1+C25-X(2)
         T1 = ABS(R)**X(3)/X(1)
         T2 = EXP(-T1)
         T3 = T1 * T2 * (T1*T2+(T1-ONE)*(T2-ARG))
         T = T1 * T2 * (T2-ARG)
         LOGR = LOG(ABS(R))
         HESD(1) = HESD(1) + T3 - T
         HESD(2) = HESD(2) + (T+X(3)*T3)/R**2
         HESD(3) = HESD(3) + T3*LOGR**2
         HESL(1) = HESL(1) + T3/R
         HESL(2) = HESL(2) - T3*LOGR
         HESL(3) = HESL(3) + (T-X(3)*T3*LOGR)/R
 1220 CONTINUE
      HESD(1) = HESD(1) / X(1)**2
      HESD(2) = HESD(2) * X(3)
      HESL(1) = HESL(1) * X(3)/X(1)
      HESL(2) = HESL(2) / X(1)
      DO 1230 I = 1, 3
         HESD(I) = TWO * HESD(I)
         HESL(I) = TWO * HESL(I)
 1230 CONTINUE
      RETURN
C
C     TRIGONOMETRIC FUNCTION.
C
 1300 CONTINUE
      S1 = ZERO
      DO 1310 J = 1, N
         HESD(J) = SIN(X(J))
         S1 = S1 + COS(X(J))
 1310 CONTINUE
      S2 = ZERO
      M = 0
      DO 1330 J = 1, N
         TH = COS(X(J))
         T = DFLOAT(N+J) - HESD(J) - S1 - DFLOAT(J)*TH
         S2 = S2 + T
         DO 1320 K = 1, J-1
            M = M + 1
            HESL(M) = SIN(X(K))*(DFLOAT(N+J+K)*HESD(J)-TH) -
     *            HESD(J)*COS(X(K))
            HESL(M) = TWO*HESL(M)
 1320    CONTINUE
         HESD(J) = DFLOAT(J*(J+2)+N)*HESD(J)**2 +
     *         TH*(TH-DFLOAT(2*J+2)*HESD(J)) + T*(DFLOAT(J)*TH+HESD(J))
 1330 CONTINUE
      DO 1340 J = 1, N
         HESD(J) = TWO*(HESD(J) + COS(X(J))*S2)
 1340 CONTINUE
      RETURN
C
C     EXTENDED ROSENBROCK FUNCTION.
C
 1400 CONTINUE
      DO 1410 J = 1, N*(N-1)/2
         HESL(J) = ZERO
 1410 CONTINUE
      DO 1420 J = 1, N, 2
         HESD(J+1) = C200
         HESD(J) = C1200*X(J)**2 - C400*X(J+1) + TWO
         HESL(IX(J+1,J)) = -C400*X(J)
 1420 CONTINUE
      RETURN
C
C     EXTENDED POWELL FUNCTION.
C
 1500 CONTINUE
      DO 1510 J = 1, N*(N-1)/2
         HESL(J) = ZERO
 1510 CONTINUE
      DO 1520 J = 1, N, 4
         T2 = X(J+1) - TWO*X(J+2)
         T3 = X(J) - X(J+3)
         S1 = C12 * T2**2
         S2 = C120 * T3**2
         HESD(J) = TWO + S2
         HESD(J+1) = C200 + S1
         HESD(J+2) = TEN + FOUR*S1
         HESD(J+3) = TEN + S2
         HESL(IX(J+1,J)) = TWO*TEN
         HESL(IX(J+2,J)) = ZERO
         HESL(IX(J+2,J+1)) = -TWO*S1
         HESL(IX(J+3,J)) = -S2
         HESL(IX(J+3,J+1)) = ZERO
         HESL(IX(J+3,J+2)) = -TEN
 1520 CONTINUE
      RETURN
C
C     BEALE FUNCTION.
C
 1600 CONTINUE
      S1 = ONE - X(2)
      T1 = C1P5 - X(1)*S1
      S2 = ONE - X(2)**2
      T2 = C2P25 - X(1)*S2
      S3 = ONE - X(2)**3
      T3 = C2P625 - X(1)*S3
      HESD(1) = TWO * (S1**2 + S2**2 + S3**2)
      HESD(2) = TWO*X(1) * (X(1) + TWO*T2 + FOUR*X(1)*X(2)**2 +
     1      SIX*X(2)*T3 + NINE*X(1)*X(2)**4)
      HESL(1) = TWO*(T1-X(1)*S1) + FOUR*X(2)*(T2-X(1)*S2) +
     2      SIX*(T3-X(1)*S3)*X(2)**2
      RETURN
C
C     WOOD FUNCTION.
C
 1700 CONTINUE
      HESD(1) = C1200*X(1)**2 - C400*X(2) + TWO
      HESD(2) = C220P2
      HESD(3) = C1080*X(3)**2 - C360*X(4) + TWO
      HESD(4) = C200P2
      HESL(1) = -C400*X(1)
      HESL(2) = ZERO
      HESL(3) = ZERO
      HESL(4) = ZERO
      HESL(5) = C19P8
      HESL(6) = -C360*X(3)
      RETURN
C
C     CHEBYQUAD FUNCTION.
C
 1800 CONTINUE
      DO 1810 I = 1, N
         FVEC(I) = ZERO
 1810 CONTINUE
      DO 1830 J = 1, N
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         DO 1820 I = 1, N
            FVEC(I) = FVEC(I) + T2
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
 1820    CONTINUE
 1830 CONTINUE
      D1 = ONE/FLOAT(N)
      IEV = .FALSE.
      DO 1840 I = 1, N
         FVEC(I) = D1*FVEC(I)
         IF (IEV) FVEC(I) = FVEC(I) + ONE/(DFLOAT(I)**2 - ONE)
         IEV = .NOT. IEV
 1840 CONTINUE
      D2 = TWO*D1
      M = 0
      DO 1880 J = 1, N
         HESD(J) = FOUR*D1
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         S1 = ZERO
         S2 = TWO
         P1 = ZERO
         P2 = ZERO
         GVEC(1) = S2
         DO 1850 I = 2, N
            TH = FOUR*T2 + T*S2 - S1
            S1 = S2
            S2 = TH
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
            TH = EIGHT*S1 + T*P2 - P1
            P1 = P2
            P2 = TH
            GVEC(I) = S2
            HESD(J) = HESD(J) + FVEC(I)*TH + D1*S2**2
 1850    CONTINUE
         HESD(J) = D2*HESD(J)
         DO 1870 K = 1, J-1
            M = M + 1
            HESL(M) = ZERO
            TT1 = ONE
            TT2 = TWO*X(K) - ONE
            TT = TWO*TT2
            SS1 = ZERO
            SS2 = TWO
            DO 1860 I = 1, N
               HESL(M) = HESL(M) + SS2*GVEC(I)
               TTH = FOUR*TT2 + TT*SS2 - SS1
               SS1 = SS2
               SS2 = TTH
               TTH = TT*TT2 - TT1
               TT1 = TT2
               TT2 = TTH
 1860       CONTINUE
            HESL(M) = D2*D1*HESL(M)
 1870    CONTINUE
 1880 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE HESFCN.
C
      END
C ----------------------------------------------------------
C SEGMENT 3: DRIVER AND ROUTINES FOR TESTING HESFCN (DOUBLE PRECISION)
C ----------------------------------------------------------
C
      PROGRAM TESTH
C
C TESTH IS THE DRIVER PROGRAM FOR EXERCISING THE VARIOUS COMPONENTS
C OF ALGORITHM 566 WITH THE NEW HESSIAN SEGMENT, ROUTINE HESFCN.
C THE TESTING OF HESFCN IS ACCOMPLISHED THROUGH TAYLOR EXPANSIONS
C (SUBROUTINE TESTGH), WHERE THE RESULTING ERROR FROM THE SECOND-
C ORDER EXPANSION INDICATES WHETHER THE GRADIENT ONLY, OR BOTH THE
C GRADIENT AND HESSIAN, ARE CORRECT.
C
      INTEGER MAXFCN, MAXN
      DOUBLE PRECISION ZERO, ONE, FIVE
      PARAMETER (MAXFCN=18, MAXN=100, ZERO=0.D0, ONE=1.0D0, FIVE=5.0D0)
      INTEGER N, NPROB, NTRIES, NREAD, NWRITE, NVARS(MAXFCN)
      DOUBLE PRECISION FACTOR, F0, X0(MAXN), X(MAXN), Y(MAXN),
     1      H0Y(MAXN), G0(MAXN), H0D(MAXN), H0L(MAXN*(MAXN-1)/2), YHY,
     2      RANVEC(MAXN)
      EXTERNAL INITPT, OBJFCN, GRDFCN, HESFCN, MVPROD
      DATA NREAD, NWRITE /5,6/
      DATA NVARS /3,6,3,2,3,0,0,0,0,2,4,3,0,0,0,2,4,0/
      DATA RANVEC/ 0.908D0, 0.769D0, 0.734D0, 0.644D0,-0.589D0, 0.577D0,
     1   -0.786D0,-0.901D0, 0.517D0, 0.767D0, 0.749D0,-0.978D0, 0.874D0,
     2    0.777D0,-0.945D0,-0.812D0, 0.921D0, 0.580D0,-0.606D0,-0.857D0,
     3   -0.565D0,-0.545D0, 0.637D0, 0.501D0, 0.707D0, 0.513D0, 0.855D0,
     4   -0.969D0, 0.620D0,-0.590D0, 0.659D0, 0.943D0, 0.826D0,-0.575D0,
     5   -0.841D0, 0.693D0,-0.694D0, 0.750D0, 0.574D0, 0.794D0,-0.923D0,
     6   -0.795D0, 0.978D0, 0.778D0, 0.574D0, 0.992D0,-0.704D0, 0.571D0,
     7    0.782D0,-0.626D0,-0.744D0, 0.732D0,-0.981D0,-0.563D0,-0.600D0,
     8   -0.660D0,-0.815D0,-0.563D0, 0.826D0, 0.811D0,-0.902D0, 0.624D0,
     9    0.738D0, 0.695D0,-0.602D0, 0.514D0,-0.951D0,-0.713D0,-0.571D0,
     A    0.974D0,-0.705D0, 0.566D0,-0.943D0,-0.546D0, 0.581D0, 0.536D0,
     B   -0.683D0, 0.627D0,-0.568D0, 0.892D0, 0.728D0, 0.675D0,-0.726D0,
     C   -0.904D0, 0.966D0, 0.826D0, 0.608D0, 0.840D0, 0.954D0, 0.625D0,
     D    0.930D0,-0.736D0,-0.753D0,-0.800D0, 0.909D0, 0.878D0, 0.731D0,
     E   -0.976D0, 0.816D0,-0.720D0/

		
   10 CONTINUE
C
C READ THE NUMBER ASSOCIATED WITH THE FUNCTION TO BE USED (NPROB), THE
C NUMBER OF VARIABLES (N), AND THE NUMBER OF STARTING POINTS (NTRIES).
C (EACH LINE OF INPUT FILE MUST CONSIST OF 3 INTEGERS, ARBITRARY
C FORMAT, WITH NPROB RANGING BETWEEN 1 AND 18; N MUST BE APPROPRIATE
C FOR THE PROBLEM  -- SEE INPUT FILE -- AND NTRIES MUST BE A POSITIVE 
C INTEGER. FOR FUNCTION NUMBER 18 (CHEBYQUAD), SUBROUTINES GRDFCN 
C AND HESFCN, AS CURRENTLY IMPLEMENTED, CANNOT HANDLE N GREATER THAN 50.
C ALSO, PLEASE NOTE THAT FOR ALL FUNCTIONS, N IS RESTRICTED TO BE NO
C MORE THAN 100 IN ORDER TO ALLOW EIGENVALUE CALCULATIONS RELATED TO THE
C SPECTRUM OF THE HESSIAN TO BE PERFORMED WITHOUT MAJOR DEMANDS ON
C STORAGE AND CPU TIME.  THE INPUT IS CHECKED BELOW.
C
         READ (NREAD, *) NPROB, N, NTRIES
         IF (NPROB .EQ. 0) STOP
         IF (NPROB .LT. 1 .OR. NPROB .GT. 18 .OR. N .LT. 1
     1         .OR. NTRIES .LT. 1) THEN
            WRITE (NWRITE, 850)
            STOP
         ENDIF
         IF (NVARS(NPROB) .NE. 0)
     1      N = NVARS(NPROB)
         IF (NPROB .EQ. 7)
     1      N = MAX(2, MIN(N,31))
         IF (NPROB .EQ. 14)
     1      N = MAX(2, N - MOD(N,2))
         IF (NPROB .EQ. 15)
     1      N = MAX(4, N - MOD(N,4))
         IF (NPROB .EQ. 18)
     1      N = MAX(2, MIN(N,50))
         IF (N .GT. MAXN) THEN
            WRITE (NWRITE, 875) N, MAXN
            GO TO 10
         END IF
C
C OBTAIN THE INITIAL POINT X0, AND COMPUTE THE CORRESPONDING
C FUNCTION VALUE, GRADIENT VECTOR, AND HESSIAN MATRIX
C
         FACTOR = ONE
         DO 40 K = 1, NTRIES
            CALL INITPT(N, X0, NPROB, FACTOR)
            CALL OBJFCN(N, X0, F0, NPROB)
            CALL GRDFCN(N, X0, G0, NPROB)
            CALL HESFCN(N, X0, H0D, H0L, NPROB)
            WRITE (NWRITE, 900) NPROB, N, FACTOR
C
C OBTAIN A PERTURBATION VECTOR Y
C
         DO 20 I = 1, N
            IF (X0(I) .NE. ZERO) THEN
               Y(I) = X0(I) * RANVEC(I)
            ELSE
               Y(I) = RANVEC(I)
            ENDIF
   20    CONTINUE
         WRITE (NWRITE,925)
         WRITE (NWRITE,950) (X0(I), I = 1, N)
         WRITE (NWRITE,975)
         WRITE (NWRITE,950) (Y(I), I = 1, N)
C
C COMPUTE THE INNER PRODUCT Y*HY AT X0 AND
C CALL THE DERIVATIVE TESTING FUNCTION
C
            CALL MVPROD(N, H0D, H0L, Y, H0Y)
            YHY = ZERO
            DO 30 I = 1, N
               YHY = YHY + Y(I)*H0Y(I)
   30       CONTINUE
            CALL TESTGH (N, X0, F0, G0, Y, YHY, X, NPROB)
            FACTOR = FIVE*FACTOR
   40    CONTINUE
         GO TO 10

		
  850 FORMAT (/4X, 'ERROR IN INPUT FILE'/)
  875 FORMAT (/4X, 'N > MAXN:  N =', I6, ', MAXN =', I6,
     +        '.  PLEASE INCREASE PARAMETER MAXN.'/)
  900 FORMAT (/4X,'TESTING FUNCTION ', I2/4X,'WITH', I5,
     *        ' VARIABLES AT THE STANDARD STARTING POINT'/
     *        4X, 'SCALED BY', 1PE16.2/)
  925 FORMAT (/4X, 'X0 VECTOR:')
  950 FORMAT (4(F14.2,2X))
  975 FORMAT (/4X, 'Y VECTOR:')
      END
C***************************************************************
      SUBROUTINE TESTGH(N,XC,FC,GC,Y,YHY,VEC,NPROB)
C
C TESTGH TESTS USER-SUPPLIED GRADIENT (G) AND HESSIAN (H)
C ROUTINES CORRESPONDING TO A GIVEN FUNCTION F.
C TESTING H IS OPTIONAL.
C
C DERIVATIVES ARE TESTED USING A TAYLOR EXPANSION OF F
C AROUND A GIVEN POINT XC. THE TAYLOR SERIES IS EXPANDED
C AT XC + EPS*Y WHERE Y IS A RANDOM  PERTURBATION VECTOR
C AND EPS IS A SCALAR. IF WE DENOTE THE DOT PRODUCT OF 2
C VECTORS A AND B AS (A,B), WE CAN WRITE OUR EXPANSION AS
C
C F(XC+EPS*Y) = F(XC) + EPS * (G,Y) + (1/2)*(EPS**2) * (Y,HY)
C                     + O(EPS**3),
C
C WHERE G AND H ARE BOTH EVALUATED AT XC, AND HY DENOTES A
C HESSIAN/VECTOR PRODUCT. IF ONLY G ROUTINES ARE TESTED, THE
C SECOND-ORDER TAYLOR TERM IS ZERO, AND THE TRUNCATION ERROR
C IS O(EPS**2).
C
C OUR TEST IS PERFORMED BY COMPUTING THIS TAYLOR APPROX. AT
C SMALLER AND SMALLER VALUES OF EPS AND CHECKING TO SEE
C WHETHER CORRECT TRUNCATION ERRORS ARE OBTAINED --
C O(EPS**2) AND  O(EPS**3) IF THE APPROX. IS CORRECT UP TO
C THE G AND H TERMS, RESPECTIVELY.
C
C WE DIVIDE EPS BY 2 AT EVERY STEP AND TEST IF INDEED THE
C TRUNCATION ERRORS DECREASE AS THEY SHOULD.
C (I.E., IF THE ERROR CORRESPONDING TO EPS IS E1,
C THE ERROR FOR EPS/2 SHOULD BE E1/4 IF THE GRADIENT
C IS CORRECT, AND E1/8 IF THE HESSIAN IS ALSO CORRECT).
C OUR VALUE "RATIO" COMPUTES THIS FACTOR OF THE OLD/NEW
C ERRORS.
C
C THE OUTPUT IS A SERIES OF VALUES FOR RATIO PRINTED FOR
C EACH EPS UNTIL THE TRUNCATION ERROR AND/OR EPS IS VERY SMALL.
C IF RATIO TENDS TO 4 OR 8 AS EPS IS DECREASED (AND THE
C ERROR IS RELATIVELY SMALL) G  IS CORRECT OR G&H ARE CORRECT,
C RESPECTIVELY. IF RATIO TENDS TO 2, WHICH IS O(EPS), NEITHER G
C NOR H ARE CORRECT. IF THE RATIO TENDS TO 1, THE ERRORS MAY
C BE TOO LARGE GIVEN THE PERTURBATION VECTOR Y.
C
C THUS IN GENERAL, RELIABLE VALUES OF RATIO SHOULD
C OCCUR WHEN: (1) EPS IS NOT TOO LARGE AND NOT TOO SMALL,
C AND (2) THE DIFFERENCE BETWEEN F(XC+EPS*Y) AND THE
C TAYLOR SERIES APPROXIMATION IS OF REASONABLE MAGNITUDE.
C (THE VALUES OF EPS AND THE ERRORS APPEAR IN THE OUTPUT).
C IN OTHER WORDS, AN ACCURATE VALUE OF RATIO SHOULD
C APPEAR AROUND THE MIDDLE OF OUR SERIES IF Y IS APPROPRIATE.
C DIFFERENT STARTING POINT AND/OR PERTURBATION VECTORS
C CAN BE TRIED.
C
C USAGE: THE USER MUST SUPPLY THE FOLLOWING INPUT
C ------ VARIABLES IN THE FUNCTION CALL:
C
C N      - DIMENSION (NUMBER OF VARIABLES FOR F)
C XC(N)  - OUR CURRENT VECTOR
C FC     - THE FUNCTION VALUE AT XC
C GC(N)  - THE GRADIENT VECTOR AT XC, ON INPUT
C          ON OUTPUT, GC MAY BE CHANGED IF IT IS USED IN
C          THE FUNCTION CALL TO OBTAIN A NEW GRADIENT IN
C          ADDITION TO A NEW FUNCTION VALUE (SEE BELOW).
C Y(N)   - A RANDOM PERTURBATION VECTOR (Y SHOULD BE CHOSEN
C          SO THAT F(XC+Y) IS IN A REASONABLE RANGE FOR THE
C          PROBLEM)
C YHY    - THE MATRIX INNER PRODUCT -- (Y,HY) -- REPRESENTING
C          THE DOT PRODUCT OF Y WITH THE HESSIAN/VECTOR
C          PRODUCT, HY, WHERE H IS EVALUATED AT XC
C          (IF ONLY THE GRADIENT IS TESTED, SET YHY TO ZERO).
C VEC(N) - A WORK VECTOR
C NPROB  - AN INTEGER VARIABLE THAT MAY BE USED IN THE 
C          USER'S FUNCTION CALL
C
C NOTE: THE USER MAY MODIFY THIS ROUTINE TO TEST OTHER
C ----  FUNCTIONS BY REPLACING THE SAMPLE FUNCTION CALL GIVEN 
C ABOVE THE '40 CONTINUE' STATEMENT WITH THE APPROPRIATE
C CALL FOR HIS/HER PROBLEM. THE INSERTED ROUTINE CALL
C SHOULD PRODUCE A NEW FUNCTION VALUE, FVEC, FOR EACH 
C NEW VECTOR VEC=XC+EPS*Y.
C
      INTEGER N, MP
      DOUBLE PRECISION ZERO,ONE,HALF,TWOP23,EPSMCH,EPSLIM,EPS,FC,
     1                 GY,YHY,TAYLOR,DIFF,FVEC,FOLD,RATIO,TEMP,
     2                 XC(N),GC(N),Y(N),VEC(N)
      PARAMETER (ZERO=0.D0, ONE=1.0D0, HALF=0.5D0, TWOP23=8388608.0D0,
     1           MP=6)
      EXTERNAL OBJFCN

		
      EPSMCH = ONE / (TWOP23 * TWOP23)
C
C  NOTE:  THE LINE ABOVE MAY BE REPLACED WITH:
C  -----  EPSMCH = D1MACH(3)
C  WHERE D1MACH IS A FUNCTION WHICH MAY BE OBTAINED BY SENDING AN
C  ELECTRONIC MAIL MESSAGE TO NETLIB@ORNL.GOV WITH A SUBJECT LINE OR
C  BODY OF "SEND D1MACH FROM CORE".  EPSMCH WOULD THEN HAVE THE VALUE
C  R**(-P), WHERE R IS THE RADIX OF DOUBLE PRECISION NUMBERS AND P IS
C  THE NUMBER OF RADIX-R DIGITS IN THE MANTISSA OR SIGNIFICAND.  IN
C  OTHER WORDS, EPSMCH WOULD HAVE THE VALUE OF THE SMALLEST RELATIVE
C  SPACING.  HERE, WE HAVE SIMPLY SET EPSMCH TO THE VALUE 2**(-46),
C  WHICH SHOULD GENERALLY BE LARGER THAN THE ACTUAL VALUE OF
C  R**(-P).
C
      EPSLIM = EPSMCH * FLOAT(N*N) * 1.D+2
      EPS    = HALF

		
      WRITE (MP,900)
      GY = ZERO
      DO 10 I = 1, N
         GY = GY + GC(I)*Y(I)
   10 CONTINUE
      WRITE (MP,910) FC,GY,YHY,EPSMCH
      WRITE (MP,940)

		
      DIFF = ZERO
      FVEC = FC

		
   20 CONTINUE
      TEMP = DIFF
      FOLD = FVEC

		
      DO 30 I = 1, N
         VEC(I) = XC(I) + EPS*Y(I)
   30 CONTINUE

		
      NOUT = 0
      CALL OBJFCN(N, VEC, FVEC, NPROB)
   40 CONTINUE

		
      TAYLOR = FC + (EPS*GY) + ( (EPS**2) * HALF  * YHY )
      DIFF   = FVEC - TAYLOR

		
      IF (ABS(DIFF) .LT. ABS(EPSLIM*FVEC)) THEN
         WRITE (MP,920) ABS(EPSLIM*FVEC)
         GOTO 50
      ENDIF

		
      IF (ABS(FVEC-FOLD) .LT. ABS(EPSLIM*FOLD)) THEN
         WRITE (MP,930) ABS(EPSLIM*FOLD)
         GOTO 50
      ENDIF

		
      IF (TEMP .EQ. ZERO .OR. DIFF .EQ. ZERO) THEN
          WRITE (MP, 950) EPS,FVEC,TAYLOR,DIFF
      ELSE
          RATIO = TEMP / DIFF
          WRITE (MP, 950) EPS,FVEC,TAYLOR,DIFF,RATIO
      ENDIF

		
      EPS = EPS * HALF
      IF (EPS .GT. EPSMCH) GOTO 20

		
   50 RETURN

		
  900 FORMAT(/T10,'ENTERING TESTGH ROUTINE:'/)
  910 FORMAT(T5,  'THE FUNCTION VALUE AT X               = ',
     + 1PE16.8/T5,'THE FIRST-ORDER TAYLOR TERM,  (G, Y)  = ',
     + 1PE16.8/T5,'THE SECOND-ORDER TAYLOR TERM, (Y,HY)  = ',
     + 1PE16.8//T5,'THE COMPUTED MACHINE PRECISION        = ',
     + 1PE16.8//)
  920 FORMAT(/T5,'DIFF IS SMALL (LESS THAN ', 1PE16.8,
     + ' IN ABSOLUTE VALUE)'/)
  930 FORMAT(/T5,'CHANGE IN FUNCTION VALUE IS VERY SMALL (LESS THAN ',
     + 1PE16.8,' IN ABSOLUTE VALUE)'/)
  940 FORMAT(4X,'EPS',10X,' F   ',10X,' TAYLOR',9X,
     +  ' DIFF.',9X,'RATIO'/)
  950 FORMAT(1X,1PE10.4,1PE16.8,1PE16.8,1PE16.8,1PE16.8)

		
      END
C***********************************************************************
      SUBROUTINE MVPROD (N, DIAGA, LOWERA, X, Y)
C
C MVPROD PERFORMS THE MATRIX-VECTOR PRODUCT A*X, AND
C STORES THE RESULT IN THE VECTOR Y.  A IS A SYMMETRIC
C NXN MATRIX, WITH DIAGONAL ELEMENTS STORED IN DIAGA AND
C THE STRICT LOWER TRIANGULAR PART STORED BY ROWS IN LOWERA.
C BOTH X AND Y ARE VECTORS OF LENGTH N.
C THE FUNCTION IX (BELOW) GIVES THE LOCATION OF A MATRIX
C ELEMENT (I,J), I>J, IN THE ONE-DIMENSIONAL ARRAY LOWERA.
C
      INTEGER N
      DOUBLE PRECISION DIAGA(N), LOWERA(N*(N-1)/2), X(N), Y(N)
      INTEGER IX, II, JJ
      IX(II,JJ)=(II-1)*(II-2)/2+JJ

		
      DO 10 I = 1, N
         Y(I) = DIAGA(I) * X(I)
   10 CONTINUE
      DO 40 I = 1, N
         DO 20 J = 1, I-1
            Y(I) = Y(I) + LOWERA(IX(I,J))*X(J)
   20    CONTINUE
         DO 30 J = I+1, N
            Y(I) = Y(I) + LOWERA(IX(J,I))*X(J)
   30    CONTINUE
   40 CONTINUE
      RETURN
      END
C
C ----------------------------------------------------------
C SEGMENT 4: DRIVER AND ROUTINES FOR TESTING HESFCN (SINGLE PRECISION)
C ----------------------------------------------------------
C
      PROGRAM TESTH
C
C TESTH IS THE DRIVER PROGRAM FOR EXERCISING THE VARIOUS COMPONENTS
C OF ALGORITHM 566 WITH THE NEW HESSIAN SEGMENT, ROUTINE HESFCN.
C THE TESTING OF HESFCN IS ACCOMPLISHED THROUGH TAYLOR EXPANSIONS
C (SUBROUTINE TESTGH), WHERE THE RESULTING ERROR FROM THE SECOND-
C ORDER EXPANSION INDICATES WHETHER THE GRADIENT ONLY, OR BOTH THE
C GRADIENT AND HESSIAN, ARE CORRECT.
C
      INTEGER MAXFCN, MAXN
      REAL ZERO, ONE, FIVE
      PARAMETER (MAXFCN=18, MAXN=100, ZERO=0.E0, ONE=1.0E0, FIVE=5.0E0)
      INTEGER N, NPROB, NTRIES, NREAD, NWRITE, NVARS(MAXFCN)
      REAL FACTOR, F0, X0(MAXN), X(MAXN), Y(MAXN),
     1      H0Y(MAXN), G0(MAXN), H0D(MAXN), H0L(MAXN*(MAXN-1)/2), YHY,
     2      RANVEC(MAXN)
      EXTERNAL INITPT, OBJFCN, GRDFCN, HESFCN, MVPROD
      DATA NREAD, NWRITE /5,6/
      DATA NVARS /3,6,3,2,3,0,0,0,0,2,4,3,0,0,0,2,4,0/
      DATA RANVEC/ 0.908E0, 0.769E0, 0.734E0, 0.644E0,-0.589E0, 0.577E0,
     1   -0.786E0,-0.901E0, 0.517E0, 0.767E0, 0.749E0,-0.978E0, 0.874E0,
     2    0.777E0,-0.945E0,-0.812E0, 0.921E0, 0.580E0,-0.606E0,-0.857E0,
     3   -0.565E0,-0.545E0, 0.637E0, 0.501E0, 0.707E0, 0.513E0, 0.855E0,
     4   -0.969E0, 0.620E0,-0.590E0, 0.659E0, 0.943E0, 0.826E0,-0.575E0,
     5   -0.841E0, 0.693E0,-0.694E0, 0.750E0, 0.574E0, 0.794E0,-0.923E0,
     6   -0.795E0, 0.978E0, 0.778E0, 0.574E0, 0.992E0,-0.704E0, 0.571E0,
     7    0.782E0,-0.626E0,-0.744E0, 0.732E0,-0.981E0,-0.563E0,-0.600E0,
     8   -0.660E0,-0.815E0,-0.563E0, 0.826E0, 0.811E0,-0.902E0, 0.624E0,
     9    0.738E0, 0.695E0,-0.602E0, 0.514E0,-0.951E0,-0.713E0,-0.571E0,
     A    0.974E0,-0.705E0, 0.566E0,-0.943E0,-0.546E0, 0.581E0, 0.536E0,
     B   -0.683E0, 0.627E0,-0.568E0, 0.892E0, 0.728E0, 0.675E0,-0.726E0,
     C   -0.904E0, 0.966E0, 0.826E0, 0.608E0, 0.840E0, 0.954E0, 0.625E0,
     D    0.930E0,-0.736E0,-0.753E0,-0.800E0, 0.909E0, 0.878E0, 0.731E0,
     E   -0.976E0, 0.816E0,-0.720E0/

		
   10 CONTINUE
C
C READ THE NUMBER ASSOCIATED WITH THE FUNCTION TO BE USED (NPROB), THE
C NUMBER OF VARIABLES (N), AND THE NUMBER OF STARTING POINTS (NTRIES).
C (EACH LINE OF INPUT FILE MUST CONSIST OF 3 INTEGERS, ARBITRARY
C FORMAT, WITH NPROB RANGING BETWEEN 1 AND 18; N MUST BE APPROPRIATE
C FOR THE PROBLEM -- SEE INPUT FILE -- AND NTRIES MUST BE A POSITIVE 
C INTEGER. FOR FUNCTION NUMBER 18 (CHEBYQUAD), SUBROUTINES GRDFCN 
C AND HESFCN, AS CURRENTLY IMPLEMENTED, CANNOT HANDLE N GREATER THAN 50.
C ALSO, PLEASE NOTE THAT FOR ALL FUNCTIONS, N IS RESTRICTED TO BE NO
C MORE THAN 100 IN ORDER TO ALLOW EIGENVALUE CALCULATIONS RELATED TO THE
C SPECTRUM OF THE HESSIAN TO BE PERFORMED WITHOUT MAJOR DEMANDS ON
C STORAGE AND CPU TIME.  THE INPUT IS CHECKED BELOW.
C
         READ (NREAD, *) NPROB, N, NTRIES
         IF (NPROB .EQ. 0) STOP
         IF (NPROB .LT. 1 .OR. NPROB .GT. 18 .OR. N .LT. 1
     1         .OR. NTRIES .LT. 1) THEN
            WRITE (NWRITE, 850)
            STOP
         ENDIF
         IF (NVARS(NPROB) .NE. 0)
     1      N = NVARS(NPROB)
         IF (NPROB .EQ. 7)
     1      N = MAX(2, MIN(N,31))
         IF (NPROB .EQ. 14)
     1      N = MAX(2, N - MOD(N,2))
         IF (NPROB .EQ. 15)
     1      N = MAX(4, N - MOD(N,4))
         IF (NPROB .EQ. 18)
     1      N = MAX(2, MIN(N,50))
         IF (N .GT. MAXN) THEN
            WRITE (NWRITE, 875) N, MAXN
            GO TO 10
         END IF
C
C OBTAIN THE INITIAL POINT X0, AND COMPUTE THE CORRESPONDING
C FUNCTION VALUE, GRADIENT VECTOR, AND HESSIAN MATRIX
C
         FACTOR = ONE
         DO 40 K = 1, NTRIES
            CALL INITPT(N, X0, NPROB, FACTOR)
            CALL OBJFCN(N, X0, F0, NPROB)
            CALL GRDFCN(N, X0, G0, NPROB)
            CALL HESFCN(N, X0, H0D, H0L, NPROB)
            WRITE (NWRITE, 900) NPROB, N, FACTOR
C
C OBTAIN A PERTURBATION VECTOR Y
C
         DO 20 I = 1, N
            IF (X0(I) .NE. ZERO) THEN
               Y(I) = X0(I) * RANVEC(I)
            ELSE
               Y(I) = RANVEC(I)
            ENDIF
   20    CONTINUE
         WRITE (NWRITE,925)
         WRITE (NWRITE,950) (X0(I), I = 1, N)
         WRITE (NWRITE,975)
         WRITE (NWRITE,950) (Y(I), I = 1, N)
C
C COMPUTE THE INNER PRODUCT Y*HY AT X0 AND
C CALL THE DERIVATIVE TESTING FUNCTION
C
            CALL MVPROD(N, H0D, H0L, Y, H0Y)
            YHY = ZERO
            DO 30 I = 1, N
               YHY = YHY + Y(I)*H0Y(I)
   30       CONTINUE
            CALL TESTGH (N, X0, F0, G0, Y, YHY, X, NPROB)
            FACTOR = FIVE*FACTOR
   40    CONTINUE
         GO TO 10

		
  850 FORMAT (/4X, 'ERROR IN INPUT FILE'/)
  875 FORMAT (/4X, 'N > MAXN:  N =', I6, ', MAXN =', I6,
     +        '.  PLEASE INCREASE PARAMETER MAXN.'/)
  900 FORMAT (/4X,'TESTING FUNCTION ', I2/4X,'WITH', I5,
     *        ' VARIABLES AT THE STANDARD STARTING POINT'/
     *        4X, 'SCALED BY', 1PE16.2/)
  925 FORMAT (/4X, 'X0 VECTOR:')
  950 FORMAT (4(F14.2,2X))
  975 FORMAT (/4X, 'Y VECTOR:')
      END
C***************************************************************
      SUBROUTINE TESTGH(N,XC,FC,GC,Y,YHY,VEC,NPROB)
C
C TESTGH TESTS USER-SUPPLIED GRADIENT (G) AND HESSIAN (H)
C ROUTINES CORRESPONDING TO A GIVEN FUNCTION F.
C TESTING H IS OPTIONAL.
C
C DERIVATIVES ARE TESTED USING A TAYLOR EXPANSION OF F
C AROUND A GIVEN POINT XC. THE TAYLOR SERIES IS EXPANDED
C AT XC + EPS*Y WHERE Y IS A RANDOM  PERTURBATION VECTOR
C AND EPS IS A SCALAR. IF WE DENOTE THE DOT PRODUCT OF 2
C VECTORS A AND B AS (A,B), WE CAN WRITE OUR EXPANSION AS
C
C F(XC+EPS*Y) = F(XC) + EPS * (G,Y) + (1/2)*(EPS**2) * (Y,HY)
C                     + O(EPS**3),
C
C WHERE G AND H ARE BOTH EVALUATED AT XC, AND HY DENOTES A
C HESSIAN/VECTOR PRODUCT. IF ONLY G ROUTINES ARE TESTED, THE
C SECOND-ORDER TAYLOR TERM IS ZERO, AND THE TRUNCATION ERROR
C IS O(EPS**2).
C
C OUR TEST IS PERFORMED BY COMPUTING THIS TAYLOR APPROX. AT
C SMALLER AND SMALLER VALUES OF EPS AND CHECKING TO SEE
C WHETHER CORRECT TRUNCATION ERRORS ARE OBTAINED --
C O(EPS**2) AND  O(EPS**3) IF THE APPROX. IS CORRECT UP TO
C THE G AND H TERMS, RESPECTIVELY.
C
C WE DIVIDE EPS BY 2 AT EVERY STEP AND TEST IF INDEED THE
C TRUNCATION ERRORS DECREASE AS THEY SHOULD.
C (I.E., IF THE ERROR CORRESPONDING TO EPS IS E1,
C THE ERROR FOR EPS/2 SHOULD BE E1/4 IF THE GRADIENT
C IS CORRECT, AND E1/8 IF THE HESSIAN IS ALSO CORRECT).
C OUR VALUE "RATIO" COMPUTES THIS FACTOR OF THE OLD/NEW
C ERRORS.
C
C THE OUTPUT IS A SERIES OF VALUES FOR RATIO PRINTED FOR 
C EACH EPS UNTIL THE TRUNCATION ERROR AND/OR EPS IS VERY SMALL.
C IF RATIO TENDS TO 4 OR 8 AS EPS IS DECREASED (AND THE
C ERROR IS RELATIVELY SMALL) G  IS CORRECT OR G&H ARE CORRECT,
C RESPECTIVELY. IF RATIO TENDS TO 2, WHICH IS O(EPS), NEITHER G
C NOR H ARE CORRECT. IF THE RATIO TENDS TO 1, THE ERRORS MAY
C BE TOO LARGE GIVEN THE PERTURBATION VECTOR Y.
C
C THUS IN GENERAL, RELIABLE VALUES OF RATIO SHOULD
C OCCUR WHEN: (1) EPS IS NOT TOO LARGE AND NOT TOO SMALL,
C AND (2) THE DIFFERENCE BETWEEN F(XC+EPS*Y) AND THE
C TAYLOR SERIES APPROXIMATION IS OF REASONABLE MAGNITUDE.
C (THE VALUES OF EPS AND THE ERRORS APPEAR IN THE OUTPUT).
C IN OTHER WORDS, AN ACCURATE VALUE OF RATIO SHOULD
C APPEAR AROUND THE MIDDLE OF OUR SERIES IF Y IS APPROPRIATE.
C DIFFERENT STARTING POINT AND/OR PERTURBATION VECTORS
C CAN BE TRIED.
C
C USAGE: THE USER MUST SUPPLY THE FOLLOWING INPUT
C ------ VARIABLES IN THE FUNCTION CALL:
C
C N      - DIMENSION (NUMBER OF VARIABLES FOR F)
C XC(N)  - OUR CURRENT VECTOR
C FC     - THE FUNCTION VALUE AT XC
C GC(N)  - THE GRADIENT VECTOR AT XC, ON INPUT
C          ON OUTPUT, GC MAY BE CHANGED IF IT IS USED IN
C          THE FUNCTION CALL TO OBTAIN A NEW GRADIENT IN
C          ADDITION TO A NEW FUNCTION VALUE (SEE BELOW).
C Y(N)   - A RANDOM PERTURBATION VECTOR (Y SHOULD BE CHOSEN
C          SO THAT F(XC+Y) IS IN A REASONABLE RANGE FOR THE
C          PROBLEM)
C YHY    - THE MATRIX INNER PRODUCT -- (Y,HY) -- REPRESENTING
C          THE DOT PRODUCT OF Y WITH THE HESSIAN/VECTOR
C          PRODUCT, HY, WHERE H IS EVALUATED AT XC
C          (IF ONLY THE GRADIENT IS TESTED, SET YHY TO ZERO).
C VEC(N) - A WORK VECTOR
C NPROB  - AN INTEGER VARIABLE THAT MAY BE USED IN THE 
C          USER'S FUNCTION CALL
C
C NOTE: THE USER MAY MODIFY THIS ROUTINE TO TEST OTHER
C ----  FUNCTIONS BY REPLACING THE SAMPLE FUNCTION CALL GIVEN 
C ABOVE THE '40 CONTINUE' STATEMENT WITH THE APPROPRIATE
C CALL FOR HIS/HER PROBLEM. THE INSERTED ROUTINE CALL
C SHOULD PRODUCE A NEW FUNCTION VALUE, FVEC, FOR EACH 
C NEW VECTOR VEC=XC+EPS*Y.
C
      INTEGER N, MP
      REAL ZERO,ONE,HALF,TWOP23,EPSMCH,EPSLIM,EPS,FC,
     1                 GY,YHY,TAYLOR,DIFF,FVEC,FOLD,RATIO,TEMP,
     2                 XC(N),GC(N),Y(N),VEC(N)
      PARAMETER (ZERO=0.E0, ONE=1.0E0, HALF=0.5E0, TWOP23=8388608.0E0,
     1           MP=6)
      EXTERNAL OBJFCN

		
      EPSMCH = ONE / TWOP23
C
C  NOTE:  THE LINE ABOVE MAY BE REPLACED WITH:
C  -----  EPSMCH = R1MACH(3)
C  WHERE R1MACH IS A FUNCTION WHICH MAY BE OBTAINED BY SENDING AN
C  ELECTRONIC MAIL MESSAGE TO NETLIB@ORNL.GOV WITH A SUBJECT LINE OR
C  BODY OF "SEND R1MACH FROM CORE".  EPSMCH WOULD THEN HAVE THE VALUE
C  R**(-P), WHERE R IS THE RADIX OF DOUBLE PRECISION NUMBERS AND P IS
C  THE NUMBER OF RADIX-R DIGITS IN THE MANTISSA OR SIGNIFICAND.  IN
C  OTHER WORDS, EPSMCH WOULD HAVE THE VALUE OF THE SMALLEST RELATIVE
C  SPACING.  HERE, WE HAVE SIMPLY SET EPSMCH TO THE VALUE 2**(-23),
C  WHICH SHOULD GENERALLY BE LARGER THAN THE ACTUAL VALUE OF
C  R**(-P).
C
      EPSLIM = EPSMCH * FLOAT(N*N) * 1.E+2
      EPS    = HALF

		
      WRITE (MP,900)
      GY = ZERO
      DO 10 I = 1, N
         GY = GY + GC(I)*Y(I)
   10 CONTINUE
      WRITE (MP,910) FC,GY,YHY,EPSMCH
      WRITE (MP,940)

		
      DIFF = ZERO
      FVEC = FC

		
   20 CONTINUE
      TEMP = DIFF
      FOLD = FVEC

		
      DO 30 I = 1, N
         VEC(I) = XC(I) + EPS*Y(I)
   30 CONTINUE

		
      NOUT = 0
      CALL OBJFCN(N, VEC, FVEC, NPROB)
   40 CONTINUE

		
      TAYLOR = FC + (EPS*GY) + ( (EPS**2) * HALF  * YHY )
      DIFF   = FVEC - TAYLOR

		
      IF (ABS(DIFF) .LT. ABS(EPSLIM*FVEC)) THEN
         WRITE (MP,920) ABS(EPSLIM*FVEC)
         GOTO 50
      ENDIF

		
      IF (ABS(FVEC-FOLD) .LT. ABS(EPSLIM*FOLD)) THEN
         WRITE (MP,930) ABS(EPSLIM*FOLD)
         GOTO 50
      ENDIF

		
      IF (TEMP .EQ. ZERO .OR. DIFF .EQ. ZERO) THEN
          WRITE (MP, 950) EPS,FVEC,TAYLOR,DIFF
      ELSE
          RATIO = TEMP / DIFF
          WRITE (MP, 950) EPS,FVEC,TAYLOR,DIFF,RATIO
      ENDIF

		
      EPS = EPS * HALF
      IF (EPS .GT. EPSMCH) GOTO 20

		
   50 RETURN

		
  900 FORMAT(/T10,'ENTERING TESTGH ROUTINE:'/)
  910 FORMAT(T5,  'THE FUNCTION VALUE AT X               = ',
     + 1PE16.8/T5,'THE FIRST-ORDER TAYLOR TERM,  (G, Y)  = ',
     + 1PE16.8/T5,'THE SECOND-ORDER TAYLOR TERM, (Y,HY)  = ',
     + 1PE16.8//T5,'THE COMPUTED MACHINE PRECISION        = ',
     + 1PE16.8//)
  920 FORMAT(/T5,'DIFF IS SMALL (LESS THAN ', 1PE16.8,
     + ' IN ABSOLUTE VALUE)'/)
  930 FORMAT(/T5,'CHANGE IN FUNCTION VALUE IS VERY SMALL (LESS THAN ',
     + 1PE16.8,' IN ABSOLUTE VALUE)'/)
  940 FORMAT(4X,'EPS',10X,' F   ',10X,' TAYLOR',9X,
     +  ' DIFF.',9X,'RATIO'/)
  950 FORMAT(1X,1PE10.4,1PE16.8,1PE16.8,1PE16.8,1PE16.8)

		
      END
C***********************************************************************
      SUBROUTINE MVPROD (N, DIAGA, LOWERA, X, Y)
C
C MVPROD PERFORMS THE MATRIX-VECTOR PRODUCT A*X, AND
C STORES THE RESULT IN THE VECTOR Y.  A IS A SYMMETRIC
C NXN MATRIX, WITH DIAGONAL ELEMENTS STORED IN DIAGA AND
C THE STRICT LOWER TRIANGULAR PART STORED BY ROWS IN LOWERA.
C BOTH X AND Y ARE VECTORS OF LENGTH N.
C THE FUNCTION IX (BELOW) GIVES THE LOCATION OF A MATRIX
C ELEMENT (I,J), I>J, IN THE ONE-DIMENSIONAL ARRAY LOWERA.
C
      INTEGER N
      REAL DIAGA(N), LOWERA(N*(N-1)/2), X(N), Y(N)
      INTEGER IX, II, JJ
      IX(II,JJ)=(II-1)*(II-2)/2+JJ

		
      DO 10 I = 1, N
         Y(I) = DIAGA(I) * X(I)
   10 CONTINUE
      DO 40 I = 1, N
         DO 20 J = 1, I-1
            Y(I) = Y(I) + LOWERA(IX(I,J))*X(J)
   20    CONTINUE
         DO 30 J = I+1, N
            Y(I) = Y(I) + LOWERA(IX(J,I))*X(J)
   30    CONTINUE
   40 CONTINUE
      RETURN
      END
C************************************************************
C ----------------------------------------------------------
C SEGMENT 5: INPUT FILE (COMMENTED)
C ----------------------------------------------------------
C EACH LINE CONTAINS 3 INTEGERS THAT ARE READ BY THE
C TESTING PROBLEM: {NPROB,N,NTRIES}, WHERE NPROB IS
C THE PROBLEM NUMBER (1 TO 18), N IS THE NUMBER OF
C VARIABLES (SEE BELOW THE PERMITTED RANGE FOR EACH
C PROBLEM), AND NTRIES IS THE NUMBER OF TIMES
C TESTS WILL BE MADE FOR THE FUNCTION BY SCALING X0.
C FIRST LINE OF FILE SHOULD BEGIN WITH THE FIRST TRIPLET,
C AND LAST LINE SHOULD BE {0,0,0}. THE FORMAT IS FLEXIBLE.
C 
C   1    3    2      Helical Valley, N=3
C   2    6    2      Biggs EXP6, N=6
C   3    3    2      Gaussian, N=3
C   4    2    3      Powell Badly Scaled, N=2
C   5    3    2      Box 3D, N=3
C   6    4    4      Variably Dimensioned, N variable
C   7   10    4      Watson, 2<=N<=31
C   8    2    2      Penalty I, N variable
C   9    2    2      Penalty II, N variable
C  10    2    5      Brown Badly Scaled, N=2
C  11    4    2      Brown and Dennis, N=4
C  12    3    2      Gulf Research and Development, N=3
C  13    2    2      Trigonometric, N variable
C  14   12    5      Extended Rosebrock, N variable, even
C  15    4    2      Extended Powell Singular, N multiple of 4
C  16    2    2      Beale, N=2
C  17    4    4      Wood, N=4
C  18    2    2      Chebyquad, N variable
C   0    0    0

		
---------------------------------------------------------------------

		
C ALGORITHM 566
C
C FORTRAN SUBROUTINES FOR TESTING UNCONSTRAINED OPTIMIZATION
C SOFTWARE
C
C BY J.J. MORE, B.S. GARBOW AND K.E. HILLSTROM
C
C ACM TRANSACTIONS ON MATHEMATICAL SOFTWARE 7,1 (MARCH 1981)
C
C ===== THERE ARE 16 PARTS TO THIS FILE
C ===== 1. DOCUMENTATION.
C ===== 2. DOUBLE PRECISION TESTING AIDS FOR NONLINEAR EQUATIONS.
C ===== 3. DOUBLE PRECISION TESTING AIDS FOR NONLINEAR LEAST-SQUARES.
C ===== 4. DOUBLE PRECISION TESTING AIDS FOR UNCONSTRAINED NONLINEAR
C =====     OPTIMIZATION.
C ===== 5. SINGLE PRECISION TESTING AIDS FOR NONLINEAR EQUATIONS.
C ===== 6. SINGLE PRECISION TESTING AIDS FOR NONLINEAR LEAST-SQUARES.
C ===== 7. SINGLE PRECISION TESTING AIDS FOR UNCONSTRAINED NONLINEAR
C =====     OPTIMIZATION.
C ===== 8. SAMPLE DRIVER FOR DOUBLE PRECISION NONLINEAR EQUATIONS.
C ===== 9. SAMPLE DRIVER FOR SINGLE PRECISION NONLINEAR EQUATIONS.
C ===== 10. SAMPLE DRIVER FOR DOUBLE PRECISION NONLINEAR LEAST-SQUARES.
C ===== 11. SAMPLE DRIVER FOR SINGLE PRECISION NONLINEAR LEAST-SQUARES.
C ===== 12. SAMPLE DRIVER FOR DOUBLE PRECISION UNCONSTRAINED NONLINEAR
C =====     MINIMIZATION.
C ===== 13. SAMPLE DRIVER FOR SINGLE PRECISION UNCONSTRAINED NONLINEAR
C =====     MINIMIZATION.
C ===== 14. DATA (NONLINEAR EQUATIONS).
C ===== 15. DATA (NONLINEARR LEAST SQUARES).
C ===== 16. DATA (UNCONSTRAINED NONLINEAR OPTIMIZATION).
C =====
C =====
C =====
C ===== 1. DOCUMENTATION.
 DESCRIPTION

		
      This is the Fortran package of subroutines described in (1)
 for testing unconstrained optimization software.  The following
 three problem areas are considered.

		
      1.  Zeros of systems of N nonlinear functions in N variables.

		
      2.  Least Squares minimization of M nonlinear functions in
          N variables.

		
      3.  Unconstrained minimization of an objective function with
          N variables.

		
      The subroutines which define the test functions and starting
 points depend on the dimension parameters M and N and on the
 problem number NPROB.  We first describe the subroutines for the
 test functions.

		
      For systems of nonlinear functions,

		
                VECFCN(N,X,FVEC,NPROB)

		
 returns the function values in the N-vector FVEC, and

		
                VECJAC(N,X,FJAC,LDFJAC,NPROB)

		
 returns the Jacobian matrix in the N by N array FJAC.  (The parameter
 LDFJAC is the leading dimension of the array FJAC as defined in the
 main program.)  In order to prevent gross inefficiencies with solvers
 which only require one function value at a time,

		
                COMFCN(N,K,X,FCNK,NPROB)

		
 returns the K-th function value in FCNK.

		
      For nonlinear least squares,

		
                SSQFCN(M,N,X,FVEC,NPROB)

		
 returns the function values in the M-vector FVEC, and

		
                SSQJAC(M,N,X,FJAC,LDFJAC,NPROB)

		
 returns the Jacobian matrix in the M by N array FJAC.

		
      For unconstrained minimization,

		
                OBJFCN(N,X,F,NPROB)

		
 returns the objective function value in F, and

		
                GRDFCN(N,X,G,NPROB)

		
 returns the gradient components in the N-vector G.

		
      For each problem area, the starting points are generated by

		
                INITPT(N,X,NPROB,FACTOR)

		
 which returns in X the starting point corresponding to the
 parameters NPROB and FACTOR.  If XS denotes the standard starting
 point, then X will contain FACTOR*XS, except that if XS is the
 zero vector and FACTOR is not unity, then all the components of X
 will be set to FACTOR.

		
      To test a code in any of the three problem areas, the user
 must provide a driver and interface routine.  The driver reads in
 the data which defines the dimensions, the problem number, and
 FACTOR, calls INITPT, and then calls the code of interest and
 prints out results.  The interface routine provides a link between
 the code with its particular function routine calling sequences
 and the subroutines for the test functions.

		
      The package includes example drivers and interface routines
 for each of the problem areas.  Sample data is also provided.

		

		
 REFERENCES

		
 1. More, J.J., Garbow, B.S., and Hillstrom, K.E., Testing
    Unconstrained Optimization Software, ACM Trans. Math. Software
    (this issue).
C ===== 2. DOUBLE PRECISION TESTING AIDS FOR NONLINEAR EQUATIONS.
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)                               00000010
      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 SUBROUTINES COMFCN AND VECFCN. THE
C     SUBROUTINE RETURNS IN X A MULTIPLE (FACTOR) OF THE STANDARD
C     STARTING POINT. FOR THE SIXTH FUNCTION THE STANDARD STARTING
C     POINT IS 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     MINPACK. VERSION OF JULY 1978.
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 COMFCN(N,K,X,FCNK,NPROB)                               00000010
      INTEGER N,K,NPROB
      DOUBLE PRECISION FCNK
      DOUBLE PRECISION X(N)
C     **********
C
C     SUBROUTINE COMFCN
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 COMFCN(N,K,X,FCNK,NPROB)
C
C     WHERE
C
C       N IS A POSITIVE INTEGER INPUT VARIABLE.
C
C       K IS A POSITIVE INTEGER INPUT VARIABLE NOT GREATER THAN N.
C
C       X IS AN INPUT ARRAY OF LENGTH N.
C
C       FCNK IS AN OUTPUT VARIABLE WHICH CONTAINS THE VALUE OF
C         THE K-TH COMPONENT OF THE NPROB FUNCTION 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 REQUIRED
C
C       FORTRAN-SUPPLIED ... DATAN,DCOS,DEXP,DSIGN,DSIN,DSQRT,
C                            MAX0,MIN0,MOD
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IVAR,J,K1,K2,KP1,ML,MU
      DOUBLE PRECISION C1,C2,C3,C4,C5,C6,C7,C8,C9,EIGHT,FIVE,H,ONE,
     1                 PROD,SUM,SUM1,SUM2,TEMP,TEMP1,TEMP2,TEN,THREE,
     2                 TI,TJ,TK,TPI,TWO,ZERO
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FIVE,EIGHT,TEN
     1     /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     /1.0D4,1.0001D0,2.0D2,2.02D1,1.98D1,1.8D2,2.5D-1,5.0D-1,
     2      2.9D1/
      DFLOAT(IVAR) = IVAR
C
C     PROBLEM SELECTOR.
C
      GO TO (10,20,30,40,50,70,110,150,200,210,250,270,290,300), NPROB
C
C     ROSENBROCK FUNCTION.
C
   10 CONTINUE
      IF (K .EQ. 1) FCNK = ONE - X(1)
      IF (K .EQ. 2) FCNK = TEN*(X(2) - X(1)**2)
      GO TO 320
C
C     POWELL SINGULAR FUNCTION.
C
   20 CONTINUE
      IF (K .EQ. 1) FCNK = X(1) + TEN*X(2)
      IF (K .EQ. 2) FCNK = DSQRT(FIVE)*(X(3) - X(4))
      IF (K .EQ. 3) FCNK = (X(2) - TWO*X(3))**2
      IF (K .EQ. 4) FCNK = DSQRT(TEN)*(X(1) - X(4))**2
      GO TO 320
C
C     POWELL BADLY SCALED FUNCTION.
C
   30 CONTINUE
      IF (K .EQ. 1) FCNK = C1*X(1)*X(2) - ONE
      IF (K .EQ. 2) FCNK = DEXP(-X(1)) + DEXP(-X(2)) - C2
      GO TO 320
C
C     WOOD FUNCTION.
C
   40 CONTINUE
      TEMP1 = X(2) - X(1)**2
      TEMP2 = X(4) - X(3)**2
      IF (K .EQ. 1) FCNK = -C3*X(1)*TEMP1 - (ONE - X(1))
      IF (K .EQ. 2)
     1   FCNK = C3*TEMP1 + C4*(X(2) - ONE) + C5*(X(4) - ONE)
      IF (K .EQ. 3) FCNK = -C6*X(3)*TEMP2 - (ONE - X(3))
      IF (K .EQ. 4)
     1   FCNK = C6*TEMP2 + C4*(X(4) - ONE) + C5*(X(2) - ONE)
      GO TO 320
C
C     HELICAL VALLEY FUNCTION.
C
   50 CONTINUE
      IF (K .NE. 1) GO TO 60
      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
      FCNK = TEN*(X(3) - TEN*TEMP1)
   60 CONTINUE
      IF (K .EQ. 2) FCNK = TEN*(DSQRT(X(1)**2+X(2)**2) - ONE)
      IF (K .EQ. 3) FCNK = X(3)
      GO TO 320
C
C     WATSON FUNCTION.
C
   70 CONTINUE
      FCNK = ZERO
      DO 100 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
         FCNK = FCNK + TI**(K - 2)*(DFLOAT(K-1) - TEMP2)*TEMP1
  100    CONTINUE
      TEMP = X(2) - X(1)**2 - ONE
      IF (K .EQ. 1) FCNK = FCNK + X(1)*(ONE - TWO*TEMP)
      IF (K .EQ. 2) FCNK = FCNK + TEMP
      GO TO 320
C
C     CHEBYQUAD FUNCTION.
C
  110 CONTINUE
      SUM = ZERO
      DO 140 J = 1, N
         TEMP1 = ONE
         TEMP2 = TWO*X(J) - ONE
         TEMP = TWO*TEMP2
         IF (K .LT. 2) GO TO 130
         DO 120 I = 2, K
            TI = TEMP*TEMP2 - TEMP1
            TEMP1 = TEMP2
            TEMP2 = TI
  120       CONTINUE
  130    CONTINUE
         SUM = SUM + TEMP2
  140    CONTINUE
      FCNK = SUM/DFLOAT(N)
      IF (MOD(K,2) .EQ. 0) FCNK = FCNK + ONE/(DFLOAT(K)**2 - ONE)
      GO TO 320
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  150 CONTINUE
      IF (K .EQ. N) GO TO 170
         SUM = -DFLOAT(N+1)
         DO 160 J = 1, N
            SUM = SUM + X(J)
  160       CONTINUE
         FCNK = X(K) + SUM
         GO TO 190
  170 CONTINUE
         PROD = ONE
         DO 180 J = 1, N
            PROD = X(J)*PROD
  180       CONTINUE
         FCNK = PROD - ONE
  190 CONTINUE
      GO TO 320
C
C     DISCRETE BOUNDARY VALUE FUNCTION.
C
  200 CONTINUE
      H = ONE/DFLOAT(N+1)
      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)
      FCNK = TWO*X(K) - TEMP1 - TEMP2 + TEMP*H**2/TWO
      GO TO 320
C
C     DISCRETE INTEGRAL EQUATION FUNCTION.
C
  210 CONTINUE
      H = ONE/DFLOAT(N+1)
      TK = DFLOAT(K)*H
      SUM1 = ZERO
      DO 220 J = 1, K
         TJ = DFLOAT(J)*H
         TEMP = (X(J) + TJ + ONE)**3
         SUM1 = SUM1 + TJ*TEMP
  220    CONTINUE
      SUM2 = ZERO
      KP1 = K + 1
      IF (N .LT. KP1) GO TO 240
      DO 230 J = KP1, N
         TJ = DFLOAT(J)*H
         TEMP = (X(J) + TJ + ONE)**3
         SUM2 = SUM2 + (ONE - TJ)*TEMP
  230    CONTINUE
  240 CONTINUE
      FCNK = X(K) + H*((ONE - TK)*SUM1 + TK*SUM2)/TWO
      GO TO 320
C
C     TRIGONOMETRIC FUNCTION.
C
  250 CONTINUE
      SUM = ZERO
      DO 260 J = 1, N
         SUM = SUM + DCOS(X(J))
  260    CONTINUE
      FCNK = DFLOAT(N+K) - DSIN(X(K)) - SUM - DFLOAT(K)*DCOS(X(K))
      GO TO 320
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  270 CONTINUE
      SUM = ZERO
      DO 280 J = 1, N
         SUM = SUM + DFLOAT(J)*(X(J) - ONE)
  280    CONTINUE
      TEMP = SUM*(ONE + TWO*SUM**2)
      FCNK = X(K) - ONE + DFLOAT(K)*TEMP
      GO TO 320
C
C     BROYDEN TRIDIAGONAL FUNCTION.
C
  290 CONTINUE
      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)
      FCNK = TEMP - TEMP1 - TWO*TEMP2 + ONE
      GO TO 320
C
C     BROYDEN BANDED FUNCTION.
C
  300 CONTINUE
      ML = 5
      MU = 1
      K1 = MAX0(1,K-ML)
      K2 = MIN0(K+MU,N)
      TEMP = ZERO
      DO 310 J = K1, K2
         IF (J .NE. K) TEMP = TEMP + X(J)*(ONE + X(J))
  310    CONTINUE
      FCNK = X(K)*(TWO + FIVE*X(K)**2) + ONE - TEMP
  320 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE COMFCN.
C
      END
      SUBROUTINE VECFCN(N,X,FVEC,NPROB)                                 00000010
      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     MINPACK. VERSION OF JULY 1978.
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,
     1                 PROD,SUM,SUM1,SUM2,TEMP,TEMP1,TEMP2,TEN,THREE,
     2                 TI,TJ,TK,TPI,TWO,ZERO
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FIVE,EIGHT,TEN
     1     /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     /1.0D4,1.0001D0,2.0D2,2.02D1,1.98D1,1.8D2,2.5D-1,5.0D-1,
     2      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
      SUBROUTINE VECJAC(N,X,FJAC,LDFJAC,NPROB)                          00000010
      INTEGER N,LDFJAC,NPROB
      DOUBLE PRECISION 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 ... DATAN,DCOS,DEXP,DMIN1,DSIN,DSQRT,
C                            MAX0,MIN0
C
C     MINPACK. VERSION OF AUGUST 1978.
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,
     1                 HUNDRD,ONE,PROD,SIX,SUM,SUM1,SUM2,TEMP,TEMP1,
     2                 TEMP2,TEMP3,TEMP4,TEN,THREE,TI,TJ,TK,TPI,
     3                 TWENTY,TWO,ZERO
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,EIGHT,TEN,FIFTN,TWENTY,
     1     HUNDRD
     2     /0.0D0,1.0D0,2.0D0,3.0D0,4.0D0,5.0D0,6.0D0,8.0D0,1.0D1,
     3      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),
     1      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) = 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.
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.
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*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) = 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 = 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)
     1                     + TJ
     2                       *((DFLOAT(K-1)/TI - TEMP2)
     3                         *(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.
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) = 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/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) = 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/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.
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.
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.
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
C ===== 3. DOUBLE PRECISION TESTING AIDS FOR NONLINEAR LEAST-SQUARES.
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)                               00000010
      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 THE
C     FUNCTIONS DEFINED BY SUBROUTINE SSQFCN. THE SUBROUTINE RETURNS
C     IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR
C     THE 11TH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN
C     THIS CASE, IF FACTOR IS NOT UNITY, THEN THE SUBROUTINE RETURNS
C     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 18.
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     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER IVAR,J
      DOUBLE PRECISION C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,
     1                 C15,C16,C17,FIVE,H,HALF,ONE,SEVEN,TEN,THREE,
     2                 TWENTY,TWNTF,TWO,ZERO
      DOUBLE PRECISION DFLOAT
      DATA ZERO,HALF,ONE,TWO,THREE,FIVE,SEVEN,TEN,TWENTY,TWNTF
     1     /0.0D0,5.0D-1,1.0D0,2.0D0,3.0D0,5.0D0,7.0D0,1.0D1,2.0D1,
     2      2.5D1/
      DATA C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16,C17
     1     /1.2D0,2.5D-1,3.9D-1,4.15D-1,2.0D-2,4.0D3,2.5D2,3.0D-1,
     2      4.0D-1,1.5D0,1.0D-2,1.3D0,6.5D-1,7.0D-1,6.0D-1,4.5D0,
     3      5.5D0/
      DFLOAT(IVAR) = IVAR
C
C     SELECTION OF INITIAL POINT.
C
      GO TO (10,10,10,30,40,50,60,70,80,90,100,120,130,140,150,170,
     1       190,200), NPROB
C
C     LINEAR FUNCTION - FULL RANK OR RANK 1.
C
   10 CONTINUE
      DO 20 J = 1, N
         X(J) = ONE
   20    CONTINUE
      GO TO 210
C
C     ROSENBROCK FUNCTION.
C
   30 CONTINUE
      X(1) = -C1
      X(2) = ONE
      GO TO 210
C
C     HELICAL VALLEY FUNCTION.
C
   40 CONTINUE
      X(1) = -ONE
      X(2) = ZERO
      X(3) = ZERO
      GO TO 210
C
C     POWELL SINGULAR FUNCTION.
C
   50 CONTINUE
      X(1) = THREE
      X(2) = -ONE
      X(3) = ZERO
      X(4) = ONE
      GO TO 210
C
C     FREUDENSTEIN AND ROTH FUNCTION.
C
   60 CONTINUE
      X(1) = HALF
      X(2) = -TWO
      GO TO 210
C
C     BARD FUNCTION.
C
   70 CONTINUE
      X(1) = ONE
      X(2) = ONE
      X(3) = ONE
      GO TO 210
C
C     KOWALIK AND OSBORNE FUNCTION.
C
   80 CONTINUE
      X(1) = C2
      X(2) = C3
      X(3) = C4
      X(4) = C3
      GO TO 210
C
C     MEYER FUNCTION.
C
   90 CONTINUE
      X(1) = C5
      X(2) = C6
      X(3) = C7
      GO TO 210
C
C     WATSON FUNCTION.
C
  100 CONTINUE
      DO 110 J = 1, N
         X(J) = ZERO
  110    CONTINUE
      GO TO 210
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  120 CONTINUE
      X(1) = ZERO
      X(2) = TEN
      X(3) = TWENTY
      GO TO 210
C
C     JENNRICH AND SAMPSON FUNCTION.
C
  130 CONTINUE
      X(1) = C8
      X(2) = C9
      GO TO 210
C
C     BROWN AND DENNIS FUNCTION.
C
  140 CONTINUE
      X(1) = TWNTF
      X(2) = FIVE
      X(3) = -FIVE
      X(4) = -ONE
      GO TO 210
C
C     CHEBYQUAD FUNCTION.
C
  150 CONTINUE
      H = ONE/DFLOAT(N+1)
      DO 160 J = 1, N
         X(J) = DFLOAT(J)*H
  160    CONTINUE
      GO TO 210
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  170 CONTINUE
      DO 180 J = 1, N
         X(J) = HALF
  180    CONTINUE
      GO TO 210
C
C     OSBORNE 1 FUNCTION.
C
  190 CONTINUE
      X(1) = HALF
      X(2) = C10
      X(3) = -ONE
      X(4) = C11
      X(5) = C5
      GO TO 210
C
C     OSBORNE 2 FUNCTION.
C
  200 CONTINUE
      X(1) = C12
      X(2) = C13
      X(3) = C13
      X(4) = C14
      X(5) = C15
      X(6) = THREE
      X(7) = FIVE
      X(8) = SEVEN
      X(9) = TWO
      X(10) = C16
      X(11) = C17
  210 CONTINUE
C
C     COMPUTE MULTIPLE OF INITIAL POINT.
C
      IF (FACTOR .EQ. ONE) GO TO 260
      IF (NPROB .EQ. 11) GO TO 230
         DO 220 J = 1, N
            X(J) = FACTOR*X(J)
  220       CONTINUE
         GO TO 250
  230 CONTINUE
         DO 240 J = 1, N
            X(J) = FACTOR
  240       CONTINUE
  250 CONTINUE
  260 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE INITPT.
C
      END
      SUBROUTINE SSQFCN(M,N,X,FVEC,NPROB)                               00000010
      INTEGER M,N,NPROB
      DOUBLE PRECISION X(N),FVEC(M)
C     **********
C
C     SUBROUTINE SSQFCN
C
C     THIS SUBROUTINE DEFINES THE FUNCTIONS OF EIGHTEEN NONLINEAR
C     LEAST SQUARES PROBLEMS. THE ALLOWABLE VALUES OF (M,N) FOR
C     FUNCTIONS 1,2 AND 3 ARE VARIABLE BUT WITH M .GE. N.
C     FOR FUNCTIONS 4,5,6,7,8,9 AND 10 THE VALUES OF (M,N) ARE
C     (2,2),(3,3),(4,4),(2,2),(15,3),(11,4) AND (16,3), RESPECTIVELY.
C     FUNCTION 11 (WATSON) HAS M = 31 WITH N USUALLY 6 OR 9.
C     HOWEVER, ANY N, N = 2,...,31, IS PERMITTED.
C     FUNCTIONS 12,13 AND 14 HAVE N = 3,2 AND 4, RESPECTIVELY, BUT
C     ALLOW ANY M .GE. N, WITH THE USUAL CHOICES BEING 10,10 AND 20.
C     FUNCTION 15 (CHEBYQUAD) ALLOWS M AND N VARIABLE WITH M .GE. N.
C     FUNCTION 16 (BROWN) ALLOWS N VARIABLE WITH M = N.
C     FOR FUNCTIONS 17 AND 18, THE VALUES OF (M,N) ARE
C     (33,5) AND (65,11), RESPECTIVELY.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE SSQFCN(M,N,X,FVEC,NPROB)
C
C     WHERE
C
C       M AND N ARE POSITIVE INTEGER INPUT VARIABLES. N MUST NOT
C         EXCEED M.
C
C       X IS AN INPUT ARRAY OF LENGTH N.
C
C       FVEC IS AN OUTPUT ARRAY OF LENGTH M WHICH CONTAINS THE NPROB
C         FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS CALLED
C
C       FORTRAN-SUPPLIED ... DATAN,DCOS,DEXP,DSIN,DSQRT,DSIGN
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IEV,IVAR,J,NM1
      DOUBLE PRECISION C13,C14,C29,C45,DIV,DX,EIGHT,FIVE,ONE,PROD,SUM,
     1                 S1,S2,TEMP,TEN,TI,TMP1,TMP2,TMP3,TMP4,TPI,TWO,
     2                 ZERO,ZP25,ZP5
      DOUBLE PRECISION V(11),Y1(15),Y2(11),Y3(16),Y4(33),Y5(65)
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ZP25,ZP5,ONE,TWO,FIVE,EIGHT,TEN,C13,C14,C29,C45
     1     /0.0D0,2.5D-1,5.0D-1,1.0D0,2.0D0,5.0D0,8.0D0,1.0D1,1.3D1,
     2      1.4D1,2.9D1,4.5D1/
      DATA V(1),V(2),V(3),V(4),V(5),V(6),V(7),V(8),V(9),V(10),V(11)
     1     /4.0D0,2.0D0,1.0D0,5.0D-1,2.5D-1,1.67D-1,1.25D-1,1.0D-1,
     2      8.33D-2,7.14D-2,6.25D-2/
      DATA Y1(1),Y1(2),Y1(3),Y1(4),Y1(5),Y1(6),Y1(7),Y1(8),Y1(9),
     1     Y1(10),Y1(11),Y1(12),Y1(13),Y1(14),Y1(15)
     2     /1.4D-1,1.8D-1,2.2D-1,2.5D-1,2.9D-1,3.2D-1,3.5D-1,3.9D-1,
     3      3.7D-1,5.8D-1,7.3D-1,9.6D-1,1.34D0,2.1D0,4.39D0/
      DATA Y2(1),Y2(2),Y2(3),Y2(4),Y2(5),Y2(6),Y2(7),Y2(8),Y2(9),
     1     Y2(10),Y2(11)
     2     /1.957D-1,1.947D-1,1.735D-1,1.6D-1,8.44D-2,6.27D-2,4.56D-2,
     3      3.42D-2,3.23D-2,2.35D-2,2.46D-2/
      DATA Y3(1),Y3(2),Y3(3),Y3(4),Y3(5),Y3(6),Y3(7),Y3(8),Y3(9),
     1     Y3(10),Y3(11),Y3(12),Y3(13),Y3(14),Y3(15),Y3(16)
     2     /3.478D4,2.861D4,2.365D4,1.963D4,1.637D4,1.372D4,1.154D4,
     3      9.744D3,8.261D3,7.03D3,6.005D3,5.147D3,4.427D3,3.82D3,
     4      3.307D3,2.872D3/
      DATA Y4(1),Y4(2),Y4(3),Y4(4),Y4(5),Y4(6),Y4(7),Y4(8),Y4(9),
     1     Y4(10),Y4(11),Y4(12),Y4(13),Y4(14),Y4(15),Y4(16),Y4(17),
     2     Y4(18),Y4(19),Y4(20),Y4(21),Y4(22),Y4(23),Y4(24),Y4(25),
     3     Y4(26),Y4(27),Y4(28),Y4(29),Y4(30),Y4(31),Y4(32),Y4(33)
     4     /8.44D-1,9.08D-1,9.32D-1,9.36D-1,9.25D-1,9.08D-1,8.81D-1,
     5      8.5D-1,8.18D-1,7.84D-1,7.51D-1,7.18D-1,6.85D-1,6.58D-1,
     6      6.28D-1,6.03D-1,5.8D-1,5.58D-1,5.38D-1,5.22D-1,5.06D-1,
     7      4.9D-1,4.78D-1,4.67D-1,4.57D-1,4.48D-1,4.38D-1,4.31D-1,
     8      4.24D-1,4.2D-1,4.14D-1,4.11D-1,4.06D-1/
      DATA Y5(1),Y5(2),Y5(3),Y5(4),Y5(5),Y5(6),Y5(7),Y5(8),Y5(9),
     1     Y5(10),Y5(11),Y5(12),Y5(13),Y5(14),Y5(15),Y5(16),Y5(17),
     2     Y5(18),Y5(19),Y5(20),Y5(21),Y5(22),Y5(23),Y5(24),Y5(25),
     3     Y5(26),Y5(27),Y5(28),Y5(29),Y5(30),Y5(31),Y5(32),Y5(33),
     4     Y5(34),Y5(35),Y5(36),Y5(37),Y5(38),Y5(39),Y5(40),Y5(41),
     5     Y5(42),Y5(43),Y5(44),Y5(45),Y5(46),Y5(47),Y5(48),Y5(49),
     6     Y5(50),Y5(51),Y5(52),Y5(53),Y5(54),Y5(55),Y5(56),Y5(57),
     7     Y5(58),Y5(59),Y5(60),Y5(61),Y5(62),Y5(63),Y5(64),Y5(65)
     8     /1.366D0,1.191D0,1.112D0,1.013D0,9.91D-1,8.85D-1,8.31D-1,
     9      8.47D-1,7.86D-1,7.25D-1,7.46D-1,6.79D-1,6.08D-1,6.55D-1,
     A      6.16D-1,6.06D-1,6.02D-1,6.26D-1,6.51D-1,7.24D-1,6.49D-1,
     B      6.49D-1,6.94D-1,6.44D-1,6.24D-1,6.61D-1,6.12D-1,5.58D-1,
     C      5.33D-1,4.95D-1,5.0D-1,4.23D-1,3.95D-1,3.75D-1,3.72D-1,
     D      3.91D-1,3.96D-1,4.05D-1,4.28D-1,4.29D-1,5.23D-1,5.62D-1,
     E      6.07D-1,6.53D-1,6.72D-1,7.08D-1,6.33D-1,6.68D-1,6.45D-1,
     F      6.32D-1,5.91D-1,5.59D-1,5.97D-1,6.25D-1,7.39D-1,7.1D-1,
     G      7.29D-1,7.2D-1,6.36D-1,5.81D-1,4.28D-1,2.92D-1,1.62D-1,
     H      9.8D-2,5.4D-2/
      DFLOAT(IVAR) = IVAR
C
C     FUNCTION ROUTINE SELECTOR.
C
      GO TO (10,40,70,110,120,130,140,150,170,190,210,250,270,290,310,
     1       360,390,410), NPROB
C
C     LINEAR FUNCTION - FULL RANK.
C
   10 CONTINUE
      SUM = ZERO
      DO 20 J = 1, N
         SUM = SUM + X(J)
   20    CONTINUE
      TEMP = TWO*SUM/DFLOAT(M) + ONE
      DO 30 I = 1, M
         FVEC(I) = -TEMP
         IF (I .LE. N) FVEC(I) = FVEC(I) + X(I)
   30    CONTINUE
      GO TO 430
C
C     LINEAR FUNCTION - RANK 1.
C
   40 CONTINUE
      SUM = ZERO
      DO 50 J = 1, N
         SUM = SUM + DFLOAT(J)*X(J)
   50    CONTINUE
      DO 60 I = 1, M
         FVEC(I) = DFLOAT(I)*SUM - ONE
   60    CONTINUE
      GO TO 430
C
C     LINEAR FUNCTION - RANK 1 WITH ZERO COLUMNS AND ROWS.
C
   70 CONTINUE
      SUM = ZERO
      NM1 = N - 1
      IF (NM1 .LT. 2) GO TO 90
      DO 80 J = 2, NM1
         SUM = SUM + DFLOAT(J)*X(J)
   80    CONTINUE
   90 CONTINUE
      DO 100 I = 1, M
         FVEC(I) = DFLOAT(I-1)*SUM - ONE
  100    CONTINUE
      FVEC(M) = -ONE
      GO TO 430
C
C     ROSENBROCK FUNCTION.
C
  110 CONTINUE
      FVEC(1) = TEN*(X(2) - X(1)**2)
      FVEC(2) = ONE - X(1)
      GO TO 430
C
C     HELICAL VALLEY FUNCTION.
C
  120 CONTINUE
      TPI = EIGHT*DATAN(ONE)
      TMP1 = DSIGN(ZP25,X(2))
      IF (X(1) .GT. ZERO) TMP1 = DATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TMP1 = DATAN(X(2)/X(1))/TPI + ZP5
      TMP2 = DSQRT(X(1)**2+X(2)**2)
      FVEC(1) = TEN*(X(3) - TEN*TMP1)
      FVEC(2) = TEN*(TMP2 - ONE)
      FVEC(3) = X(3)
      GO TO 430
C
C     POWELL SINGULAR FUNCTION.
C
  130 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 430
C
C     FREUDENSTEIN AND ROTH FUNCTION.
C
  140 CONTINUE
      FVEC(1) = -C13 + X(1) + ((FIVE - X(2))*X(2) - TWO)*X(2)
      FVEC(2) = -C29 + X(1) + ((ONE + X(2))*X(2) - C14)*X(2)
      GO TO 430
C
C     BARD FUNCTION.
C
  150 CONTINUE
      DO 160 I = 1, 15
         TMP1 = DFLOAT(I)
         TMP2 = DFLOAT(16-I)
         TMP3 = TMP1
         IF (I .GT. 8) TMP3 = TMP2
         FVEC(I) = Y1(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
  160    CONTINUE
      GO TO 430
C
C     KOWALIK AND OSBORNE FUNCTION.
C
  170 CONTINUE
      DO 180 I = 1, 11
         TMP1 = V(I)*(V(I) + X(2))
         TMP2 = V(I)*(V(I) + X(3)) + X(4)
         FVEC(I) = Y2(I) - X(1)*TMP1/TMP2
  180    CONTINUE
      GO TO 430
C
C     MEYER FUNCTION.
C
  190 CONTINUE
      DO 200 I = 1, 16
         TEMP = FIVE*DFLOAT(I) + C45 + X(3)
         TMP1 = X(2)/TEMP
         TMP2 = DEXP(TMP1)
         FVEC(I) = X(1)*TMP2 - Y3(I)
  200    CONTINUE
      GO TO 430
C
C     WATSON FUNCTION.
C
  210 CONTINUE
      DO 240 I = 1, 29
         DIV = DFLOAT(I)/C29
         S1 = ZERO
         DX = ONE
         DO 220 J = 2, N
            S1 = S1 + DFLOAT(J-1)*DX*X(J)
            DX = DIV*DX
  220       CONTINUE
         S2 = ZERO
         DX = ONE
         DO 230 J = 1, N
            S2 = S2 + DX*X(J)
            DX = DIV*DX
  230       CONTINUE
         FVEC(I) = S1 - S2**2 - ONE
  240    CONTINUE
      FVEC(30) = X(1)
      FVEC(31) = X(2) - X(1)**2 - ONE
      GO TO 430
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  250 CONTINUE
      DO 260 I = 1, M
         TEMP = DFLOAT(I)
         TMP1 = TEMP/TEN
         FVEC(I) = DEXP(-TMP1*X(1)) - DEXP(-TMP1*X(2))
     1             + (DEXP(-TEMP) - DEXP(-TMP1))*X(3)
  260    CONTINUE
      GO TO 430
C
C     JENNRICH AND SAMPSON FUNCTION.
C
  270 CONTINUE
      DO 280 I = 1, M
         TEMP = DFLOAT(I)
         FVEC(I) = TWO + TWO*TEMP - DEXP(TEMP*X(1)) - DEXP(TEMP*X(2))
  280    CONTINUE
      GO TO 430
C
C     BROWN AND DENNIS FUNCTION.
C
  290 CONTINUE
      DO 300 I = 1, M
         TEMP = DFLOAT(I)/FIVE
         TMP1 = X(1) + TEMP*X(2) - DEXP(TEMP)
         TMP2 = X(3) + DSIN(TEMP)*X(4) - DCOS(TEMP)
         FVEC(I) = TMP1**2 + TMP2**2
  300    CONTINUE
      GO TO 430
C
C     CHEBYQUAD FUNCTION.
C
  310 CONTINUE
      DO 320 I = 1, M
         FVEC(I) = ZERO
  320    CONTINUE
      DO 340 J = 1, N
         TMP1 = ONE
         TMP2 = TWO*X(J) - ONE
         TEMP = TWO*TMP2
         DO 330 I = 1, M
            FVEC(I) = FVEC(I) + TMP2
            TI = TEMP*TMP2 - TMP1
            TMP1 = TMP2
            TMP2 = TI
  330       CONTINUE
  340    CONTINUE
      DX = ONE/DFLOAT(N)
      IEV = -1
      DO 350 I = 1, M
         FVEC(I) = DX*FVEC(I)
         IF (IEV .GT. 0) FVEC(I) = FVEC(I) + ONE/(DFLOAT(I)**2 - ONE)
         IEV = -IEV
  350    CONTINUE
      GO TO 430
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  360 CONTINUE
      SUM = -DFLOAT(N+1)
      PROD = ONE
      DO 370 J = 1, N
         SUM = SUM + X(J)
         PROD = X(J)*PROD
  370    CONTINUE
      DO 380 I = 1, N
         FVEC(I) = X(I) + SUM
  380    CONTINUE
      FVEC(N) = PROD - ONE
      GO TO 430
C
C     OSBORNE 1 FUNCTION.
C
  390 CONTINUE
      DO 400 I = 1, 33
         TEMP = TEN*DFLOAT(I-1)
         TMP1 = DEXP(-X(4)*TEMP)
         TMP2 = DEXP(-X(5)*TEMP)
         FVEC(I) = Y4(I) - (X(1) + X(2)*TMP1 + X(3)*TMP2)
  400    CONTINUE
      GO TO 430
C
C     OSBORNE 2 FUNCTION.
C
  410 CONTINUE
      DO 420 I = 1, 65
         TEMP = DFLOAT(I-1)/TEN
         TMP1 = DEXP(-X(5)*TEMP)
         TMP2 = DEXP(-X(6)*(TEMP-X(9))**2)
         TMP3 = DEXP(-X(7)*(TEMP-X(10))**2)
         TMP4 = DEXP(-X(8)*(TEMP-X(11))**2)
         FVEC(I) = Y5(I)
     1             - (X(1)*TMP1 + X(2)*TMP2 + X(3)*TMP3 + X(4)*TMP4)
  420    CONTINUE
  430 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE SSQFCN.
C
      END
      SUBROUTINE SSQJAC(M,N,X,FJAC,LDFJAC,NPROB)                        00000010
      INTEGER M,N,LDFJAC,NPROB
      DOUBLE PRECISION X(N),FJAC(LDFJAC,N)
C     **********
C
C     SUBROUTINE SSQJAC
C
C     THIS SUBROUTINE DEFINES THE JACOBIAN MATRICES OF EIGHTEEN
C     NONLINEAR LEAST SQUARES PROBLEMS. THE PROBLEM DIMENSIONS ARE
C     AS DESCRIBED IN THE PROLOGUE COMMENTS OF SSQFCN.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE SSQJAC(M,N,X,FJAC,LDFJAC,NPROB)
C
C     WHERE
C
C       M AND N ARE POSITIVE INTEGER INPUT VARIABLES. N MUST NOT
C         EXCEED M.
C
C       X IS AN INPUT ARRAY OF LENGTH N.
C
C       FJAC IS AN M BY N OUTPUT ARRAY WHICH CONTAINS THE JACOBIAN
C         MATRIX OF THE NPROB FUNCTION EVALUATED AT X.
C
C       LDFJAC IS A POSITIVE INTEGER INPUT VARIABLE NOT LESS THAN M
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 18.
C
C     SUBPROGRAMS CALLED
C
C       FORTRAN-SUPPLIED ... DATAN,DCOS,DEXP,DSIN,DSQRT
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IVAR,J,K,MM1,NM1
      DOUBLE PRECISION C14,C20,C29,C45,C100,DIV,DX,EIGHT,FIVE,FOUR,
     1                 ONE,PROD,S2,TEMP,TEN,THREE,TI,TMP1,TMP2,TMP3,
     2                 TMP4,TPI,TWO,ZERO
      DOUBLE PRECISION V(11)
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,EIGHT,TEN,C14,C20,C29,C45,C100
     1     /0.0D0,1.0D0,2.0D0,3.0D0,4.0D0,5.0D0,8.0D0,1.0D1,1.4D1,
     2      2.0D1,2.9D1,4.5D1,1.0D2/
      DATA V(1),V(2),V(3),V(4),V(5),V(6),V(7),V(8),V(9),V(10),V(11)
     1     /4.0D0,2.0D0,1.0D0,5.0D-1,2.5D-1,1.67D-1,1.25D-1,1.0D-1,
     2      8.33D-2,7.14D-2,6.25D-2/
      DFLOAT(IVAR) = IVAR
C
C     JACOBIAN ROUTINE SELECTOR.
C
      GO TO (10,40,70,130,140,150,180,190,210,230,250,310,330,350,370,
     1       400,460,480), NPROB
C
C     LINEAR FUNCTION - FULL RANK.
C
   10 CONTINUE
      TEMP = TWO/DFLOAT(M)
      DO 30 J = 1, N
         DO 20 I = 1, M
            FJAC(I,J) = -TEMP
   20       CONTINUE
         FJAC(J,J) = FJAC(J,J) + ONE
   30    CONTINUE
      GO TO 500
C
C     LINEAR FUNCTION - RANK 1.
C
   40 CONTINUE
      DO 60 J = 1, N
         DO 50 I = 1, M
            FJAC(I,J) = DFLOAT(I)*DFLOAT(J)
   50       CONTINUE
   60    CONTINUE
      GO TO 500
C
C     LINEAR FUNCTION - RANK 1 WITH ZERO COLUMNS AND ROWS.
C
   70 CONTINUE
      DO 90 J = 1, N
         DO 80 I = 1, M
            FJAC(I,J) = ZERO
   80       CONTINUE
   90    CONTINUE
      NM1 = N - 1
      MM1 = M - 1
      IF (NM1 .LT. 2) GO TO 120
      DO 110 J = 2, NM1
         DO 100 I = 2, MM1
            FJAC(I,J) = DFLOAT(I-1)*DFLOAT(J)
  100       CONTINUE
  110    CONTINUE
  120 CONTINUE
      GO TO 500
C
C     ROSENBROCK FUNCTION.
C
  130 CONTINUE
      FJAC(1,1) = -C20*X(1)
      FJAC(1,2) = TEN
      FJAC(2,1) = -ONE
      FJAC(2,2) = ZERO
      GO TO 500
C
C     HELICAL VALLEY FUNCTION.
C
  140 CONTINUE
      TPI = EIGHT*DATAN(ONE)
      TEMP = X(1)**2 + X(2)**2
      TMP1 = TPI*TEMP
      TMP2 = DSQRT(TEMP)
      FJAC(1,1) = C100*X(2)/TMP1
      FJAC(1,2) = -C100*X(1)/TMP1
      FJAC(1,3) = TEN
      FJAC(2,1) = TEN*X(1)/TMP2
      FJAC(2,2) = TEN*X(2)/TMP2
      FJAC(2,3) = ZERO
      FJAC(3,1) = ZERO
      FJAC(3,2) = ZERO
      FJAC(3,3) = ONE
      GO TO 500
C
C     POWELL SINGULAR FUNCTION.
C
  150 CONTINUE
      DO 170 J = 1, 4
         DO 160 I = 1, 4
            FJAC(I,J) = ZERO
  160       CONTINUE
  170    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 500
C
C     FREUDENSTEIN AND ROTH FUNCTION.
C
  180 CONTINUE
      FJAC(1,1) = ONE
      FJAC(1,2) = X(2)*(TEN - THREE*X(2)) - TWO
      FJAC(2,1) = ONE
      FJAC(2,2) = X(2)*(TWO + THREE*X(2)) - C14
      GO TO 500
C
C     BARD FUNCTION.
C
  190 CONTINUE
      DO 200 I = 1, 15
         TMP1 = DFLOAT(I)
         TMP2 = DFLOAT(16-I)
         TMP3 = TMP1
         IF (I .GT. 8) TMP3 = TMP2
         TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2
         FJAC(I,1) = -ONE
         FJAC(I,2) = TMP1*TMP2/TMP4
         FJAC(I,3) = TMP1*TMP3/TMP4
  200    CONTINUE
      GO TO 500
C
C     KOWALIK AND OSBORNE FUNCTION.
C
  210 CONTINUE
      DO 220 I = 1, 11
         TMP1 = V(I)*(V(I) + X(2))
         TMP2 = V(I)*(V(I) + X(3)) + X(4)
         FJAC(I,1) = -TMP1/TMP2
         FJAC(I,2) = -V(I)*X(1)/TMP2
         FJAC(I,3) = FJAC(I,1)*FJAC(I,2)
         FJAC(I,4) = FJAC(I,3)/V(I)
  220    CONTINUE
      GO TO 500
C
C     MEYER FUNCTION.
C
  230 CONTINUE
      DO 240 I = 1, 16
         TEMP = FIVE*DFLOAT(I) + C45 + X(3)
         TMP1 = X(2)/TEMP
         TMP2 = DEXP(TMP1)
         FJAC(I,1) = TMP2
         FJAC(I,2) = X(1)*TMP2/TEMP
         FJAC(I,3) = -TMP1*FJAC(I,2)
  240    CONTINUE
      GO TO 500
C
C     WATSON FUNCTION.
C
  250 CONTINUE
      DO 280 I = 1, 29
         DIV = DFLOAT(I)/C29
         S2 = ZERO
         DX = ONE
         DO 260 J = 1, N
            S2 = S2 + DX*X(J)
            DX = DIV*DX
  260       CONTINUE
         TEMP = TWO*DIV*S2
         DX = ONE/DIV
         DO 270 J = 1, N
            FJAC(I,J) = DX*(DFLOAT(J-1) - TEMP)
            DX = DIV*DX
  270       CONTINUE
  280    CONTINUE
      DO 300 J = 1, N
         DO 290 I = 30, 31
            FJAC(I,J) = ZERO
  290       CONTINUE
  300    CONTINUE
      FJAC(30,1) = ONE
      FJAC(31,1) = -TWO*X(1)
      FJAC(31,2) = ONE
      GO TO 500
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  310 CONTINUE
      DO 320 I = 1, M
         TEMP = DFLOAT(I)
         TMP1 = TEMP/TEN
         FJAC(I,1) = -TMP1*DEXP(-TMP1*X(1))
         FJAC(I,2) = TMP1*DEXP(-TMP1*X(2))
         FJAC(I,3) = DEXP(-TEMP) - DEXP(-TMP1)
  320    CONTINUE
      GO TO 500
C
C     JENNRICH AND SAMPSON FUNCTION.
C
  330 CONTINUE
      DO 340 I = 1, M
         TEMP = DFLOAT(I)
         FJAC(I,1) = -TEMP*DEXP(TEMP*X(1))
         FJAC(I,2) = -TEMP*DEXP(TEMP*X(2))
  340    CONTINUE
      GO TO 500
C
C     BROWN AND DENNIS FUNCTION.
C
  350 CONTINUE
      DO 360 I = 1, M
         TEMP = DFLOAT(I)/FIVE
         TI = DSIN(TEMP)
         TMP1 = X(1) + TEMP*X(2) - DEXP(TEMP)
         TMP2 = X(3) + TI*X(4) - DCOS(TEMP)
         FJAC(I,1) = TWO*TMP1
         FJAC(I,2) = TEMP*FJAC(I,1)
         FJAC(I,3) = TWO*TMP2
         FJAC(I,4) = TI*FJAC(I,3)
  360    CONTINUE
      GO TO 500
C
C     CHEBYQUAD FUNCTION.
C
  370 CONTINUE
      DX = ONE/DFLOAT(N)
      DO 390 J = 1, N
         TMP1 = ONE
         TMP2 = TWO*X(J) - ONE
         TEMP = TWO*TMP2
         TMP3 = ZERO
         TMP4 = TWO
         DO 380 I = 1, M
            FJAC(I,J) = DX*TMP4
            TI = FOUR*TMP2 + TEMP*TMP4 - TMP3
            TMP3 = TMP4
            TMP4 = TI
            TI = TEMP*TMP2 - TMP1
            TMP1 = TMP2
            TMP2 = TI
  380       CONTINUE
  390    CONTINUE
      GO TO 500
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  400 CONTINUE
      PROD = ONE
      DO 420 J = 1, N
         PROD = X(J)*PROD
         DO 410 I = 1, N
            FJAC(I,J) = ONE
  410       CONTINUE
         FJAC(J,J) = TWO
  420    CONTINUE
      DO 450 J = 1, N
         TEMP = X(J)
         IF (TEMP .NE. ZERO) GO TO 440
         TEMP = ONE
         PROD = ONE
         DO 430 K = 1, N
            IF (K .NE. J) PROD = X(K)*PROD
  430       CONTINUE
  440    CONTINUE
         FJAC(N,J) = PROD/TEMP
  450    CONTINUE
      GO TO 500
C
C     OSBORNE 1 FUNCTION.
C
  460 CONTINUE
      DO 470 I = 1, 33
         TEMP = TEN*DFLOAT(I-1)
         TMP1 = DEXP(-X(4)*TEMP)
         TMP2 = DEXP(-X(5)*TEMP)
         FJAC(I,1) = -ONE
         FJAC(I,2) = -TMP1
         FJAC(I,3) = -TMP2
         FJAC(I,4) = TEMP*X(2)*TMP1
         FJAC(I,5) = TEMP*X(3)*TMP2
  470    CONTINUE
      GO TO 500
C
C     OSBORNE 2 FUNCTION.
C
  480 CONTINUE
      DO 490 I = 1, 65
         TEMP = DFLOAT(I-1)/TEN
         TMP1 = DEXP(-X(5)*TEMP)
         TMP2 = DEXP(-X(6)*(TEMP-X(9))**2)
         TMP3 = DEXP(-X(7)*(TEMP-X(10))**2)
         TMP4 = DEXP(-X(8)*(TEMP-X(11))**2)
         FJAC(I,1) = -TMP1
         FJAC(I,2) = -TMP2
         FJAC(I,3) = -TMP3
         FJAC(I,4) = -TMP4
         FJAC(I,5) = TEMP*X(1)*TMP1
         FJAC(I,6) = X(2)*(TEMP - X(9))**2*TMP2
         FJAC(I,7) = X(3)*(TEMP - X(10))**2*TMP3
         FJAC(I,8) = X(4)*(TEMP - X(11))**2*TMP4
         FJAC(I,9) = -TWO*X(2)*X(6)*(TEMP - X(9))*TMP2
         FJAC(I,10) = -TWO*X(3)*X(7)*(TEMP - X(10))*TMP3
         FJAC(I,11) = -TWO*X(4)*X(8)*(TEMP - X(11))*TMP4
  490    CONTINUE
  500 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE SSQJAC.
C
      END
C ===== 4. DOUBLE PRECISION TESTING AIDS FOR UNCONSTRAINED NONLINEAR
C =====     OPTIMIZATION.
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)                               00000010
      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 THE
C     FUNCTIONS DEFINED BY SUBROUTINE OBJFCN. THE SUBROUTINE RETURNS
C     IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR
C     THE SEVENTH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN
C     THIS CASE, IF FACTOR IS NOT UNITY, THEN THE SUBROUTINE RETURNS
C     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 18.
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     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER IVAR,J
      DOUBLE PRECISION C1,C2,C3,C4,FIVE,H,HALF,ONE,TEN,THREE,TWENTY,
     1                 TWNTF,TWO,ZERO
      DOUBLE PRECISION DFLOAT
      DATA ZERO,HALF,ONE,TWO,THREE,FIVE,TEN,TWENTY,TWNTF
     1     /0.0D0,0.5D0,1.0D0,2.0D0,3.0D0,5.0D0,1.0D1,2.0D1,2.5D1/
      DATA C1,C2,C3,C4 /4.0D-1,2.5D0,1.5D-1,1.2D0/
      DFLOAT(IVAR) = IVAR
C
C     SELECTION OF INITIAL POINT.
C
      GO TO (10,20,30,40,50,60,80,100,120,140,150,160,170,190,210,230,
     1       240,250), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
   10 CONTINUE
      X(1) = -ONE
      X(2) = ZERO
      X(3) = ZERO
      GO TO 270
C
C     BIGGS EXP6 FUNCTION.
C
   20 CONTINUE
      X(1) = ONE
      X(2) = TWO
      X(3) = ONE
      X(4) = ONE
      X(5) = ONE
      X(6) = ONE
      GO TO 270
C
C     GAUSSIAN FUNCTION.
C
   30 CONTINUE
      X(1) = C1
      X(2) = ONE
      X(3) = ZERO
      GO TO 270
C
C     POWELL BADLY SCALED FUNCTION.
C
   40 CONTINUE
      X(1) = ZERO
      X(2) = ONE
      GO TO 270
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
   50 CONTINUE
      X(1) = ZERO
      X(2) = TEN
      X(3) = TWENTY
      GO TO 270
C
C     VARIABLY DIMENSIONED FUNCTION.
C
   60 CONTINUE
      H = ONE/DFLOAT(N)
      DO 70 J = 1, N
         X(J) = ONE - DFLOAT(J)*H
   70    CONTINUE
      GO TO 270
C
C     WATSON FUNCTION.
C
   80 CONTINUE
      DO 90 J = 1, N
         X(J) = ZERO
   90    CONTINUE
      GO TO 270
C
C     PENALTY FUNCTION I.
C
  100 CONTINUE
      DO 110 J = 1, N
         X(J) = DFLOAT(J)
  110    CONTINUE
      GO TO 270
C
C     PENALTY FUNCTION II.
C
  120 CONTINUE
      DO 130 J = 1, N
         X(J) = HALF
  130    CONTINUE
      GO TO 270
C
C     BROWN BADLY SCALED FUNCTION.
C
  140 CONTINUE
      X(1) = ONE
      X(2) = ONE
      GO TO 270
C
C     BROWN AND DENNIS FUNCTION.
C
  150 CONTINUE
      X(1) = TWNTF
      X(2) = FIVE
      X(3) = -FIVE
      X(4) = -ONE
      GO TO 270
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
  160 CONTINUE
      X(1) = FIVE
      X(2) = C2
      X(3) = C3
      GO TO 270
C
C     TRIGONOMETRIC FUNCTION.
C
  170 CONTINUE
      H = ONE/DFLOAT(N)
      DO 180 J = 1, N
         X(J) = H
  180    CONTINUE
      GO TO 270
C
C     EXTENDED ROSENBROCK FUNCTION.
C
  190 CONTINUE
      DO 200 J = 1, N, 2
         X(J) = -C4
         X(J+1) = ONE
  200    CONTINUE
      GO TO 270
C
C     EXTENDED POWELL SINGULAR FUNCTION.
C
  210 CONTINUE
      DO 220 J = 1, N, 4
         X(J) = THREE
         X(J+1) = -ONE
         X(J+2) = ZERO
         X(J+3) = ONE
  220    CONTINUE
      GO TO 270
C
C     BEALE FUNCTION.
C
  230 CONTINUE
      X(1) = ONE
      X(2) = ONE
      GO TO 270
C
C     WOOD FUNCTION.
C
  240 CONTINUE
      X(1) = -THREE
      X(2) = -ONE
      X(3) = -THREE
      X(4) = -ONE
      GO TO 270
C
C     CHEBYQUAD FUNCTION.
C
  250 CONTINUE
      H = ONE/DFLOAT(N+1)
      DO 260 J = 1, N
         X(J) = DFLOAT(J)*H
  260    CONTINUE
  270 CONTINUE
C
C     COMPUTE MULTIPLE OF INITIAL POINT.
C
      IF (FACTOR .EQ. ONE) GO TO 320
      IF (NPROB .EQ. 7) GO TO 290
         DO 280 J = 1, N
            X(J) = FACTOR*X(J)
  280       CONTINUE
         GO TO 310
  290 CONTINUE
         DO 300 J = 1, N
            X(J) = FACTOR
  300       CONTINUE
  310 CONTINUE
  320 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE INITPT.
C
      END
      SUBROUTINE OBJFCN(N,X,F,NPROB)                                    00000010
      INTEGER N,NPROB
      DOUBLE PRECISION F
      DOUBLE PRECISION X(N)
C     **********
C
C     SUBROUTINE OBJFCN
C
C     THIS SUBROUTINE DEFINES THE OBJECTIVE FUNCTIONS OF EIGHTEEN
C     NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS. THE VALUES
C     OF N FOR FUNCTIONS 1,2,3,4,5,10,11,12,16 AND 17 ARE
C     3,6,3,2,3,2,4,3,2 AND 4, RESPECTIVELY.
C     FOR FUNCTION 7, N MAY BE 2 OR GREATER BUT IS USUALLY 6 OR 9.
C     FOR FUNCTIONS 6,8,9,13,14,15 AND 18 N MAY BE VARIABLE,
C     HOWEVER IT MUST BE EVEN FOR FUNCTION 14, A MULTIPLE OF 4 FOR
C     FUNCTION 15, AND NOT GREATER THAN 50 FOR FUNCTION 18.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE OBJFCN(N,X,F,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       F IS AN OUTPUT VARIABLE WHICH CONTAINS THE VALUE OF
C         THE NPROB OBJECTIVE FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS CALLED
C
C       FORTRAN-SUPPLIED ... DABS,DATAN,DCOS,DEXP,DLOG,DSIGN,DSIN,
C                            DSQRT
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IEV,IVAR,J
      DOUBLE PRECISION AP,ARG,BP,C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,
     1                 C2P25,C2P625,C3P5,C25,C29,C90,C100,C10000,
     2                 C1PD6,D1,D2,EIGHT,FIFTY,FIVE,FOUR,ONE,R,S1,S2,
     3                 S3,T,T1,T2,T3,TEN,TH,THREE,TPI,TWO,ZERO
      DOUBLE PRECISION FVEC(50),Y(15)
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,EIGHT,TEN,FIFTY
     1     /0.0D0,1.0D0,2.0D0,3.0D0,4.0D0,5.0D0,8.0D0,1.0D1,5.0D1/
      DATA C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,C2P25,C2P625,C3P5,C25,
     1     C29,C90,C100,C10000,C1PD6
     2     /2.0D-6,1.0D-4,1.0D-1,2.0D-1,2.5D-1,5.0D-1,1.5D0,2.25D0,
     3      2.625D0,3.5D0,2.5D1,2.9D1,9.0D1,1.0D2,1.0D4,1.0D6/
      DATA AP,BP /1.0D-5,1.0D0/
      DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),Y(9),Y(10),Y(11),
     1     Y(12),Y(13),Y(14),Y(15)
     2     /9.0D-4,4.4D-3,1.75D-2,5.4D-2,1.295D-1,2.42D-1,3.521D-1,
     3      3.989D-1,3.521D-1,2.42D-1,1.295D-1,5.4D-2,1.75D-2,4.4D-3,
     4      9.0D-4/
      DFLOAT(IVAR) = IVAR
C
C     FUNCTION ROUTINE SELECTOR.
C
      GO TO (10,20,40,60,70,90,110,150,170,200,210,230,250,280,300,
     1       320,330,340), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
   10 CONTINUE
      TPI = EIGHT*DATAN(ONE)
      TH = DSIGN(CP25,X(2))
      IF (X(1) .GT. ZERO) TH = DATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TH = DATAN(X(2)/X(1))/TPI + CP5
      ARG = X(1)**2 + X(2)**2
      R = DSQRT(ARG)
      T = X(3) - TEN*TH
      F = C100*(T**2 + (R - ONE)**2) + X(3)**2
      GO TO 390
C
C     BIGGS EXP6 FUNCTION.
C
   20 CONTINUE
      F = ZERO
      DO 30 I = 1, 13
         D1 = DFLOAT(I)/TEN
         D2 = DEXP(-D1) - FIVE*DEXP(-TEN*D1) + THREE*DEXP(-FOUR*D1)
         S1 = DEXP(-D1*X(1))
         S2 = DEXP(-D1*X(2))
         S3 = DEXP(-D1*X(5))
         T = X(3)*S1 - X(4)*S2 + X(6)*S3 - D2
         F = F + T**2
   30    CONTINUE
      GO TO 390
C
C     GAUSSIAN FUNCTION.
C
   40 CONTINUE
      F = ZERO
      DO 50 I = 1, 15
         D1 = CP5*DFLOAT(I-1)
         D2 = C3P5 - D1 - X(3)
         ARG = -CP5*X(2)*D2**2
         R = DEXP(ARG)
         T = X(1)*R - Y(I)
         F = F + T**2
   50    CONTINUE
      GO TO 390
C
C     POWELL BADLY SCALED FUNCTION.
C
   60 CONTINUE
      T1 = C10000*X(1)*X(2) - ONE
      S1 = DEXP(-X(1))
      S2 = DEXP(-X(2))
      T2 = S1 + S2 - ONE - CP0001
      F = T1**2 + T2**2
      GO TO 390
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
   70 CONTINUE
      F = ZERO
      DO 80 I = 1, 10
         D1 = DFLOAT(I)
         D2 = D1/TEN
         S1 = DEXP(-D2*X(1))
         S2 = DEXP(-D2*X(2))
         S3 = DEXP(-D2) - DEXP(-D1)
         T = S1 - S2 - S3*X(3)
         F = F + T**2
   80    CONTINUE
      GO TO 390
C
C     VARIABLY DIMENSIONED FUNCTION.
C
   90 CONTINUE
      T1 = ZERO
      T2 = ZERO
      DO 100 J = 1, N
         T1 = T1 + DFLOAT(J)*(X(J) - ONE)
         T2 = T2 + (X(J) - ONE)**2
  100    CONTINUE
      F = T2 + T1**2*(ONE + T1**2)
      GO TO 390
C
C     WATSON FUNCTION.
C
  110 CONTINUE
      F = ZERO
      DO 140 I = 1, 29
         D1 = DFLOAT(I)/C29
         S1 = ZERO
         D2 = ONE
         DO 120 J = 2, N
            S1 = S1 + DFLOAT(J-1)*D2*X(J)
            D2 = D1*D2
  120       CONTINUE
         S2 = ZERO
         D2 = ONE
         DO 130 J = 1, N
            S2 = S2 + D2*X(J)
            D2 = D1*D2
  130       CONTINUE
         T = S1 - S2**2 - ONE
         F = F + T**2
  140    CONTINUE
      T1 = X(2) - X(1)**2 - ONE
      F = F + X(1)**2 + T1**2
      GO TO 390
C
C     PENALTY FUNCTION I.
C
  150 CONTINUE
      T1 = -CP25
      T2 = ZERO
      DO 160 J = 1, N
         T1 = T1 + X(J)**2
         T2 = T2 + (X(J) - ONE)**2
  160    CONTINUE
      F = AP*T2 + BP*T1**2
      GO TO 390
C
C     PENALTY FUNCTION II.
C
  170 CONTINUE
      T1 = -ONE
      T2 = ZERO
      T3 = ZERO
      D1 = DEXP(CP1)
      D2 = ONE
      DO 190 J = 1, N
         T1 = T1 + DFLOAT(N-J+1)*X(J)**2
         S1 = DEXP(X(J)/TEN)
         IF (J .EQ. 1) GO TO 180
         S3 = S1 + S2 - D2*(D1 + ONE)
         T2 = T2 + S3**2
         T3 = T3 + (S1 - ONE/D1)**2
  180    CONTINUE
         S2 = S1
         D2 = D1*D2
  190    CONTINUE
      F = AP*(T2 + T3) + BP*(T1**2 + (X(1) - CP2)**2)
      GO TO 390
C
C     BROWN BADLY SCALED FUNCTION.
C
  200 CONTINUE
      T1 = X(1) - C1PD6
      T2 = X(2) - C2PDM6
      T3 = X(1)*X(2) - TWO
      F = T1**2 + T2**2 + T3**2
      GO TO 390
C
C     BROWN AND DENNIS FUNCTION.
C
  210 CONTINUE
      F = ZERO
      DO 220 I = 1, 20
         D1 = DFLOAT(I)/FIVE
         D2 = DSIN(D1)
         T1 = X(1) + D1*X(2) - DEXP(D1)
         T2 = X(3) + D2*X(4) - DCOS(D1)
         T = T1**2 + T2**2
         F = F + T**2
  220    CONTINUE
      GO TO 390
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
  230 CONTINUE
      F = ZERO
      D1 = TWO/THREE
      DO 240 I = 1, 99
         ARG = DFLOAT(I)/C100
         R = DABS((-FIFTY*DLOG(ARG))**D1+C25-X(2))
         T1 = R**X(3)/X(1)
         T2 = DEXP(-T1)
         T = T2 - ARG
         F = F + T**2
  240    CONTINUE
      GO TO 390
C
C     TRIGONOMETRIC FUNCTION.
C
  250 CONTINUE
      S1 = ZERO
      DO 260 J = 1, N
         S1 = S1 + DCOS(X(J))
  260    CONTINUE
      F = ZERO
      DO 270 J = 1, N
         T = DFLOAT(N+J) - DSIN(X(J)) - S1 - DFLOAT(J)*DCOS(X(J))
         F = F + T**2
  270    CONTINUE
      GO TO 390
C
C     EXTENDED ROSENBROCK FUNCTION.
C
  280 CONTINUE
      F = ZERO
      DO 290 J = 1, N, 2
         T1 = ONE - X(J)
         T2 = TEN*(X(J+1) - X(J)**2)
         F = F + T1**2 + T2**2
  290    CONTINUE
      GO TO 390
C
C     EXTENDED POWELL FUNCTION.
C
  300 CONTINUE
      F = ZERO
      DO 310 J = 1, N, 4
         T = X(J) + TEN*X(J+1)
         T1 = X(J+2) - X(J+3)
         S1 = FIVE*T1
         T2 = X(J+1) - TWO*X(J+2)
         S2 = T2**3
         T3 = X(J) - X(J+3)
         S3 = TEN*T3**3
         F = F + T**2 + S1*T1 + S2*T2 + S3*T3
  310    CONTINUE
      GO TO 390
C
C     BEALE FUNCTION.
C
  320 CONTINUE
      S1 = ONE - X(2)
      T1 = C1P5 - X(1)*S1
      S2 = ONE - X(2)**2
      T2 = C2P25 - X(1)*S2
      S3 = ONE - X(2)**3
      T3 = C2P625 - X(1)*S3
      F = T1**2 + T2**2 + T3**2
      GO TO 390
C
C     WOOD FUNCTION.
C
  330 CONTINUE
      S1 = X(2) - X(1)**2
      S2 = ONE - X(1)
      S3 = X(2) - ONE
      T1 = X(4) - X(3)**2
      T2 = ONE - X(3)
      T3 = X(4) - ONE
      F = C100*S1**2 + S2**2 + C90*T1**2 + T2**2 + TEN*(S3 + T3)**2
     1    + (S3 - T3)**2/TEN
      GO TO 390
C
C     CHEBYQUAD FUNCTION.
C
  340 CONTINUE
      DO 350 I = 1, N
         FVEC(I) = ZERO
  350    CONTINUE
      DO 370 J = 1, N
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         DO 360 I = 1, N
            FVEC(I) = FVEC(I) + T2
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
  360       CONTINUE
  370    CONTINUE
      F = ZERO
      D1 = ONE/DFLOAT(N)
      IEV = -1
      DO 380 I = 1, N
         T = D1*FVEC(I)
         IF (IEV .GT. 0) T = T + ONE/(DFLOAT(I)**2 - ONE)
         F = F + T**2
         IEV = -IEV
  380    CONTINUE
  390 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE OBJFCN.
C
      END
      SUBROUTINE GRDFCN(N,X,G,NPROB)                                    00000010
      INTEGER N,NPROB
      DOUBLE PRECISION X(N),G(N)
C     **********
C
C     SUBROUTINE GRDFCN
C
C     THIS SUBROUTINE DEFINES THE GRADIENT VECTORS OF EIGHTEEN
C     NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS. THE PROBLEM
C     DIMENSIONS ARE AS DESCRIBED IN THE PROLOGUE COMMENTS OF OBJFCN.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE GRDFCN(N,X,G,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       G IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE COMPONENTS
C         OF THE GRADIENT VECTOR OF THE NPROB OBJECTIVE FUNCTION
C         EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS CALLED
C
C       FORTRAN-SUPPLIED ... DABS,DATAN,DCOS,DEXP,DLOG,DSIGN,DSIN,
C                            DSQRT
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IEV,IVAR,J
      DOUBLE PRECISION AP,ARG,BP,C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,
     1                 C2P25,C2P625,C3P5,C19P8,C20P2,C25,C29,C100,
     2                 C180,C200,C10000,C1PD6,D1,D2,EIGHT,FIFTY,FIVE,
     3                 FOUR,ONE,R,S1,S2,S3,T,T1,T2,T3,TEN,TH,THREE,
     4                 TPI,TWENTY,TWO,ZERO
      DOUBLE PRECISION FVEC(50),Y(15)
      DOUBLE PRECISION DFLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,EIGHT,TEN,TWENTY,FIFTY
     1     /0.0D0,1.0D0,2.0D0,3.0D0,4.0D0,5.0D0,8.0D0,1.0D1,2.0D1,
     2      5.0D1/
      DATA C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,C2P25,C2P625,C3P5,
     1     C19P8,C20P2,C25,C29,C100,C180,C200,C10000,C1PD6
     2     /2.0D-6,1.0D-4,1.0D-1,2.0D-1,2.5D-1,5.0D-1,1.5D0,2.25D0,
     3      2.625D0,3.5D0,1.98D1,2.02D1,2.5D1,2.9D1,1.0D2,1.8D2,2.0D2,
     4      1.0D4,1.0D6/
      DATA AP,BP /1.0D-5,1.0D0/
      DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),Y(9),Y(10),Y(11),
     1     Y(12),Y(13),Y(14),Y(15)
     2     /9.0D-4,4.4D-3,1.75D-2,5.4D-2,1.295D-1,2.42D-1,3.521D-1,
     3      3.989D-1,3.521D-1,2.42D-1,1.295D-1,5.4D-2,1.75D-2,4.4D-3,
     4      9.0D-4/
      DFLOAT(IVAR) = IVAR
C
C     GRADIENT ROUTINE SELECTOR.
C
      GO TO (10,20,50,70,80,100,130,190,220,260,270,290,310,350,370,
     1       390,400,410), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
   10 CONTINUE
      TPI = EIGHT*DATAN(ONE)
      TH = DSIGN(CP25,X(2))
      IF (X(1) .GT. ZERO) TH = DATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TH = DATAN(X(2)/X(1))/TPI + CP5
      ARG = X(1)**2 + X(2)**2
      R = DSQRT(ARG)
      T = X(3) - TEN*TH
      S1 = TEN*T/(TPI*ARG)
      G(1) = C200*(X(1) - X(1)/R + X(2)*S1)
      G(2) = C200*(X(2) - X(2)/R - X(1)*S1)
      G(3) = TWO*(C100*T + X(3))
      GO TO 490
C
C     BIGGS EXP6 FUNCTION.
C
   20 CONTINUE
      DO 30 J = 1, N
         G(J) = ZERO
   30    CONTINUE
      DO 40 I = 1, 13
         D1 = DFLOAT(I)/TEN
         D2 = DEXP(-D1) - FIVE*DEXP(-TEN*D1) + THREE*DEXP(-FOUR*D1)
         S1 = DEXP(-D1*X(1))
         S2 = DEXP(-D1*X(2))
         S3 = DEXP(-D1*X(5))
         T = X(3)*S1 - X(4)*S2 + X(6)*S3 - D2
         TH = D1*T
         G(1) = G(1) - S1*TH
         G(2) = G(2) + S2*TH
         G(3) = G(3) + S1*T
         G(4) = G(4) - S2*T
         G(5) = G(5) - S3*TH
         G(6) = G(6) + S3*T
   40    CONTINUE
      G(1) = TWO*X(3)*G(1)
      G(2) = TWO*X(4)*G(2)
      G(3) = TWO*G(3)
      G(4) = TWO*G(4)
      G(5) = TWO*X(6)*G(5)
      G(6) = TWO*G(6)
      GO TO 490
C
C     GAUSSIAN FUNCTION.
C
   50 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      DO 60 I = 1, 15
         D1 = CP5*DFLOAT(I-1)
         D2 = C3P5 - D1 - X(3)
         ARG = -CP5*X(2)*D2**2
         R = DEXP(ARG)
         T = X(1)*R - Y(I)
         S1 = R*T
         S2 = D2*S1
         G(1) = G(1) + S1
         G(2) = G(2) - D2*S2
         G(3) = G(3) + S2
   60    CONTINUE
      G(1) = TWO*G(1)
      G(2) = X(1)*G(2)
      G(3) = TWO*X(1)*X(2)*G(3)
      GO TO 490
C
C     POWELL BADLY SCALED FUNCTION.
C
   70 CONTINUE
      T1 = C10000*X(1)*X(2) - ONE
      S1 = DEXP(-X(1))
      S2 = DEXP(-X(2))
      T2 = S1 + S2 - ONE - CP0001
      G(1) = TWO*(C10000*X(2)*T1 - S1*T2)
      G(2) = TWO*(C10000*X(1)*T1 - S2*T2)
      GO TO 490
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
   80 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      DO 90 I = 1, 10
         D1 = DFLOAT(I)
         D2 = D1/TEN
         S1 = DEXP(-D2*X(1))
         S2 = DEXP(-D2*X(2))
         S3 = DEXP(-D2) - DEXP(-D1)
         T = S1 - S2 - S3*X(3)
         TH = D2*T
         G(1) = G(1) - S1*TH
         G(2) = G(2) + S2*TH
         G(3) = G(3) - S3*T
   90    CONTINUE
      G(1) = TWO*G(1)
      G(2) = TWO*G(2)
      G(3) = TWO*G(3)
      GO TO 490
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  100 CONTINUE
      T1 = ZERO
      DO 110 J = 1, N
         T1 = T1 + DFLOAT(J)*(X(J) - ONE)
  110    CONTINUE
      T = T1*(ONE + TWO*T1**2)
      DO 120 J = 1, N
         G(J) = TWO*(X(J) - ONE + DFLOAT(J)*T)
  120    CONTINUE
      GO TO 490
C
C     WATSON FUNCTION.
C
  130 CONTINUE
      DO 140 J = 1, N
         G(J) = ZERO
  140    CONTINUE
      DO 180 I = 1, 29
         D1 = DFLOAT(I)/C29
         S1 = ZERO
         D2 = ONE
         DO 150 J = 2, N
            S1 = S1 + DFLOAT(J-1)*D2*X(J)
            D2 = D1*D2
  150       CONTINUE
         S2 = ZERO
         D2 = ONE
         DO 160 J = 1, N
            S2 = S2 + D2*X(J)
            D2 = D1*D2
  160       CONTINUE
         T = S1 - S2**2 - ONE
         S3 = TWO*D1*S2
         D2 = TWO/D1
         DO 170 J = 1, N
            G(J) = G(J) + D2*(DFLOAT(J-1) - S3)*T
            D2 = D1*D2
  170       CONTINUE
  180    CONTINUE
      T1 = X(2) - X(1)**2 - ONE
      G(1) = G(1) + X(1)*(TWO - FOUR*T1)
      G(2) = G(2) + TWO*T1
      GO TO 490
C
C     PENALTY FUNCTION I.
C
  190 CONTINUE
      T1 = -CP25
      DO 200 J = 1, N
         T1 = T1 + X(J)**2
  200    CONTINUE
      D1 = TWO*AP
      TH = FOUR*BP*T1
      DO 210 J = 1, N
         G(J) = D1*(X(J) - ONE) + X(J)*TH
  210    CONTINUE
      GO TO 490
C
C     PENALTY FUNCTION II.
C
  220 CONTINUE
      T1 = -ONE
      DO 230 J = 1, N
         T1 = T1 + DFLOAT(N-J+1)*X(J)**2
  230    CONTINUE
      D1 = DEXP(CP1)
      D2 = ONE
      TH = FOUR*BP*T1
      DO 250 J = 1, N
         G(J) = DFLOAT(N-J+1)*X(J)*TH
         S1 = DEXP(X(J)/TEN)
         IF (J .EQ. 1) GO TO 240
         S3 = S1 + S2 - D2*(D1 + ONE)
         G(J) = G(J) + AP*S1*(S3 + S1 - ONE/D1)/FIVE
         G(J-1) = G(J-1) + AP*S2*S3/FIVE
  240    CONTINUE
         S2 = S1
         D2 = D1*D2
  250    CONTINUE
      G(1) = G(1) + TWO*BP*(X(1) - CP2)
      GO TO 490
C
C     BROWN BADLY SCALED FUNCTION.
C
  260 CONTINUE
      T1 = X(1) - C1PD6
      T2 = X(2) - C2PDM6
      T3 = X(1)*X(2) - TWO
      G(1) = TWO*(T1 + X(2)*T3)
      G(2) = TWO*(T2 + X(1)*T3)
      GO TO 490
C
C     BROWN AND DENNIS FUNCTION.
C
  270 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      G(4) = ZERO
      DO 280 I = 1, 20
         D1 = DFLOAT(I)/FIVE
         D2 = DSIN(D1)
         T1 = X(1) + D1*X(2) - DEXP(D1)
         T2 = X(3) + D2*X(4) - DCOS(D1)
         T = T1**2 + T2**2
         S1 = T1*T
         S2 = T2*T
         G(1) = G(1) + S1
         G(2) = G(2) + D1*S1
         G(3) = G(3) + S2
         G(4) = G(4) + D2*S2
  280    CONTINUE
      G(1) = FOUR*G(1)
      G(2) = FOUR*G(2)
      G(3) = FOUR*G(3)
      G(4) = FOUR*G(4)
      GO TO 490
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
  290 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      D1 = TWO/THREE
      DO 300 I = 1, 99
         ARG = DFLOAT(I)/C100
         R = DABS((-FIFTY*DLOG(ARG))**D1+C25-X(2))
         T1 = R**X(3)/X(1)
         T2 = DEXP(-T1)
         T = T2 - ARG
         S1 = T1*T2*T
         G(1) = G(1) + S1
         G(2) = G(2) + S1/R
         G(3) = G(3) - S1*DLOG(R)
  300    CONTINUE
      G(1) = TWO*G(1)/X(1)
      G(2) = TWO*X(3)*G(2)
      G(3) = TWO*G(3)
      GO TO 490
C
C     TRIGONOMETRIC FUNCTION.
C
  310 CONTINUE
      S1 = ZERO
      DO 320 J = 1, N
         G(J) = DCOS(X(J))
         S1 = S1 + G(J)
  320    CONTINUE
      S2 = ZERO
      DO 330 J = 1, N
         TH = DSIN(X(J))
         T = DFLOAT(N+J) - TH - S1 - DFLOAT(J)*G(J)
         S2 = S2 + T
         G(J) = (DFLOAT(J)*TH - G(J))*T
  330    CONTINUE
      DO 340 J = 1, N
         G(J) = TWO*(G(J) + DSIN(X(J))*S2)
  340    CONTINUE
      GO TO 490
C
C     EXTENDED ROSENBROCK FUNCTION.
C
  350 CONTINUE
      DO 360 J = 1, N, 2
         T1 = ONE - X(J)
         G(J+1) = C200*(X(J+1) - X(J)**2)
         G(J) = -TWO*(X(J)*G(J+1) + T1)
  360    CONTINUE
      GO TO 490
C
C     EXTENDED POWELL FUNCTION.
C
  370 CONTINUE
      DO 380 J = 1, N, 4
         T = X(J) + TEN*X(J+1)
         T1 = X(J+2) - X(J+3)
         S1 = FIVE*T1
         T2 = X(J+1) - TWO*X(J+2)
         S2 = FOUR*T2**3
         T3 = X(J) - X(J+3)
         S3 = TWENTY*T3**3
         G(J) = TWO*(T + S3)
         G(J+1) = TWENTY*T + S2
         G(J+2) = TWO*(S1 - S2)
         G(J+3) = -TWO*(S1 + S3)
  380    CONTINUE
      GO TO 490
C
C     BEALE FUNCTION.
C
  390 CONTINUE
      S1 = ONE - X(2)
      T1 = C1P5 - X(1)*S1
      S2 = ONE - X(2)**2
      T2 = C2P25 - X(1)*S2
      S3 = ONE - X(2)**3
      T3 = C2P625 - X(1)*S3
      G(1) = -TWO*(S1*T1 + S2*T2 + S3*T3)
      G(2) = TWO*X(1)*(T1 + X(2)*(TWO*T2 + THREE*X(2)*T3))
      GO TO 490
C
C     WOOD FUNCTION.
C
  400 CONTINUE
      S1 = X(2) - X(1)**2
      S2 = ONE - X(1)
      S3 = X(2) - ONE
      T1 = X(4) - X(3)**2
      T2 = ONE - X(3)
      T3 = X(4) - ONE
      G(1) = -TWO*(C200*X(1)*S1 + S2)
      G(2) = C200*S1 + C20P2*S3 + C19P8*T3
      G(3) = -TWO*(C180*X(3)*T1 + T2)
      G(4) = C180*T1 + C20P2*T3 + C19P8*S3
      GO TO 490
C
C     CHEBYQUAD FUNCTION.
C
  410 CONTINUE
      DO 420 I = 1, N
         FVEC(I) = ZERO
  420    CONTINUE
      DO 440 J = 1, N
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         DO 430 I = 1, N
            FVEC(I) = FVEC(I) + T2
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
  430       CONTINUE
  440    CONTINUE
      D1 = ONE/DFLOAT(N)
      IEV = -1
      DO 450 I = 1, N
         FVEC(I) = D1*FVEC(I)
         IF (IEV .GT. 0) FVEC(I) = FVEC(I) + ONE/(DFLOAT(I)**2 - ONE)
         IEV = -IEV
  450    CONTINUE
      DO 470 J = 1, N
         G(J) = ZERO
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         S1 = ZERO
         S2 = TWO
         DO 460 I = 1, N
            G(J) = G(J) + FVEC(I)*S2
            TH = FOUR*T2 + T*S2 - S1
            S1 = S2
            S2 = TH
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
  460       CONTINUE
  470    CONTINUE
      D2 = TWO*D1
      DO 480 J = 1, N
         G(J) = D2*G(J)
  480    CONTINUE
  490 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE GRDFCN.
C
      END
C ===== 5. SINGLE PRECISION TESTING AIDS FOR NONLINEAR EQUATIONS.
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)                               00000010
      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 SUBROUTINES COMFCN AND VECFCN. THE
C     SUBROUTINE RETURNS IN X A MULTIPLE (FACTOR) OF THE STANDARD
C     STARTING POINT. FOR THE SIXTH FUNCTION THE STANDARD STARTING
C     POINT IS ZERO, SO IN THIS CASE, IF FACTOR IS NOT UNITY, THEN
C     THE 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 VARIABLE.
C
C       X IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE
C         STANDARD STARTING POINT FOR PROBLEM NPROB MULTIPLIED BY
C         FACTOR.
C
C       NPROB IS A POSITIVE INTEGER VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 14.
C
C       FACTOR SPECIFIES THE MULTIPLE OF THE STANDARD STARTING
C         POINT. IF FACTOR IS UNITY, NO MULTIPLICATION IS PERFORMED.
C
C     MINPACK. VERSION OF JULY 1978.
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 COMFCN(N,K,X,FCNK,NPROB)                               00000010
      INTEGER N,K,NPROB
      REAL FCNK
      REAL X(N)
C     **********
C
C     SUBROUTINE COMFCN
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 COMFCN(N,K,X,FCNK,NPROB)
C
C     WHERE
C
C       N IS A POSITIVE INTEGER INPUT VARIABLE.
C
C       K IS A POSITIVE INTEGER INPUT VARIABLE NOT GREATER THAN N.
C
C       X IS AN INPUT ARRAY OF LENGTH N.
C
C       FCNK IS AN OUTPUT VARIABLE WHICH CONTAINS THE VALUE OF
C         THE K-TH COMPONENT OF THE NPROB FUNCTION 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 REQUIRED
C
C       FORTRAN-SUPPLIED ... ATAN,COS,EXP,SIGN,SIN,SQRT,
C                            MAX0,MIN0,MOD
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IVAR,J,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,70,110,150,200,210,250,270,290,300), NPROB
C
C     ROSENBROCK FUNCTION.
C
   10 CONTINUE
      IF (K .EQ. 1) FCNK = ONE - X(1)
      IF (K .EQ. 2) FCNK = TEN*(X(2) - X(1)**2)
      GO TO 320
C
C     POWELL SINGULAR FUNCTION.
C
   20 CONTINUE
      IF (K .EQ. 1) FCNK = X(1) + TEN*X(2)
      IF (K .EQ. 2) FCNK = SQRT(FIVE)*(X(3) - X(4))
      IF (K .EQ. 3) FCNK = (X(2) - TWO*X(3))**2
      IF (K .EQ. 4) FCNK = SQRT(TEN)*(X(1) - X(4))**2
      GO TO 320
C
C     POWELL BADLY SCALED FUNCTION.
C
   30 CONTINUE
      IF (K .EQ. 1) FCNK = C1*X(1)*X(2) - ONE
      IF (K .EQ. 2) FCNK = EXP(-X(1)) + EXP(-X(2)) - C2
      GO TO 320
C
C     WOOD FUNCTION.
C
   40 CONTINUE
      TEMP1 = X(2) - X(1)**2
      TEMP2 = X(4) - X(3)**2
      IF (K .EQ. 1) FCNK = -C3*X(1)*TEMP1 - (ONE - X(1))
      IF (K .EQ. 2)
     *   FCNK = C3*TEMP1 + C4*(X(2) - ONE) + C5*(X(4) - ONE)
      IF (K .EQ. 3) FCNK = -C6*X(3)*TEMP2 - (ONE - X(3))
      IF (K .EQ. 4)
     *   FCNK = C6*TEMP2 + C4*(X(4) - ONE) + C5*(X(2) - ONE)
      GO TO 320
C
C     HELICAL VALLEY FUNCTION.
C
   50 CONTINUE
      IF (K .NE. 1) GO TO 60
      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
      FCNK = TEN*(X(3) - TEN*TEMP1)
   60 CONTINUE
      IF (K .EQ. 2) FCNK = TEN*(SQRT(X(1)**2+X(2)**2) - ONE)
      IF (K .EQ. 3) FCNK = X(3)
      GO TO 320
C
C     WATSON FUNCTION.
C
   70 CONTINUE
      FCNK = ZERO
      DO 100 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
         FCNK = FCNK + TI**(K - 2)*(FLOAT(K-1) - TEMP2)*TEMP1
  100    CONTINUE
      TEMP = X(2) - X(1)**2 - ONE
      IF (K .EQ. 1) FCNK = FCNK + X(1)*(ONE - TWO*TEMP)
      IF (K .EQ. 2) FCNK = FCNK + TEMP
      GO TO 320
C
C     CHEBYQUAD FUNCTION.
C
  110 CONTINUE
      SUM = ZERO
      DO 140 J = 1, N
         TEMP1 = ONE
         TEMP2 = TWO*X(J) - ONE
         TEMP = TWO*TEMP2
         IF (K .LT. 2) GO TO 130
         DO 120 I = 2, K
            TI = TEMP*TEMP2 - TEMP1
            TEMP1 = TEMP2
            TEMP2 = TI
  120       CONTINUE
  130    CONTINUE
         SUM = SUM + TEMP2
  140    CONTINUE
      FCNK = SUM/FLOAT(N)
      IF (MOD(K,2) .EQ. 0) FCNK = FCNK + ONE/(FLOAT(K)**2 - ONE)
      GO TO 320
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  150 CONTINUE
      IF (K .EQ. N) GO TO 170
         SUM = -FLOAT(N+1)
         DO 160 J = 1, N
            SUM = SUM + X(J)
  160       CONTINUE
         FCNK = X(K) + SUM
         GO TO 190
  170 CONTINUE
         PROD = ONE
         DO 180 J = 1, N
            PROD = X(J)*PROD
  180       CONTINUE
         FCNK = PROD - ONE
  190 CONTINUE
      GO TO 320
C
C     DISCRETE BOUNDARY VALUE FUNCTION.
C
  200 CONTINUE
      H = ONE/FLOAT(N+1)
      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)
      FCNK = TWO*X(K) - TEMP1 - TEMP2 + TEMP*H**2/TWO
      GO TO 320
C
C     DISCRETE INTEGRAL EQUATION FUNCTION.
C
  210 CONTINUE
      H = ONE/FLOAT(N+1)
      TK = FLOAT(K)*H
      SUM1 = ZERO
      DO 220 J = 1, K
         TJ = FLOAT(J)*H
         TEMP = (X(J) + TJ + ONE)**3
         SUM1 = SUM1 + TJ*TEMP
  220    CONTINUE
      SUM2 = ZERO
      KP1 = K + 1
      IF (N .LT. KP1) GO TO 240
      DO 230 J = KP1, N
         TJ = FLOAT(J)*H
         TEMP = (X(J) + TJ + ONE)**3
         SUM2 = SUM2 + (ONE - TJ)*TEMP
  230    CONTINUE
  240 CONTINUE
      FCNK = X(K) + H*((ONE - TK)*SUM1 + TK*SUM2)/TWO
      GO TO 320
C
C     TRIGONOMETRIC FUNCTION.
C
  250 CONTINUE
      SUM = ZERO
      DO 260 J = 1, N
         SUM = SUM + COS(X(J))
  260    CONTINUE
      FCNK = FLOAT(N+K) - SIN(X(K)) - SUM - FLOAT(K)*COS(X(K))
      GO TO 320
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  270 CONTINUE
      SUM = ZERO
      DO 280 J = 1, N
         SUM = SUM + FLOAT(J)*(X(J) - ONE)
  280    CONTINUE
      TEMP = SUM*(ONE + TWO*SUM**2)
      FCNK = X(K) - ONE + FLOAT(K)*TEMP
      GO TO 320
C
C     BROYDEN TRIDIAGONAL FUNCTION.
C
  290 CONTINUE
      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)
      FCNK = TEMP - TEMP1 - TWO*TEMP2 + ONE
      GO TO 320
C
C     BROYDEN BANDED FUNCTION.
C
  300 CONTINUE
      ML = 5
      MU = 1
      K1 = MAX0(1,K-ML)
      K2 = MIN0(K+MU,N)
      TEMP = ZERO
      DO 310 J = K1, K2
         IF (J .NE. K) TEMP = TEMP + X(J)*(ONE + X(J))
  310    CONTINUE
      FCNK = X(K)*(TWO + FIVE*X(K)**2) + ONE - TEMP
  320 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE COMFCN.
C
      END
      SUBROUTINE VECFCN(N,X,FVEC,NPROB)                                 00000010
      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 VARIABLE.
C
C       X IS AN ARRAY OF LENGTH N.
C
C       FVEC IS AN OUTPUT ARRAY OF LENGTH N WHICH
C         CONTAINS THE NPROB FUNCTION VECTOR EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 14.
C
C     SUBPROGRAMS REQUIRED
C
C       FORTRAN-SUPPLIED ... ATAN,COS,EXP,SIGN,SIN,SQRT,
C                            MAX0,MIN0
C
C     MINPACK. VERSION OF JULY 1978.
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
      SUBROUTINE VECJAC(N,X,FJAC,LDFJAC,NPROB)                          00000010
      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 A LINEAR 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 REQUIRED
C
C       FORTRAN-SUPPLIED ... ATAN,COS,EXP,AMIN1,SIN,SQRT,
C                            MAX0,MIN0
C
C     MINPACK. VERSION OF AUGUST 1978.
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
C ===== 6. SINGLE PRECISION TESTING AIDS FOR NONLINEAR EQUATIONS.
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)                               00000010
      INTEGER N,NPROB
      REAL FACTOR
      REAL X(N)
C     **********
C
C     SUBROUTINE INITPT
C
C     THIS SUBROUTINE SPECIFIES THE STANDARD STARTING POINTS FOR THE
C     FUNCTIONS DEFINED BY SUBROUTINE SSQFCN. THE SUBROUTINE RETURNS
C     IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR
C     THE 11TH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN
C     THIS CASE, IF FACTOR IS NOT UNITY, THEN THE SUBROUTINE RETURNS
C     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 VARIABLE.
C
C       X IS AN OUTPUT ARRAY OF LENGTH N THAT CONTAINS THE
C         STANDARD STARTING POINT FOR PROBLEM NPROB MULTIPLIED BY
C         FACTOR.
C
C       NPROB IS A POSITIVE INTEGER VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C       FACTOR SPECIFIES THE MULTIPLE OF THE STANDARD STARTING
C         POINT. IF FACTOR IS UNITY, NO MULTIPLICATION IS PERFORMED.
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER IVAR,J
      REAL C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16,C17,
     *     FIVE,H,HALF,ONE,SEVEN,TEN,THREE,TWENTY,TWNTF,TWO,ZERO
      REAL FLOAT
      DATA ZERO,HALF,ONE,TWO,THREE,FIVE,SEVEN,TEN,TWENTY,TWNTF
     *     /0.0E0,5.0E-1,1.0E0,2.0E0,3.0E0,5.0E0,7.0E0,1.0E1,2.0E1,
     *      2.5E1/
      DATA C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16,C17
     *     /1.2E0,2.5E-1,3.9E-1,4.15E-1,2.0E-2,4.0E3,2.5E2,3.0E-1,
     *      4.0E-1,1.5E0,1.0E-2,1.3E0,6.5E-1,7.0E-1,6.0E-1,4.5E0,
     *      5.5E0/
      FLOAT(IVAR) = IVAR
C
C     SELECTION OF INITIAL POINT.
C
      GO TO (10,10,10,30,40,50,60,70,80,90,100,120,130,140,150,170,
     *       190,200), NPROB
C
C     LINEAR FUNCTION - FULL RANK OR RANK 1.
C
   10 CONTINUE
      DO 20 J = 1, N
         X(J) = ONE
   20    CONTINUE
      GO TO 210
C
C     ROSENBROCK FUNCTION.
C
   30 CONTINUE
      X(1) = -C1
      X(2) = ONE
      GO TO 210
C
C     HELICAL VALLEY FUNCTION.
C
   40 CONTINUE
      X(1) = -ONE
      X(2) = ZERO
      X(3) = ZERO
      GO TO 210
C
C     POWELL SINGULAR FUNCTION.
C
   50 CONTINUE
      X(1) = THREE
      X(2) = -ONE
      X(3) = ZERO
      X(4) = ONE
      GO TO 210
C
C     FREUDENSTEIN AND ROTH FUNCTION.
C
   60 CONTINUE
      X(1) = HALF
      X(2) = -TWO
      GO TO 210
C
C     BARD FUNCTION.
C
   70 CONTINUE
      X(1) = ONE
      X(2) = ONE
      X(3) = ONE
      GO TO 210
C
C     KOWALIK AND OSBORNE FUNCTION.
C
   80 CONTINUE
      X(1) = C2
      X(2) = C3
      X(3) = C4
      X(4) = C3
      GO TO 210
C
C     MEYER FUNCTION.
C
   90 CONTINUE
      X(1) = C5
      X(2) = C6
      X(3) = C7
      GO TO 210
C
C     WATSON FUNCTION.
C
  100 CONTINUE
      DO 110 J = 1, N
         X(J) = ZERO
  110    CONTINUE
      GO TO 210
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  120 CONTINUE
      X(1) = ZERO
      X(2) = TEN
      X(3) = TWENTY
      GO TO 210
C
C     JENNRICH AND SAMPSON FUNCTION.
C
  130 CONTINUE
      X(1) = C8
      X(2) = C9
      GO TO 210
C
C     BROWN AND DENNIS FUNCTION.
C
  140 CONTINUE
      X(1) = TWNTF
      X(2) = FIVE
      X(3) = -FIVE
      X(4) = -ONE
      GO TO 210
C
C     CHEBYQUAD FUNCTION.
C
  150 CONTINUE
      H = ONE/FLOAT(N+1)
      DO 160 J = 1, N
         X(J) = FLOAT(J)*H
  160    CONTINUE
      GO TO 210
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  170 CONTINUE
      DO 180 J = 1, N
         X(J) = HALF
  180    CONTINUE
      GO TO 210
C
C     OSBORNE 1 FUNCTION.
C
  190 CONTINUE
      X(1) = HALF
      X(2) = C10
      X(3) = -ONE
      X(4) = C11
      X(5) = C5
      GO TO 210
C
C     OSBORNE 2 FUNCTION.
C
  200 CONTINUE
      X(1) = C12
      X(2) = C13
      X(3) = C13
      X(4) = C14
      X(5) = C15
      X(6) = THREE
      X(7) = FIVE
      X(8) = SEVEN
      X(9) = TWO
      X(10) = C16
      X(11) = C17
  210 CONTINUE
C
C     COMPUTE MULTIPLE OF INITIAL POINT.
C
      IF (FACTOR .EQ. ONE) GO TO 260
      IF (NPROB .EQ. 11) GO TO 230
         DO 220 J = 1, N
            X(J) = FACTOR*X(J)
  220       CONTINUE
         GO TO 250
  230 CONTINUE
         DO 240 J = 1, N
            X(J) = FACTOR
  240       CONTINUE
  250 CONTINUE
  260 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE INITPT.
C
      END
      SUBROUTINE SSQFCN(M,N,X,FVEC,NPROB)                               00000010
      INTEGER M,N,NPROB
      REAL X(N),FVEC(M)
C     **********
C
C     SUBROUTINE SSQFCN
C
C     THIS SUBROUTINE DEFINES THE FUNCTIONS OF EIGHTEEN NONLINEAR
C     LEAST SQUARES PROBLEMS. THE ALLOWABLE VALUES OF (M,N) FOR
C     FUNCTIONS 1,2 AND 3 ARE VARIABLE BUT WITH M .GE. N.
C     FOR FUNCTIONS 4,5,6,7,8,9 AND 10 THE VALUES OF (M,N) ARE
C     (2,2),(3,3),(4,4),(2,2),(15,3),(11,4) AND (16,3), RESPECTIVELY.
C     FUNCTION 11 (WATSON) HAS M = 31 WITH N USUALLY 6 OR 9.
C     HOWEVER, ANY N, N = 2,...,31, IS PERMITTED.
C     FUNCTIONS 12,13 AND 14 HAVE N = 3,2 AND 4, RESPECTIVELY, BUT
C     ALLOW ANY M .GE. N, WITH THE USUAL CHOICES BEING 10,10 AND 20.
C     FUNCTION 15 (CHEBYQUAD) ALLOWS M AND N VARIABLE WITH M .GE. N.
C     FUNCTION 16 (BROWN) ALLOWS N VARIABLE WITH M = N.
C     FOR FUNCTIONS 17 AND 18, THE VALUES OF (M,N) ARE
C     (33,5) AND (65,11), RESPECTIVELY.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE SSQFCN(M,N,X,FVEC,NPROB)
C
C     WHERE
C
C       M AND N ARE POSITIVE INTEGER VARIABLES. N MUST NOT EXCEED M.
C
C       X IS AN ARRAY OF LENGTH N.
C
C       FVEC IS AN OUTPUT ARRAY OF LENGTH M WHICH
C         CONTAINS THE NPROB FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS REQUIRED
C
C       FORTRAN-SUPPLIED ... ATAN,COS,EXP,SIN,SQRT,SIGN
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IEV,IVAR,J,NM1
      REAL C13,C14,C29,C45,DIV,DX,EIGHT,FIVE,ONE,PROD,SUM,S1,S2,TEMP,
     *     TEN,TI,TMP1,TMP2,TMP3,TMP4,TPI,TWO,ZERO,ZP25,ZP5
      REAL V(11),Y1(15),Y2(11),Y3(16),Y4(33),Y5(65)
      REAL FLOAT
      DATA ZERO,ZP25,ZP5,ONE,TWO,FIVE,EIGHT,TEN,C13,C14,C29,C45
     *     /0.0E0,2.5E-1,5.0E-1,1.0E0,2.0E0,5.0E0,8.0E0,1.0E1,1.3E1,
     *      1.4E1,2.9E1,4.5E1/
      DATA V(1),V(2),V(3),V(4),V(5),V(6),V(7),V(8),V(9),V(10),V(11)
     *     /4.0E0,2.0E0,1.0E0,5.0E-1,2.5E-1,1.67E-1,1.25E-1,1.0E-1,
     *      8.33E-2,7.14E-2,6.25E-2/
      DATA Y1(1),Y1(2),Y1(3),Y1(4),Y1(5),Y1(6),Y1(7),Y1(8),Y1(9),
     *     Y1(10),Y1(11),Y1(12),Y1(13),Y1(14),Y1(15)
     *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
     *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
      DATA Y2(1),Y2(2),Y2(3),Y2(4),Y2(5),Y2(6),Y2(7),Y2(8),Y2(9),
     *     Y2(10),Y2(11)
     *     /1.957E-1,1.947E-1,1.735E-1,1.6E-1,8.44E-2,6.27E-2,4.56E-2,
     *      3.42E-2,3.23E-2,2.35E-2,2.46E-2/
      DATA Y3(1),Y3(2),Y3(3),Y3(4),Y3(5),Y3(6),Y3(7),Y3(8),Y3(9),
     *     Y3(10),Y3(11),Y3(12),Y3(13),Y3(14),Y3(15),Y3(16)
     *     /3.478E4,2.861E4,2.365E4,1.963E4,1.637E4,1.372E4,1.154E4,
     *      9.744E3,8.261E3,7.03E3,6.005E3,5.147E3,4.427E3,3.82E3,
     *      3.307E3,2.872E3/
      DATA Y4(1),Y4(2),Y4(3),Y4(4),Y4(5),Y4(6),Y4(7),Y4(8),Y4(9),
     *     Y4(10),Y4(11),Y4(12),Y4(13),Y4(14),Y4(15),Y4(16),Y4(17),
     *     Y4(18),Y4(19),Y4(20),Y4(21),Y4(22),Y4(23),Y4(24),Y4(25),
     *     Y4(26),Y4(27),Y4(28),Y4(29),Y4(30),Y4(31),Y4(32),Y4(33)
     *     /8.44E-1,9.08E-1,9.32E-1,9.36E-1,9.25E-1,9.08E-1,8.81E-1,
     *      8.5E-1,8.18E-1,7.84E-1,7.51E-1,7.18E-1,6.85E-1,6.58E-1,
     *      6.28E-1,6.03E-1,5.8E-1,5.58E-1,5.38E-1,5.22E-1,5.06E-1,
     *      4.9E-1,4.78E-1,4.67E-1,4.57E-1,4.48E-1,4.38E-1,4.31E-1,
     *      4.24E-1,4.2E-1,4.14E-1,4.11E-1,4.06E-1/
      DATA Y5(1),Y5(2),Y5(3),Y5(4),Y5(5),Y5(6),Y5(7),Y5(8),Y5(9),
     *     Y5(10),Y5(11),Y5(12),Y5(13),Y5(14),Y5(15),Y5(16),Y5(17),
     *     Y5(18),Y5(19),Y5(20),Y5(21),Y5(22),Y5(23),Y5(24),Y5(25),
     *     Y5(26),Y5(27),Y5(28),Y5(29),Y5(30),Y5(31),Y5(32),Y5(33),
     *     Y5(34),Y5(35),Y5(36),Y5(37),Y5(38),Y5(39),Y5(40),Y5(41),
     *     Y5(42),Y5(43),Y5(44),Y5(45),Y5(46),Y5(47),Y5(48),Y5(49),
     *     Y5(50),Y5(51),Y5(52),Y5(53),Y5(54),Y5(55),Y5(56),Y5(57),
     *     Y5(58),Y5(59),Y5(60),Y5(61),Y5(62),Y5(63),Y5(64),Y5(65)
     *     /1.366E0,1.191E0,1.112E0,1.013E0,9.91E-1,8.85E-1,8.31E-1,
     *      8.47E-1,7.86E-1,7.25E-1,7.46E-1,6.79E-1,6.08E-1,6.55E-1,
     *      6.16E-1,6.06E-1,6.02E-1,6.26E-1,6.51E-1,7.24E-1,6.49E-1,
     *      6.49E-1,6.94E-1,6.44E-1,6.24E-1,6.61E-1,6.12E-1,5.58E-1,
     *      5.33E-1,4.95E-1,5.0E-1,4.23E-1,3.95E-1,3.75E-1,3.72E-1,
     *      3.91E-1,3.96E-1,4.05E-1,4.28E-1,4.29E-1,5.23E-1,5.62E-1,
     *      6.07E-1,6.53E-1,6.72E-1,7.08E-1,6.33E-1,6.68E-1,6.45E-1,
     *      6.32E-1,5.91E-1,5.59E-1,5.97E-1,6.25E-1,7.39E-1,7.1E-1,
     *      7.29E-1,7.2E-1,6.36E-1,5.81E-1,4.28E-1,2.92E-1,1.62E-1,
     *      9.8E-2,5.4E-2/
      FLOAT(IVAR) = IVAR
C
C     FUNCTION ROUTINE SELECTOR.
C
      GO TO (10,40,70,110,120,130,140,150,170,190,210,250,270,290,310,
     *       360,390,410), NPROB
C
C     LINEAR FUNCTION - FULL RANK.
C
   10 CONTINUE
      SUM = ZERO
      DO 20 J = 1, N
         SUM = SUM + X(J)
   20    CONTINUE
      TEMP = TWO*SUM/FLOAT(M) + ONE
      DO 30 I = 1, M
         FVEC(I) = -TEMP
         IF (I .LE. N) FVEC(I) = FVEC(I) + X(I)
   30    CONTINUE
      GO TO 430
C
C     LINEAR FUNCTION - RANK 1.
C
   40 CONTINUE
      SUM = ZERO
      DO 50 J = 1, N
         SUM = SUM + FLOAT(J)*X(J)
   50    CONTINUE
      DO 60 I = 1, M
         FVEC(I) = FLOAT(I)*SUM - ONE
   60    CONTINUE
      GO TO 430
C
C     LINEAR FUNCTION - RANK 1 WITH ZERO COLUMNS AND ROWS.
C
   70 CONTINUE
      SUM = ZERO
      NM1 = N - 1
      IF (NM1 .LT. 2) GO TO 90
      DO 80 J = 2, NM1
         SUM = SUM + FLOAT(J)*X(J)
   80    CONTINUE
   90 CONTINUE
      DO 100 I = 1, M
         FVEC(I) = FLOAT(I-1)*SUM - ONE
  100    CONTINUE
      FVEC(M) = -ONE
      GO TO 430
C
C     ROSENBROCK FUNCTION.
C
  110 CONTINUE
      FVEC(1) = TEN*(X(2) - X(1)**2)
      FVEC(2) = ONE - X(1)
      GO TO 430
C
C     HELICAL VALLEY FUNCTION.
C
  120 CONTINUE
      TPI = EIGHT*ATAN(ONE)
      TMP1 = SIGN(ZP25,X(2))
      IF (X(1) .GT. ZERO) TMP1 = ATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TMP1 = ATAN(X(2)/X(1))/TPI + ZP5
      TMP2 = SQRT(X(1)**2+X(2)**2)
      FVEC(1) = TEN*(X(3) - TEN*TMP1)
      FVEC(2) = TEN*(TMP2 - ONE)
      FVEC(3) = X(3)
      GO TO 430
C
C     POWELL SINGULAR FUNCTION.
C
  130 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 430
C
C     FREUDENSTEIN AND ROTH FUNCTION.
C
  140 CONTINUE
      FVEC(1) = -C13 + X(1) + ((FIVE - X(2))*X(2) - TWO)*X(2)
      FVEC(2) = -C29 + X(1) + ((ONE + X(2))*X(2) - C14)*X(2)
      GO TO 430
C
C     BARD FUNCTION.
C
  150 CONTINUE
      DO 160 I = 1, 15
         TMP1 = FLOAT(I)
         TMP2 = FLOAT(16-I)
         TMP3 = TMP1
         IF (I .GT. 8) TMP3 = TMP2
         FVEC(I) = Y1(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
  160    CONTINUE
      GO TO 430
C
C     KOWALIK AND OSBORNE FUNCTION.
C
  170 CONTINUE
      DO 180 I = 1, 11
         TMP1 = V(I)*(V(I) + X(2))
         TMP2 = V(I)*(V(I) + X(3)) + X(4)
         FVEC(I) = Y2(I) - X(1)*TMP1/TMP2
  180    CONTINUE
      GO TO 430
C
C     MEYER FUNCTION.
C
  190 CONTINUE
      DO 200 I = 1, 16
         TEMP = FIVE*FLOAT(I) + C45 + X(3)
         TMP1 = X(2)/TEMP
         TMP2 = EXP(TMP1)
         FVEC(I) = X(1)*TMP2 - Y3(I)
  200    CONTINUE
      GO TO 430
C
C     WATSON FUNCTION.
C
  210 CONTINUE
      DO 240 I = 1, 29
         DIV = FLOAT(I)/C29
         S1 = ZERO
         DX = ONE
         DO 220 J = 2, N
            S1 = S1 + FLOAT(J-1)*DX*X(J)
            DX = DIV*DX
  220       CONTINUE
         S2 = ZERO
         DX = ONE
         DO 230 J = 1, N
            S2 = S2 + DX*X(J)
            DX = DIV*DX
  230       CONTINUE
         FVEC(I) = S1 - S2**2 - ONE
  240    CONTINUE
      FVEC(30) = X(1)
      FVEC(31) = X(2) - X(1)**2 - ONE
      GO TO 430
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  250 CONTINUE
      DO 260 I = 1, M
         TEMP = FLOAT(I)
         TMP1 = TEMP/TEN
         FVEC(I) = EXP(-TMP1*X(1)) - EXP(-TMP1*X(2))
     *             + (EXP(-TEMP) - EXP(-TMP1))*X(3)
  260    CONTINUE
      GO TO 430
C
C     JENNRICH AND SAMPSON FUNCTION.
C
  270 CONTINUE
      DO 280 I = 1, M
         TEMP = FLOAT(I)
         FVEC(I) = TWO + TWO*TEMP - EXP(TEMP*X(1)) - EXP(TEMP*X(2))
  280    CONTINUE
      GO TO 430
C
C     BROWN AND DENNIS FUNCTION.
C
  290 CONTINUE
      DO 300 I = 1, M
         TEMP = FLOAT(I)/FIVE
         TMP1 = X(1) + TEMP*X(2) - EXP(TEMP)
         TMP2 = X(3) + SIN(TEMP)*X(4) - COS(TEMP)
         FVEC(I) = TMP1**2 + TMP2**2
  300    CONTINUE
      GO TO 430
C
C     CHEBYQUAD FUNCTION.
C
  310 CONTINUE
      DO 320 I = 1, M
         FVEC(I) = ZERO
  320    CONTINUE
      DO 340 J = 1, N
         TMP1 = ONE
         TMP2 = TWO*X(J) - ONE
         TEMP = TWO*TMP2
         DO 330 I = 1, M
            FVEC(I) = FVEC(I) + TMP2
            TI = TEMP*TMP2 - TMP1
            TMP1 = TMP2
            TMP2 = TI
  330       CONTINUE
  340    CONTINUE
      DX = ONE/FLOAT(N)
      IEV = -1
      DO 350 I = 1, M
         FVEC(I) = DX*FVEC(I)
         IF (IEV .GT. 0) FVEC(I) = FVEC(I) + ONE/(FLOAT(I)**2 - ONE)
         IEV = -IEV
  350    CONTINUE
      GO TO 430
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  360 CONTINUE
      SUM = -FLOAT(N+1)
      PROD = ONE
      DO 370 J = 1, N
         SUM = SUM + X(J)
         PROD = X(J)*PROD
  370    CONTINUE
      DO 380 I = 1, N
         FVEC(I) = X(I) + SUM
  380    CONTINUE
      FVEC(N) = PROD - ONE
      GO TO 430
C
C     OSBORNE 1 FUNCTION.
C
  390 CONTINUE
      DO 400 I = 1, 33
         TEMP = TEN*FLOAT(I-1)
         TMP1 = EXP(-X(4)*TEMP)
         TMP2 = EXP(-X(5)*TEMP)
         FVEC(I) = Y4(I) - (X(1) + X(2)*TMP1 + X(3)*TMP2)
  400    CONTINUE
      GO TO 430
C
C     OSBORNE 2 FUNCTION.
C
  410 CONTINUE
      DO 420 I = 1, 65
         TEMP = FLOAT(I-1)/TEN
         TMP1 = EXP(-X(5)*TEMP)
         TMP2 = EXP(-X(6)*(TEMP-X(9))**2)
         TMP3 = EXP(-X(7)*(TEMP-X(10))**2)
         TMP4 = EXP(-X(8)*(TEMP-X(11))**2)
         FVEC(I) = Y5(I)
     *             - (X(1)*TMP1 + X(2)*TMP2 + X(3)*TMP3 + X(4)*TMP4)
  420    CONTINUE
  430 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE SSQFCN.
C
      END
      SUBROUTINE SSQJAC(M,N,X,FJAC,LDFJAC,NPROB)                        00000010
      INTEGER M,N,LDFJAC,NPROB
      REAL X(N),FJAC(LDFJAC,N)
C     **********
C
C     SUBROUTINE SSQJAC
C
C     THIS SUBROUTINE DEFINES THE JACOBIAN MATRICES OF EIGHTEEN
C     NONLINEAR LEAST SQUARES PROBLEMS. THE PROBLEM DIMENSIONS ARE
C     AS DESCRIBED IN THE PROLOGUE COMMENTS OF SSQFCN.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE SSQJAC(M,N,X,FJAC,LDFJAC,NPROB)
C
C     WHERE
C
C       M AND N ARE POSITIVE INTEGER VARIABLES. N MUST NOT EXCEED M.
C
C       X IS AN ARRAY OF LENGTH N.
C
C       FJAC IS AN M BY N OUTPUT ARRAY WHICH CONTAINS THE
C         JACOBIAN MATRIX OF THE NPROB FUNCTION EVALUATED AT X.
C
C       LDFJAC IS A POSITIVE INTEGER VARIABLE NOT LESS THAN M
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 18.
C
C     SUBPROGRAMS REQUIRED
C
C       FORTRAN-SUPPLIED ... ATAN,COS,EXP,SIN,SQRT
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IVAR,J,K,MM1,NM1
      REAL C14,C20,C29,C45,C100,DIV,DX,EIGHT,FIVE,FOUR,ONE,PROD,S2,
     *     TEMP,TEN,THREE,TI,TMP1,TMP2,TMP3,TMP4,TPI,TWO,ZERO
      REAL V(11)
      REAL FLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,EIGHT,TEN,C14,C20,C29,C45,C100
     *     /0.0E0,1.0E0,2.0E0,3.0E0,4.0E0,5.0E0,8.0E0,1.0E1,1.4E1,
     *      2.0E1,2.9E1,4.5E1,1.0E2/
      DATA V(1),V(2),V(3),V(4),V(5),V(6),V(7),V(8),V(9),V(10),V(11)
     *     /4.0E0,2.0E0,1.0E0,5.0E-1,2.5E-1,1.67E-1,1.25E-1,1.0E-1,
     *      8.33E-2,7.14E-2,6.25E-2/
      FLOAT(IVAR) = IVAR
C
C     JACOBIAN ROUTINE SELECTOR.
C
      GO TO (10,40,70,130,140,150,180,190,210,230,250,310,330,350,370,
     *       400,460,480), NPROB
C
C     LINEAR FUNCTION - FULL RANK.
C
   10 CONTINUE
      TEMP = TWO/FLOAT(M)
      DO 30 J = 1, N
         DO 20 I = 1, M
            FJAC(I,J) = -TEMP
   20       CONTINUE
         FJAC(J,J) = FJAC(J,J) + ONE
   30    CONTINUE
      GO TO 500
C
C     LINEAR FUNCTION - RANK 1.
C
   40 CONTINUE
      DO 60 J = 1, N
         DO 50 I = 1, M
            FJAC(I,J) = FLOAT(I)*FLOAT(J)
   50       CONTINUE
   60    CONTINUE
      GO TO 500
C
C     LINEAR FUNCTION - RANK 1 WITH ZERO COLUMNS AND ROWS.
C
   70 CONTINUE
      DO 90 J = 1, N
         DO 80 I = 1, M
            FJAC(I,J) = ZERO
   80       CONTINUE
   90    CONTINUE
      NM1 = N - 1
      MM1 = M - 1
      IF (NM1 .LT. 2) GO TO 120
      DO 110 J = 2, NM1
         DO 100 I = 2, MM1
            FJAC(I,J) = FLOAT(I-1)*FLOAT(J)
  100       CONTINUE
  110    CONTINUE
  120 CONTINUE
      GO TO 500
C
C     ROSENBROCK FUNCTION.
C
  130 CONTINUE
      FJAC(1,1) = -C20*X(1)
      FJAC(1,2) = TEN
      FJAC(2,1) = -ONE
      FJAC(2,2) = ZERO
      GO TO 500
C
C     HELICAL VALLEY FUNCTION.
C
  140 CONTINUE
      TPI = EIGHT*ATAN(ONE)
      TEMP = X(1)**2 + X(2)**2
      TMP1 = TPI*TEMP
      TMP2 = SQRT(TEMP)
      FJAC(1,1) = C100*X(2)/TMP1
      FJAC(1,2) = -C100*X(1)/TMP1
      FJAC(1,3) = TEN
      FJAC(2,1) = TEN*X(1)/TMP2
      FJAC(2,2) = TEN*X(2)/TMP2
      FJAC(2,3) = ZERO
      FJAC(3,1) = ZERO
      FJAC(3,2) = ZERO
      FJAC(3,3) = ONE
      GO TO 500
C
C     POWELL SINGULAR FUNCTION.
C
  150 CONTINUE
      DO 170 J = 1, 4
         DO 160 I = 1, 4
            FJAC(I,J) = ZERO
  160       CONTINUE
  170    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 500
C
C     FREUDENSTEIN AND ROTH FUNCTION.
C
  180 CONTINUE
      FJAC(1,1) = ONE
      FJAC(1,2) = X(2)*(TEN - THREE*X(2)) - TWO
      FJAC(2,1) = ONE
      FJAC(2,2) = X(2)*(TWO + THREE*X(2)) - C14
      GO TO 500
C
C     BARD FUNCTION.
C
  190 CONTINUE
      DO 200 I = 1, 15
         TMP1 = FLOAT(I)
         TMP2 = FLOAT(16-I)
         TMP3 = TMP1
         IF (I .GT. 8) TMP3 = TMP2
         TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2
         FJAC(I,1) = -ONE
         FJAC(I,2) = TMP1*TMP2/TMP4
         FJAC(I,3) = TMP1*TMP3/TMP4
  200    CONTINUE
      GO TO 500
C
C     KOWALIK AND OSBORNE FUNCTION.
C
  210 CONTINUE
      DO 220 I = 1, 11
         TMP1 = V(I)*(V(I) + X(2))
         TMP2 = V(I)*(V(I) + X(3)) + X(4)
         FJAC(I,1) = -TMP1/TMP2
         FJAC(I,2) = -V(I)*X(1)/TMP2
         FJAC(I,3) = FJAC(I,1)*FJAC(I,2)
         FJAC(I,4) = FJAC(I,3)/V(I)
  220    CONTINUE
      GO TO 500
C
C     MEYER FUNCTION.
C
  230 CONTINUE
      DO 240 I = 1, 16
         TEMP = FIVE*FLOAT(I) + C45 + X(3)
         TMP1 = X(2)/TEMP
         TMP2 = EXP(TMP1)
         FJAC(I,1) = TMP2
         FJAC(I,2) = X(1)*TMP2/TEMP
         FJAC(I,3) = -TMP1*FJAC(I,2)
  240    CONTINUE
      GO TO 500
C
C     WATSON FUNCTION.
C
  250 CONTINUE
      DO 280 I = 1, 29
         DIV = FLOAT(I)/C29
         S2 = ZERO
         DX = ONE
         DO 260 J = 1, N
            S2 = S2 + DX*X(J)
            DX = DIV*DX
  260       CONTINUE
         TEMP = TWO*DIV*S2
         DX = ONE/DIV
         DO 270 J = 1, N
            FJAC(I,J) = DX*(FLOAT(J-1) - TEMP)
            DX = DIV*DX
  270       CONTINUE
  280    CONTINUE
      DO 300 J = 1, N
         DO 290 I = 30, 31
            FJAC(I,J) = ZERO
  290       CONTINUE
  300    CONTINUE
      FJAC(30,1) = ONE
      FJAC(31,1) = -TWO*X(1)
      FJAC(31,2) = ONE
      GO TO 500
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
  310 CONTINUE
      DO 320 I = 1, M
         TEMP = FLOAT(I)
         TMP1 = TEMP/TEN
         FJAC(I,1) = -TMP1*EXP(-TMP1*X(1))
         FJAC(I,2) = TMP1*EXP(-TMP1*X(2))
         FJAC(I,3) = EXP(-TEMP) - EXP(-TMP1)
  320    CONTINUE
      GO TO 500
C
C     JENNRICH AND SAMPSON FUNCTION.
C
  330 CONTINUE
      DO 340 I = 1, M
         TEMP = FLOAT(I)
         FJAC(I,1) = -TEMP*EXP(TEMP*X(1))
         FJAC(I,2) = -TEMP*EXP(TEMP*X(2))
  340    CONTINUE
      GO TO 500
C
C     BROWN AND DENNIS FUNCTION.
C
  350 CONTINUE
      DO 360 I = 1, M
         TEMP = FLOAT(I)/FIVE
         TI = SIN(TEMP)
         TMP1 = X(1) + TEMP*X(2) - EXP(TEMP)
         TMP2 = X(3) + TI*X(4) - COS(TEMP)
         FJAC(I,1) = TWO*TMP1
         FJAC(I,2) = TEMP*FJAC(I,1)
         FJAC(I,3) = TWO*TMP2
         FJAC(I,4) = TI*FJAC(I,3)
  360    CONTINUE
      GO TO 500
C
C     CHEBYQUAD FUNCTION.
C
  370 CONTINUE
      DX = ONE/FLOAT(N)
      DO 390 J = 1, N
         TMP1 = ONE
         TMP2 = TWO*X(J) - ONE
         TEMP = TWO*TMP2
         TMP3 = ZERO
         TMP4 = TWO
         DO 380 I = 1, M
            FJAC(I,J) = DX*TMP4
            TI = FOUR*TMP2 + TEMP*TMP4 - TMP3
            TMP3 = TMP4
            TMP4 = TI
            TI = TEMP*TMP2 - TMP1
            TMP1 = TMP2
            TMP2 = TI
  380       CONTINUE
  390    CONTINUE
      GO TO 500
C
C     BROWN ALMOST-LINEAR FUNCTION.
C
  400 CONTINUE
      PROD = ONE
      DO 420 J = 1, N
         PROD = X(J)*PROD
         DO 410 I = 1, N
            FJAC(I,J) = ONE
  410       CONTINUE
         FJAC(J,J) = TWO
  420    CONTINUE
      DO 450 J = 1, N
         TEMP = X(J)
         IF (TEMP .NE. ZERO) GO TO 440
         TEMP = ONE
         PROD = ONE
         DO 430 K = 1, N
            IF (K .NE. J) PROD = X(K)*PROD
  430       CONTINUE
  440    CONTINUE
         FJAC(N,J) = PROD/TEMP
  450    CONTINUE
      GO TO 500
C
C     OSBORNE 1 FUNCTION.
C
  460 CONTINUE
      DO 470 I = 1, 33
         TEMP = TEN*FLOAT(I-1)
         TMP1 = EXP(-X(4)*TEMP)
         TMP2 = EXP(-X(5)*TEMP)
         FJAC(I,1) = -ONE
         FJAC(I,2) = -TMP1
         FJAC(I,3) = -TMP2
         FJAC(I,4) = TEMP*X(2)*TMP1
         FJAC(I,5) = TEMP*X(3)*TMP2
  470    CONTINUE
      GO TO 500
C
C     OSBORNE 2 FUNCTION.
C
  480 CONTINUE
      DO 490 I = 1, 65
         TEMP = FLOAT(I-1)/TEN
         TMP1 = EXP(-X(5)*TEMP)
         TMP2 = EXP(-X(6)*(TEMP-X(9))**2)
         TMP3 = EXP(-X(7)*(TEMP-X(10))**2)
         TMP4 = EXP(-X(8)*(TEMP-X(11))**2)
         FJAC(I,1) = -TMP1
         FJAC(I,2) = -TMP2
         FJAC(I,3) = -TMP3
         FJAC(I,4) = -TMP4
         FJAC(I,5) = TEMP*X(1)*TMP1
         FJAC(I,6) = X(2)*(TEMP - X(9))**2*TMP2
         FJAC(I,7) = X(3)*(TEMP - X(10))**2*TMP3
         FJAC(I,8) = X(4)*(TEMP - X(11))**2*TMP4
         FJAC(I,9) = -TWO*X(2)*X(6)*(TEMP - X(9))*TMP2
         FJAC(I,10) = -TWO*X(3)*X(7)*(TEMP - X(10))*TMP3
         FJAC(I,11) = -TWO*X(4)*X(8)*(TEMP - X(11))*TMP4
  490    CONTINUE
  500 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE SSQJAC.
C
      END
C ===== 7. SINGLE PRECISION TESTING AIDS FOR UNCONSTRAINED NONLINEAR
C =====     OPTIMIZATION.
      SUBROUTINE INITPT(N,X,NPROB,FACTOR)                               00000010
      INTEGER N,NPROB
      REAL FACTOR
      REAL X(N)
C     **********
C
C     SUBROUTINE INITPT
C
C     THIS SUBROUTINE SPECIFIES THE STANDARD STARTING POINTS FOR THE
C     FUNCTIONS DEFINED BY SUBROUTINE OBJFCN. THE SUBROUTINE RETURNS
C     IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR
C     THE SEVENTH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN
C     THIS CASE, IF FACTOR IS NOT UNITY, THEN THE SUBROUTINE RETURNS
C     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 VARIABLE.
C
C       X IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE
C         STANDARD STARTING POINT FOR PROBLEM NPROB MULTIPLIED BY
C         FACTOR.
C
C       NPROB IS A POSITIVE INTEGER VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C       FACTOR SPECIFIES THE MULTIPLE OF THE STANDARD STARTING
C         POINT. IF FACTOR IS UNITY, NO MULTIPLICATION IS PERFORMED.
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER IVAR,J
      REAL C1,C2,C3,C4,FIVE,H,HALF,ONE,TEN,THREE,TWENTY,TWNTF,TWO,ZERO
      REAL FLOAT
      DATA ZERO,HALF,ONE,TWO,THREE,FIVE,TEN,TWENTY,TWNTF
     *     /0.0E0,0.5E0,1.0E0,2.0E0,3.0E0,5.0E0,1.0E1,2.0E1,2.5E1/
      DATA C1,C2,C3,C4 /4.0E-1,2.5E0,1.5E-1,1.2E0/
      FLOAT(IVAR) = IVAR
C
C     SELECTION OF INITIAL POINT.
C
      GO TO (10,20,30,40,50,60,80,100,120,140,150,160,170,190,210,230,
     *       240,250), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
   10 CONTINUE
      X(1) = -ONE
      X(2) = ZERO
      X(3) = ZERO
      GO TO 270
C
C     BIGGS EXP6 FUNCTION.
C
   20 CONTINUE
      X(1) = ONE
      X(2) = TWO
      X(3) = ONE
      X(4) = ONE
      X(5) = ONE
      X(6) = ONE
      GO TO 270
C
C     GAUSSIAN FUNCTION.
C
   30 CONTINUE
      X(1) = C1
      X(2) = ONE
      X(3) = ZERO
      GO TO 270
C
C     POWELL BADLY SCALED FUNCTION.
C
   40 CONTINUE
      X(1) = ZERO
      X(2) = ONE
      GO TO 270
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
   50 CONTINUE
      X(1) = ZERO
      X(2) = TEN
      X(3) = TWENTY
      GO TO 270
C
C     VARIABLY DIMENSIONED FUNCTION.
C
   60 CONTINUE
      H = ONE/FLOAT(N)
      DO 70 J = 1, N
         X(J) = ONE - FLOAT(J)*H
   70    CONTINUE
      GO TO 270
C
C     WATSON FUNCTION.
C
   80 CONTINUE
      DO 90 J = 1, N
         X(J) = ZERO
   90    CONTINUE
      GO TO 270
C
C     PENALTY FUNCTION I.
C
  100 CONTINUE
      DO 110 J = 1, N
         X(J) = FLOAT(J)
  110    CONTINUE
      GO TO 270
C
C     PENALTY FUNCTION II.
C
  120 CONTINUE
      DO 130 J = 1, N
         X(J) = HALF
  130    CONTINUE
      GO TO 270
C
C     BROWN BADLY SCALED FUNCTION.
C
  140 CONTINUE
      X(1) = ONE
      X(2) = ONE
      GO TO 270
C
C     BROWN AND DENNIS FUNCTION.
C
  150 CONTINUE
      X(1) = TWNTF
      X(2) = FIVE
      X(3) = -FIVE
      X(4) = -ONE
      GO TO 270
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
  160 CONTINUE
      X(1) = FIVE
      X(2) = C2
      X(3) = C3
      GO TO 270
C
C     TRIGONOMETRIC FUNCTION.
C
  170 CONTINUE
      H = ONE/FLOAT(N)
      DO 180 J = 1, N
         X(J) = H
  180    CONTINUE
      GO TO 270
C
C     EXTENDED ROSENBROCK FUNCTION.
C
  190 CONTINUE
      DO 200 J = 1, N, 2
         X(J) = -C4
         X(J+1) = ONE
  200    CONTINUE
      GO TO 270
C
C     EXTENDED POWELL SINGULAR FUNCTION.
C
  210 CONTINUE
      DO 220 J = 1, N, 4
         X(J) = THREE
         X(J+1) = -ONE
         X(J+2) = ZERO
         X(J+3) = ONE
  220    CONTINUE
      GO TO 270
C
C     BEALE FUNCTION.
C
  230 CONTINUE
      X(1) = ONE
      X(2) = ONE
      GO TO 270
C
C     WOOD FUNCTION.
C
  240 CONTINUE
      X(1) = -THREE
      X(2) = -ONE
      X(3) = -THREE
      X(4) = -ONE
      GO TO 270
C
C     CHEBYQUAD FUNCTION.
C
  250 CONTINUE
      H = ONE/FLOAT(N+1)
      DO 260 J = 1, N
         X(J) = FLOAT(J)*H
  260    CONTINUE
  270 CONTINUE
C
C     COMPUTE MULTIPLE OF INITIAL POINT.
C
      IF (FACTOR .EQ. ONE) GO TO 320
      IF (NPROB .EQ. 7) GO TO 290
         DO 280 J = 1, N
            X(J) = FACTOR*X(J)
  280       CONTINUE
         GO TO 310
  290 CONTINUE
         DO 300 J = 1, N
            X(J) = FACTOR
  300       CONTINUE
  310 CONTINUE
  320 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE INITPT.
C
      END
      SUBROUTINE OBJFCN(N,X,F,NPROB)                                    00000010
      INTEGER N,NPROB
      REAL F
      REAL X(N)
C     **********
C
C     SUBROUTINE OBJFCN
C
C     THIS SUBROUTINE DEFINES THE OBJECTIVE FUNCTIONS OF EIGHTEEN
C     NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS. THE VALUES
C     OF N FOR FUNCTIONS 1,2,3,4,5,10,11,12,16 AND 17 ARE
C     3,6,3,2,3,2,4,3,2 AND 4, RESPECTIVELY.
C     FOR FUNCTION 7, N MAY BE 2 OR GREATER BUT IS USUALLY 6 OR 9.
C     FOR FUNCTIONS 6,8,9,13,14,15 AND 18 N MAY BE VARIABLE,
C     HOWEVER IT MUST BE EVEN FOR FUNCTION 14, A MULTIPLE OF 4 FOR
C     FUNCTION 15, AND NOT GREATER THAN 50 FOR FUNCTION 18.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE OBJFCN(N,X,F,NPROB)
C
C     WHERE
C
C       N IS A POSITIVE INTEGER VARIABLE.
C
C       X IS AN ARRAY OF LENGTH N.
C
C       F IS AN OUTPUT VARIABLE WHICH CONTAINS THE VALUE OF
C         THE NPROB OBJECTIVE FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS REQUIRED
C
C       FORTRAN-SUPPLIED ... ABS,ATAN,COS,EXP,ALOG,SIGN,SIN,
C                            SQRT
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IEV,IVAR,J
      REAL AP,ARG,BP,C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,C2P25,C2P625,
     *     C3P5,C25,C29,C90,C100,C10000,C1PD6,D1,D2,EIGHT,FIFTY,FIVE,
     *     FOUR,ONE,R,S1,S2,S3,T,T1,T2,T3,TEN,TH,THREE,TPI,TWO,ZERO
      REAL FVEC(50),Y(15)
      REAL FLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,EIGHT,TEN,FIFTY
     *     /0.0E0,1.0E0,2.0E0,3.0E0,4.0E0,5.0E0,8.0E0,1.0E1,5.0E1/
      DATA C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,C2P25,C2P625,C3P5,C25,
     *     C29,C90,C100,C10000,C1PD6
     *     /2.0E-6,1.0E-4,1.0E-1,2.0E-1,2.5E-1,5.0E-1,1.5E0,2.25E0,
     *      2.625E0,3.5E0,2.5E1,2.9E1,9.0E1,1.0E2,1.0E4,1.0E6/
      DATA AP,BP /1.0E-5,1.0E0/
      DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),Y(9),Y(10),Y(11),
     *     Y(12),Y(13),Y(14),Y(15)
     *     /9.0E-4,4.4E-3,1.75E-2,5.4E-2,1.295E-1,2.42E-1,3.521E-1,
     *      3.989E-1,3.521E-1,2.42E-1,1.295E-1,5.4E-2,1.75E-2,4.4E-3,
     *      9.0E-4/
      FLOAT(IVAR) = IVAR
C
C     FUNCTION ROUTINE SELECTOR.
C
      GO TO (10,20,40,60,70,90,110,150,170,200,210,230,250,280,300,
     *       320,330,340), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
   10 CONTINUE
      TPI = EIGHT*ATAN(ONE)
      TH = SIGN(CP25,X(2))
      IF (X(1) .GT. ZERO) TH = ATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TH = ATAN(X(2)/X(1))/TPI + CP5
      ARG = X(1)**2 + X(2)**2
      R = SQRT(ARG)
      T = X(3) - TEN*TH
      F = C100*(T**2 + (R - ONE)**2) + X(3)**2
      GO TO 390
C
C     BIGGS EXP6 FUNCTION.
C
   20 CONTINUE
      F = ZERO
      DO 30 I = 1, 13
         D1 = FLOAT(I)/TEN
         D2 = EXP(-D1) - FIVE*EXP(-TEN*D1) + THREE*EXP(-FOUR*D1)
         S1 = EXP(-D1*X(1))
         S2 = EXP(-D1*X(2))
         S3 = EXP(-D1*X(5))
         T = X(3)*S1 - X(4)*S2 + X(6)*S3 - D2
         F = F + T**2
   30    CONTINUE
      GO TO 390
C
C     GAUSSIAN FUNCTION.
C
   40 CONTINUE
      F = ZERO
      DO 50 I = 1, 15
         D1 = CP5*FLOAT(I-1)
         D2 = C3P5 - D1 - X(3)
         ARG = -CP5*X(2)*D2**2
         R = EXP(ARG)
         T = X(1)*R - Y(I)
         F = F + T**2
   50    CONTINUE
      GO TO 390
C
C     POWELL BADLY SCALED FUNCTION.
C
   60 CONTINUE
      T1 = C10000*X(1)*X(2) - ONE
      S1 = EXP(-X(1))
      S2 = EXP(-X(2))
      T2 = S1 + S2 - ONE - CP0001
      F = T1**2 + T2**2
      GO TO 390
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
   70 CONTINUE
      F = ZERO
      DO 80 I = 1, 10
         D1 = FLOAT(I)
         D2 = D1/TEN
         S1 = EXP(-D2*X(1))
         S2 = EXP(-D2*X(2))
         S3 = EXP(-D2) - EXP(-D1)
         T = S1 - S2 - S3*X(3)
         F = F + T**2
   80    CONTINUE
      GO TO 390
C
C     VARIABLY DIMENSIONED FUNCTION.
C
   90 CONTINUE
      T1 = ZERO
      T2 = ZERO
      DO 100 J = 1, N
         T1 = T1 + FLOAT(J)*(X(J) - ONE)
         T2 = T2 + (X(J) - ONE)**2
  100    CONTINUE
      F = T2 + T1**2*(ONE + T1**2)
      GO TO 390
C
C     WATSON FUNCTION.
C
  110 CONTINUE
      F = ZERO
      DO 140 I = 1, 29
         D1 = FLOAT(I)/C29
         S1 = ZERO
         D2 = ONE
         DO 120 J = 2, N
            S1 = S1 + FLOAT(J-1)*D2*X(J)
            D2 = D1*D2
  120       CONTINUE
         S2 = ZERO
         D2 = ONE
         DO 130 J = 1, N
            S2 = S2 + D2*X(J)
            D2 = D1*D2
  130       CONTINUE
         T = S1 - S2**2 - ONE
         F = F + T**2
  140    CONTINUE
      T1 = X(2) - X(1)**2 - ONE
      F = F + X(1)**2 + T1**2
      GO TO 390
C
C     PENALTY FUNCTION I.
C
  150 CONTINUE
      T1 = -CP25
      T2 = ZERO
      DO 160 J = 1, N
         T1 = T1 + X(J)**2
         T2 = T2 + (X(J) - ONE)**2
  160    CONTINUE
      F = AP*T2 + BP*T1**2
      GO TO 390
C
C     PENALTY FUNCTION II.
C
  170 CONTINUE
      T1 = -ONE
      T2 = ZERO
      T3 = ZERO
      D1 = EXP(CP1)
      D2 = ONE
      DO 190 J = 1, N
         T1 = T1 + FLOAT(N-J+1)*X(J)**2
         S1 = EXP(X(J)/TEN)
         IF (J .EQ. 1) GO TO 180
         S3 = S1 + S2 - D2*(D1 + ONE)
         T2 = T2 + S3**2
         T3 = T3 + (S1 - ONE/D1)**2
  180    CONTINUE
         S2 = S1
         D2 = D1*D2
  190    CONTINUE
      F = AP*(T2 + T3) + BP*(T1**2 + (X(1) - CP2)**2)
      GO TO 390
C
C     BROWN BADLY SCALED FUNCTION.
C
  200 CONTINUE
      T1 = X(1) - C1PD6
      T2 = X(2) - C2PDM6
      T3 = X(1)*X(2) - TWO
      F = T1**2 + T2**2 + T3**2
      GO TO 390
C
C     BROWN AND DENNIS FUNCTION.
C
  210 CONTINUE
      F = ZERO
      DO 220 I = 1, 20
         D1 = FLOAT(I)/FIVE
         D2 = SIN(D1)
         T1 = X(1) + D1*X(2) - EXP(D1)
         T2 = X(3) + D2*X(4) - COS(D1)
         T = T1**2 + T2**2
         F = F + T**2
  220    CONTINUE
      GO TO 390
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
  230 CONTINUE
      F = ZERO
      D1 = TWO/THREE
      DO 240 I = 1, 99
         ARG = FLOAT(I)/C100
         R = ABS((-FIFTY*ALOG(ARG))**D1+C25-X(2))
         T1 = R**X(3)/X(1)
         T2 = EXP(-T1)
         T = T2 - ARG
         F = F + T**2
  240    CONTINUE
      GO TO 390
C
C     TRIGONOMETRIC FUNCTION.
C
  250 CONTINUE
      S1 = ZERO
      DO 260 J = 1, N
         S1 = S1 + COS(X(J))
  260    CONTINUE
      F = ZERO
      DO 270 J = 1, N
         T = FLOAT(N+J) - SIN(X(J)) - S1 - FLOAT(J)*COS(X(J))
         F = F + T**2
  270    CONTINUE
      GO TO 390
C
C     EXTENDED ROSENBROCK FUNCTION.
C
  280 CONTINUE
      F = ZERO
      DO 290 J = 1, N, 2
         T1 = ONE - X(J)
         T2 = TEN*(X(J+1) - X(J)**2)
         F = F + T1**2 + T2**2
  290    CONTINUE
      GO TO 390
C
C     EXTENDED POWELL FUNCTION.
C
  300 CONTINUE
      F = ZERO
      DO 310 J = 1, N, 4
         T = X(J) + TEN*X(J+1)
         T1 = X(J+2) - X(J+3)
         S1 = FIVE*T1
         T2 = X(J+1) - TWO*X(J+2)
         S2 = T2**3
         T3 = X(J) - X(J+3)
         S3 = TEN*T3**3
         F = F + T**2 + S1*T1 + S2*T2 + S3*T3
  310    CONTINUE
      GO TO 390
C
C     BEALE FUNCTION.
C
  320 CONTINUE
      S1 = ONE - X(2)
      T1 = C1P5 - X(1)*S1
      S2 = ONE - X(2)**2
      T2 = C2P25 - X(1)*S2
      S3 = ONE - X(2)**3
      T3 = C2P625 - X(1)*S3
      F = T1**2 + T2**2 + T3**2
      GO TO 390
C
C     WOOD FUNCTION.
C
  330 CONTINUE
      S1 = X(2) - X(1)**2
      S2 = ONE - X(1)
      S3 = X(2) - ONE
      T1 = X(4) - X(3)**2
      T2 = ONE - X(3)
      T3 = X(4) - ONE
      F = C100*S1**2 + S2**2 + C90*T1**2 + T2**2 + TEN*(S3 + T3)**2
     *    + (S3 - T3)**2/TEN
      GO TO 390
C
C     CHEBYQUAD FUNCTION.
C
  340 CONTINUE
      DO 350 I = 1, N
         FVEC(I) = ZERO
  350    CONTINUE
      DO 370 J = 1, N
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         DO 360 I = 1, N
            FVEC(I) = FVEC(I) + T2
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
  360       CONTINUE
  370    CONTINUE
      F = ZERO
      D1 = ONE/FLOAT(N)
      IEV = -1
      DO 380 I = 1, N
         T = D1*FVEC(I)
         IF (IEV .GT. 0) T = T + ONE/(FLOAT(I)**2 - ONE)
         F = F + T**2
         IEV = -IEV
  380    CONTINUE
  390 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE OBJFCN.
C
      END
      SUBROUTINE GRDFCN(N,X,G,NPROB)                                    00000010
      INTEGER N,NPROB
      REAL X(N),G(N)
C     **********
C
C     SUBROUTINE GRDFCN
C
C     THIS SUBROUTINE DEFINES THE GRADIENT VECTORS OF EIGHTEEN
C     NONLINEAR UNCONSTRAINED MINIMIZATION PROBLEMS. THE PROBLEM
C     DIMENSIONS ARE AS DESCRIBED IN THE PROLOGUE COMMENTS OF OBJFCN.
C
C     THE SUBROUTINE STATEMENT IS
C
C       SUBROUTINE GRDFCN(N,X,G,NPROB)
C
C     WHERE
C
C       N IS A POSITIVE INTEGER VARIABLE.
C
C       X IS AN ARRAY OF LENGTH N.
C
C       G IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS
C         THE COMPONENTS OF THE GRADIENT VECTOR OF THE NPROB
C         OBJECTIVE FUNCTION EVALUATED AT X.
C
C       NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
C         NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
C
C     SUBPROGRAMS REQUIRED
C
C       FORTRAN-SUPPLIED ... ABS,ATAN,COS,EXP,ALOG,SIGN,SIN,
C                            SQRT
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER I,IEV,IVAR,J
      REAL AP,ARG,BP,C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,C2P25,C2P625,
     *     C3P5,C19P8,C20P2,C25,C29,C100,C180,C200,C10000,C1PD6,D1,D2,
     *     EIGHT,FIFTY,FIVE,FOUR,ONE,R,S1,S2,S3,T,T1,T2,T3,TEN,TH,
     *     THREE,TPI,TWENTY,TWO,ZERO
      REAL FVEC(50),Y(15)
      REAL FLOAT
      DATA ZERO,ONE,TWO,THREE,FOUR,FIVE,EIGHT,TEN,TWENTY,FIFTY
     *     /0.0E0,1.0E0,2.0E0,3.0E0,4.0E0,5.0E0,8.0E0,1.0E1,2.0E1,
     *      5.0E1/
      DATA C2PDM6,CP0001,CP1,CP2,CP25,CP5,C1P5,C2P25,C2P625,C3P5,
     *     C19P8,C20P2,C25,C29,C100,C180,C200,C10000,C1PD6
     *     /2.0E-6,1.0E-4,1.0E-1,2.0E-1,2.5E-1,5.0E-1,1.5E0,2.25E0,
     *      2.625E0,3.5E0,1.98E1,2.02E1,2.5E1,2.9E1,1.0E2,1.8E2,2.0E2,
     *      1.0E4,1.0E6/
      DATA AP,BP /1.0E-5,1.0E0/
      DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),Y(9),Y(10),Y(11),
     *     Y(12),Y(13),Y(14),Y(15)
     *     /9.0E-4,4.4E-3,1.75E-2,5.4E-2,1.295E-1,2.42E-1,3.521E-1,
     *      3.989E-1,3.521E-1,2.42E-1,1.295E-1,5.4E-2,1.75E-2,4.4E-3,
     *      9.0E-4/
      FLOAT(IVAR) = IVAR
C
C     GRADIENT ROUTINE SELECTOR.
C
      GO TO (10,20,50,70,80,100,130,190,220,260,270,290,310,350,370,
     *       390,400,410), NPROB
C
C     HELICAL VALLEY FUNCTION.
C
   10 CONTINUE
      TPI = EIGHT*ATAN(ONE)
      TH = SIGN(CP25,X(2))
      IF (X(1) .GT. ZERO) TH = ATAN(X(2)/X(1))/TPI
      IF (X(1) .LT. ZERO) TH = ATAN(X(2)/X(1))/TPI + CP5
      ARG = X(1)**2 + X(2)**2
      R = SQRT(ARG)
      T = X(3) - TEN*TH
      S1 = TEN*T/(TPI*ARG)
      G(1) = C200*(X(1) - X(1)/R + X(2)*S1)
      G(2) = C200*(X(2) - X(2)/R - X(1)*S1)
      G(3) = TWO*(C100*T + X(3))
      GO TO 490
C
C     BIGGS EXP6 FUNCTION.
C
   20 CONTINUE
      DO 30 J = 1, N
         G(J) = ZERO
   30    CONTINUE
      DO 40 I = 1, 13
         D1 = FLOAT(I)/TEN
         D2 = EXP(-D1) - FIVE*EXP(-TEN*D1) + THREE*EXP(-FOUR*D1)
         S1 = EXP(-D1*X(1))
         S2 = EXP(-D1*X(2))
         S3 = EXP(-D1*X(5))
         T = X(3)*S1 - X(4)*S2 + X(6)*S3 - D2
         TH = D1*T
         G(1) = G(1) - S1*TH
         G(2) = G(2) + S2*TH
         G(3) = G(3) + S1*T
         G(4) = G(4) - S2*T
         G(5) = G(5) - S3*TH
         G(6) = G(6) + S3*T
   40    CONTINUE
      G(1) = TWO*X(3)*G(1)
      G(2) = TWO*X(4)*G(2)
      G(3) = TWO*G(3)
      G(4) = TWO*G(4)
      G(5) = TWO*X(6)*G(5)
      G(6) = TWO*G(6)
      GO TO 490
C
C     GAUSSIAN FUNCTION.
C
   50 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      DO 60 I = 1, 15
         D1 = CP5*FLOAT(I-1)
         D2 = C3P5 - D1 - X(3)
         ARG = -CP5*X(2)*D2**2
         R = EXP(ARG)
         T = X(1)*R - Y(I)
         S1 = R*T
         S2 = D2*S1
         G(1) = G(1) + S1
         G(2) = G(2) - D2*S2
         G(3) = G(3) + S2
   60    CONTINUE
      G(1) = TWO*G(1)
      G(2) = X(1)*G(2)
      G(3) = TWO*X(1)*X(2)*G(3)
      GO TO 490
C
C     POWELL BADLY SCALED FUNCTION.
C
   70 CONTINUE
      T1 = C10000*X(1)*X(2) - ONE
      S1 = EXP(-X(1))
      S2 = EXP(-X(2))
      T2 = S1 + S2 - ONE - CP0001
      G(1) = TWO*(C10000*X(2)*T1 - S1*T2)
      G(2) = TWO*(C10000*X(1)*T1 - S2*T2)
      GO TO 490
C
C     BOX 3-DIMENSIONAL FUNCTION.
C
   80 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      DO 90 I = 1, 10
         D1 = FLOAT(I)
         D2 = D1/TEN
         S1 = EXP(-D2*X(1))
         S2 = EXP(-D2*X(2))
         S3 = EXP(-D2) - EXP(-D1)
         T = S1 - S2 - S3*X(3)
         TH = D2*T
         G(1) = G(1) - S1*TH
         G(2) = G(2) + S2*TH
         G(3) = G(3) - S3*T
   90    CONTINUE
      G(1) = TWO*G(1)
      G(2) = TWO*G(2)
      G(3) = TWO*G(3)
      GO TO 490
C
C     VARIABLY DIMENSIONED FUNCTION.
C
  100 CONTINUE
      T1 = ZERO
      DO 110 J = 1, N
         T1 = T1 + FLOAT(J)*(X(J) - ONE)
  110    CONTINUE
      T = T1*(ONE + TWO*T1**2)
      DO 120 J = 1, N
         G(J) = TWO*(X(J) - ONE + FLOAT(J)*T)
  120    CONTINUE
      GO TO 490
C
C     WATSON FUNCTION.
C
  130 CONTINUE
      DO 140 J = 1, N
         G(J) = ZERO
  140    CONTINUE
      DO 180 I = 1, 29
         D1 = FLOAT(I)/C29
         S1 = ZERO
         D2 = ONE
         DO 150 J = 2, N
            S1 = S1 + FLOAT(J-1)*D2*X(J)
            D2 = D1*D2
  150       CONTINUE
         S2 = ZERO
         D2 = ONE
         DO 160 J = 1, N
            S2 = S2 + D2*X(J)
            D2 = D1*D2
  160       CONTINUE
         T = S1 - S2**2 - ONE
         S3 = TWO*D1*S2
         D2 = TWO/D1
         DO 170 J = 1, N
            G(J) = G(J) + D2*(FLOAT(J-1) - S3)*T
            D2 = D1*D2
  170       CONTINUE
  180    CONTINUE
      T1 = X(2) - X(1)**2 - ONE
      G(1) = G(1) + X(1)*(TWO - FOUR*T1)
      G(2) = G(2) + TWO*T1
      GO TO 490
C
C     PENALTY FUNCTION I.
C
  190 CONTINUE
      T1 = -CP25
      DO 200 J = 1, N
         T1 = T1 + X(J)**2
  200    CONTINUE
      D1 = TWO*AP
      TH = FOUR*BP*T1
      DO 210 J = 1, N
         G(J) = D1*(X(J) - ONE) + X(J)*TH
  210    CONTINUE
      GO TO 490
C
C     PENALTY FUNCTION II.
C
  220 CONTINUE
      T1 = -ONE
      DO 230 J = 1, N
         T1 = T1 + FLOAT(N-J+1)*X(J)**2
  230    CONTINUE
      D1 = EXP(CP1)
      D2 = ONE
      TH = FOUR*BP*T1
      DO 250 J = 1, N
         G(J) = FLOAT(N-J+1)*X(J)*TH
         S1 = EXP(X(J)/TEN)
         IF (J .EQ. 1) GO TO 240
         S3 = S1 + S2 - D2*(D1 + ONE)
         G(J) = G(J) + AP*S1*(S3 + S1 - ONE/D1)/FIVE
         G(J-1) = G(J-1) + AP*S2*S3/FIVE
  240    CONTINUE
         S2 = S1
         D2 = D1*D2
  250    CONTINUE
      G(1) = G(1) + TWO*BP*(X(1) - CP2)
      GO TO 490
C
C     BROWN BADLY SCALED FUNCTION.
C
  260 CONTINUE
      T1 = X(1) - C1PD6
      T2 = X(2) - C2PDM6
      T3 = X(1)*X(2) - TWO
      G(1) = TWO*(T1 + X(2)*T3)
      G(2) = TWO*(T2 + X(1)*T3)
      GO TO 490
C
C     BROWN AND DENNIS FUNCTION.
C
  270 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      G(4) = ZERO
      DO 280 I = 1, 20
         D1 = FLOAT(I)/FIVE
         D2 = SIN(D1)
         T1 = X(1) + D1*X(2) - EXP(D1)
         T2 = X(3) + D2*X(4) - COS(D1)
         T = T1**2 + T2**2
         S1 = T1*T
         S2 = T2*T
         G(1) = G(1) + S1
         G(2) = G(2) + D1*S1
         G(3) = G(3) + S2
         G(4) = G(4) + D2*S2
  280    CONTINUE
      G(1) = FOUR*G(1)
      G(2) = FOUR*G(2)
      G(3) = FOUR*G(3)
      G(4) = FOUR*G(4)
      GO TO 490
C
C     GULF RESEARCH AND DEVELOPMENT FUNCTION.
C
  290 CONTINUE
      G(1) = ZERO
      G(2) = ZERO
      G(3) = ZERO
      D1 = TWO/THREE
      DO 300 I = 1, 99
         ARG = FLOAT(I)/C100
         R = ABS((-FIFTY*ALOG(ARG))**D1+C25-X(2))
         T1 = R**X(3)/X(1)
         T2 = EXP(-T1)
         T = T2 - ARG
         S1 = T1*T2*T
         G(1) = G(1) + S1
         G(2) = G(2) + S1/R
         G(3) = G(3) - S1*ALOG(R)
  300    CONTINUE
      G(1) = TWO*G(1)/X(1)
      G(2) = TWO*X(3)*G(2)
      G(3) = TWO*G(3)
      GO TO 490
C
C     TRIGONOMETRIC FUNCTION.
C
  310 CONTINUE
      S1 = ZERO
      DO 320 J = 1, N
         G(J) = COS(X(J))
         S1 = S1 + G(J)
  320    CONTINUE
      S2 = ZERO
      DO 330 J = 1, N
         TH = SIN(X(J))
         T = FLOAT(N+J) - TH - S1 - FLOAT(J)*G(J)
         S2 = S2 + T
         G(J) = (FLOAT(J)*TH - G(J))*T
  330    CONTINUE
      DO 340 J = 1, N
         G(J) = TWO*(G(J) + SIN(X(J))*S2)
  340    CONTINUE
      GO TO 490
C
C     EXTENDED ROSENBROCK FUNCTION.
C
  350 CONTINUE
      DO 360 J = 1, N, 2
         T1 = ONE - X(J)
         G(J+1) = C200*(X(J+1) - X(J)**2)
         G(J) = -TWO*(X(J)*G(J+1) + T1)
  360    CONTINUE
      GO TO 490
C
C     EXTENDED POWELL FUNCTION.
C
  370 CONTINUE
      DO 380 J = 1, N, 4
         T = X(J) + TEN*X(J+1)
         T1 = X(J+2) - X(J+3)
         S1 = FIVE*T1
         T2 = X(J+1) - TWO*X(J+2)
         S2 = FOUR*T2**3
         T3 = X(J) - X(J+3)
         S3 = TWENTY*T3**3
         G(J) = TWO*(T + S3)
         G(J+1) = TWENTY*T + S2
         G(J+2) = TWO*(S1 - S2)
         G(J+3) = -TWO*(S1 + S3)
  380    CONTINUE
      GO TO 490
C
C     BEALE FUNCTION.
C
  390 CONTINUE
      S1 = ONE - X(2)
      T1 = C1P5 - X(1)*S1
      S2 = ONE - X(2)**2
      T2 = C2P25 - X(1)*S2
      S3 = ONE - X(2)**3
      T3 = C2P625 - X(1)*S3
      G(1) = -TWO*(S1*T1 + S2*T2 + S3*T3)
      G(2) = TWO*X(1)*(T1 + X(2)*(TWO*T2 + THREE*X(2)*T3))
      GO TO 490
C
C     WOOD FUNCTION.
C
  400 CONTINUE
      S1 = X(2) - X(1)**2
      S2 = ONE - X(1)
      S3 = X(2) - ONE
      T1 = X(4) - X(3)**2
      T2 = ONE - X(3)
      T3 = X(4) - ONE
      G(1) = -TWO*(C200*X(1)*S1 + S2)
      G(2) = C200*S1 + C20P2*S3 + C19P8*T3
      G(3) = -TWO*(C180*X(3)*T1 + T2)
      G(4) = C180*T1 + C20P2*T3 + C19P8*S3
      GO TO 490
C
C     CHEBYQUAD FUNCTION.
C
  410 CONTINUE
      DO 420 I = 1, N
         FVEC(I) = ZERO
  420    CONTINUE
      DO 440 J = 1, N
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         DO 430 I = 1, N
            FVEC(I) = FVEC(I) + T2
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
  430       CONTINUE
  440    CONTINUE
      D1 = ONE/FLOAT(N)
      IEV = -1
      DO 450 I = 1, N
         FVEC(I) = D1*FVEC(I)
         IF (IEV .GT. 0) FVEC(I) = FVEC(I) + ONE/(FLOAT(I)**2 - ONE)
         IEV = -IEV
  450    CONTINUE
      DO 470 J = 1, N
         G(J) = ZERO
         T1 = ONE
         T2 = TWO*X(J) - ONE
         T = TWO*T2
         S1 = ZERO
         S2 = TWO
         DO 460 I = 1, N
            G(J) = G(J) + FVEC(I)*S2
            TH = FOUR*T2 + T*S2 - S1
            S1 = S2
            S2 = TH
            TH = T*T2 - T1
            T1 = T2
            T2 = TH
  460       CONTINUE
  470    CONTINUE
      D2 = TWO*D1
      DO 480 J = 1, N
         G(J) = D2*G(J)
  480    CONTINUE
  490 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE GRDFCN.
C
      END
C ===== 8. SAMPLE DRIVER FOR DOUBLE PRECISION NONLINEAR EQUATIONS.
C     **********                                                        00000010
C                                                                       00000020
C     THIS PROGRAM TESTS CODES FOR THE SOLUTION OF N NONLINEAR          00000030
C     EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER AND AN          00000040
C     INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA, CALLS THE     00000050
C     NONLINEAR EQUATION SOLVER, AND FINALLY PRINTS OUT INFORMATION     00000060
C     ON THE PERFORMANCE OF THE SOLVER. THIS IS ONLY A SAMPLE DRIVER,   00000070
C     MANY OTHER DRIVERS ARE POSSIBLE. THE INTERFACE SUBROUTINE FCN     00000080
C     IS NECESSARY TO TAKE INTO ACCOUNT THE FORMS OF CALLING            00000090
C     SEQUENCES USED BY THE FUNCTION SUBROUTINES IN THE VARIOUS         00000100
C     NONLINEAR EQUATION SOLVERS.                                       00000110
C                                                                       00000120
C     SUBPROGRAMS CALLED                                                00000130
C                                                                       00000140
C       USER-SUPPLIED ...... ENORM,FCN,SOLVER                           00000150
C                                                                       00000160
C       MINPACK-SUPPLIED ... INITPT,VECFCN                              00000170
C                                                                       00000180
C       FORTRAN-SUPPLIED ... DSQRT                                      00000190
C                                                                       00000200
C     MINPACK. VERSION OF NOVEMBER 1978.                                00000210
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE             00000220
C                                                                       00000230
C     **********                                                        00000240
      INTEGER I,IC,INFO,K,LWA,N,NFEV,NPROB,NREAD,NTRIES,NWRITE          00000250
      INTEGER NA(60),NF(60),NP(60),NX(60)                               00000260
      DOUBLE PRECISION FACTOR,FNORM1,FNORM2,ONE,TEN,TOL                 00000270
      DOUBLE PRECISION FNM(60),FVEC(40),WA(2660),X(40)                  00000280
      DOUBLE PRECISION ENORM                                            00000290
      EXTERNAL FCN                                                      00000300
      COMMON /REFNUM/ NPROB,NFEV                                        00000310
C                                                                       00000320
C     LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.                     00000330
C     LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.                    00000340
C                                                                       00000350
      DATA NREAD,NWRITE /5,6/                                           00000360
C                                                                       00000370
      DATA ONE,TEN,TOL /1.0D0,1.0D1,1.D-10/                             00000380
      LWA = 2660                                                        00000390
      IC = 0                                                            00000400
   10 CONTINUE                                                          00000410
         READ (NREAD,50) NPROB,N,NTRIES                                 00000420
         IF (NPROB .LE. 0) GO TO 30                                     00000430
         FACTOR = ONE                                                   00000440
         DO 20 K = 1, NTRIES                                            00000450
            IC = IC + 1                                                 00000460
            CALL INITPT(N,X,NPROB,FACTOR)                               00000470
            CALL VECFCN(N,X,FVEC,NPROB)                                 00000480
            FNORM1 = ENORM(N,FVEC)                                      00000490
            WRITE (NWRITE,60) NPROB,N                                   00000500
            NFEV = 0                                                    00000510
            CALL SOLVER(FCN,N,X,FVEC,TOL,INFO,WA,LWA)                   00000520
            FNORM2 = ENORM(N,FVEC)                                      00000530
            NP(IC) = NPROB                                              00000540
            NA(IC) = N                                                  00000550
            NF(IC) = NFEV                                               00000560
            NX(IC) = INFO                                               00000570
            FNM(IC) = FNORM2                                            00000580
            WRITE (NWRITE,70) FNORM1,FNORM2,NFEV,INFO,(X(I), I = 1, N)  00000590
            FACTOR = TEN*FACTOR                                         00000600
   20       CONTINUE                                                    00000610
         GO TO 10                                                       00000620
   30 CONTINUE                                                          00000630
      WRITE (NWRITE,80) IC                                              00000640
      WRITE (NWRITE,90)                                                 00000650
      DO 40 I = 1, IC                                                   00000660
         WRITE (NWRITE,100) NP(I),NA(I),NF(I),NX(I),FNM(I)              00000670
   40    CONTINUE                                                       00000680
      STOP                                                              00000690
   50 FORMAT (3I5)                                                      00000700
   60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 10H DIMENSION, I5, 5X //)   00000710
   70 FORMAT (5X, 33H INITIAL L2 NORM OF THE RESIDUALS, D15.7 // 5X,    00000720
     *        33H FINAL L2 NORM OF THE RESIDUALS  , D15.7 // 5X,        00000730
     *        33H NUMBER OF FUNCTION EVALUATIONS  , I10 // 5X,          00000740
     *        15H EXIT PARAMETER, 18X, I10 // 5X,                       00000750
     *        27H FINAL APPROXIMATE SOLUTION // (5X, 5D15.7))           00000760
   80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO HYBRD1 /)               00000770
   90 FORMAT (39H NPROB   N    NFEV  INFO  FINAL L2 NORM /)             00000780
  100 FORMAT (I4, I6, I7, I6, 1X, D15.7)                                00000790
C                                                                       00000800
C     LAST CARD OF DRIVER.                                              00000810
C                                                                       00000820
      END                                                               00000830
      SUBROUTINE FCN(N,X,FVEC,IFLAG)                                    00000840
      INTEGER N,IFLAG
      DOUBLE PRECISION X(N),FVEC(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     SUBROUTINE VECFCN WITH THE APPROPRIATE VALUE OF PROBLEM
C     NUMBER (NPROB).
C
C     SUBPROGRAMS CALLED
C
C       MINPACK-SUPPLIED ... VECFCN
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER NPROB,NFEV
      COMMON /REFNUM/ NPROB,NFEV
      CALL VECFCN(N,X,FVEC,NPROB)
      NFEV = NFEV + 1
      RETURN
C
C     LAST CARD OF INTERFACE SUBROUTINE FCN.
C
      END
C ===== 9. SAMPLE DRIVER FOR SINGLE PRECISION NONLINEAR EQUATIONS.
C     **********                                                        00000010
C                                                                       00000020
C     THIS PROGRAM TESTS CODES FOR THE SOLUTION OF N NONLINEAR          00000030
C     EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER AND AN          00000040
C     INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA, CALLS THE     00000050
C     NONLINEAR EQUATION SOLVER, AND FINALLY PRINTS OUT INFORMATION     00000060
C     ON THE PERFORMANCE OF THE SOLVER. THIS IS ONLY A SAMPLE DRIVER,   00000070
C     MANY OTHER DRIVERS ARE POSSIBLE. THE INTERFACE SUBROUTINE FCN     00000080
C     IS NECESSARY TO TAKE INTO ACCOUNT THE FORMS OF CALLING            00000090
C     SEQUENCES USED BY THE FUNCTION SUBROUTINES IN THE VARIOUS         00000100
C     NONLINEAR EQUATION SOLVERS.                                       00000110
C                                                                       00000120
C     SUBPROGRAMS CALLED                                                00000130
C                                                                       00000140
C       USER-SUPPLIED ...... ENORM,FCN,SOLVER                           00000150
C                                                                       00000160
C       MINPACK-SUPPLIED ... INITPT,VECFCN                              00000170
C                                                                       00000180
C       FORTRAN-SUPPLIED ... SQRT                                       00000190
C                                                                       00000200
C     MINPACK. VERSION OF NOVEMBER 1978.                                00000210
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE             00000220
C                                                                       00000230
C     **********                                                        00000240
      INTEGER I,IC,INFO,K,LWA,N,NFEV,NPROB,NREAD,NTRIES,NWRITE          00000250
      INTEGER NA(60),NF(60),NP(60),NX(60)                               00000260
      REAL FACTOR,FNORM1,FNORM2,ONE,TEN,TOL                             00000270
      REAL FNM(60),FVEC(40),WA(2660),X(40)                              00000280
      REAL ENORM                                                        00000290
      EXTERNAL FCN                                                      00000300
      COMMON /REFNUM/ NPROB,NFEV                                        00000310
C                                                                       00000320
C     LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.                     00000330
C     LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.                    00000340
C                                                                       00000350
      DATA NREAD,NWRITE /5,6/                                           00000360
C                                                                       00000370
      DATA ONE,TEN,TOL /1.0E0,1.0E1,1.E-5/                              00000380
      LWA = 2660                                                        00000390
      IC = 0                                                            00000400
   10 CONTINUE                                                          00000410
         READ (NREAD,50) NPROB,N,NTRIES                                 00000420
         IF (NPROB .LE. 0) GO TO 30                                     00000430
         FACTOR = ONE                                                   00000440
         DO 20 K = 1, NTRIES                                            00000450
            IC = IC + 1                                                 00000460
            CALL INITPT(N,X,NPROB,FACTOR)                               00000470
            CALL VECFCN(N,X,FVEC,NPROB)                                 00000480
            FNORM1 = ENORM(N,FVEC)                                      00000490
            WRITE (NWRITE,60) NPROB,N                                   00000500
            NFEV = 0                                                    00000510
            CALL SOLVER(FCN,N,X,FVEC,TOL,INFO,WA,LWA)                   00000520
            FNORM2 = ENORM(N,FVEC)                                      00000530
            NP(IC) = NPROB                                              00000540
            NA(IC) = N                                                  00000550
            NF(IC) = NFEV                                               00000560
            NX(IC) = INFO                                               00000570
            FNM(IC) = FNORM2                                            00000580
            WRITE (NWRITE,70) FNORM1,FNORM2,NFEV,INFO,(X(I), I = 1, N)  00000590
            FACTOR = TEN*FACTOR                                         00000600
   20       CONTINUE                                                    00000610
         GO TO 10                                                       00000620
   30 CONTINUE                                                          00000630
      WRITE (NWRITE,80) IC                                              00000640
      WRITE (NWRITE,90)                                                 00000650
      DO 40 I = 1, IC                                                   00000660
         WRITE (NWRITE,100) NP(I),NA(I),NF(I),NX(I),FNM(I)              00000670
   40    CONTINUE                                                       00000680
      STOP                                                              00000690
   50 FORMAT (3I5)                                                      00000700
   60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 10H DIMENSION, I5, 5X //)   00000710
   70 FORMAT (5X, 33H INITIAL L2 NORM OF THE RESIDUALS, E15.7 // 5X,    00000720
     *        33H FINAL L2 NORM OF THE RESIDUALS  , E15.7 // 5X,        00000730
     *        33H NUMBER OF FUNCTION EVALUATIONS  , I10 // 5X,          00000740
     *        15H EXIT PARAMETER, 18X, I10 // 5X,                       00000750
     *        27H FINAL APPROXIMATE SOLUTION // (5X, 5E15.7))           00000760
   80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO HYBRD1 /)               00000770
   90 FORMAT (39H NPROB   N    NFEV  INFO  FINAL L2 NORM /)             00000780
  100 FORMAT (I4, I6, I7, I6, 1X, E15.7)                                00000790
C                                                                       00000800
C     LAST CARD OF DRIVER.                                              00000810
C                                                                       00000820
      END                                                               00000830
      SUBROUTINE FCN(N,X,FVEC,IFLAG)                                    00000840
      INTEGER N,IFLAG
      REAL X(N),FVEC(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     SUBROUTINE VECFCN WITH THE APPROPRIATE VALUE OF PROBLEM
C     NUMBER (NPROB).
C
C     SUBPROGRAMS CALLED
C
C       MINPACK-SUPPLIED ... VECFCN
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER NPROB,NFEV
      COMMON /REFNUM/ NPROB,NFEV
      CALL VECFCN(N,X,FVEC,NPROB)
      NFEV = NFEV + 1
      RETURN
C
C     LAST CARD OF INTERFACE SUBROUTINE FCN.
C
      END
C ===== 10. SAMPLE DRIVER FOR DOUBLE PRECISION NONLINEAR LEAST-SQUARES.
C     **********                                                        00000010
C                                                                       00000020
C     THIS PROGRAM TESTS CODES FOR THE LEAST-SQUARES SOLUTION OF        00000030
C     M NONLINEAR EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER     00000040
C     AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA,        00000050
C     CALLS THE NONLINEAR LEAST-SQUARES SOLVER, AND FINALLY PRINTS      00000060
C     OUT INFORMATION ON THE PERFORMANCE OF THE SOLVER. THIS IS         00000070
C     ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE        00000080
C     INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE    00000090
C     FORMS OF CALLING SEQUENCES USED BY THE FUNCTION AND JACOBIAN      00000100
C     SUBROUTINES IN THE VARIOUS NONLINEAR LEAST-SQUARES SOLVERS.       00000110
C                                                                       00000120
C     SUBPROGRAMS CALLED                                                00000130
C                                                                       00000140
C       USER-SUPPLIED ...... ENORM,FCN,SOLVER                           00000150
C                                                                       00000160
C       MINPACK-SUPPLIED ... INITPT,SSQFCN                              00000170
C                                                                       00000180
C       FORTRAN-SUPPLIED ... DSQRT                                      00000190
C                                                                       00000200
C     MINPACK. VERSION OF NOVEMBER 1978.                                00000210
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE             00000220
C                                                                       00000230
C     **********                                                        00000240
      INTEGER I,IC,INFO,K,LDFJAC,LWA,M,N,NFEV,NJEV,NPROB,NREAD,NTRIES,  00000250
     *        NWRITE                                                    00000260
      INTEGER IWA(40),MA(60),NA(60),NF(60),NJ(60),NP(60),NX(60)         00000270
      DOUBLE PRECISION FACTOR,FNORM1,FNORM2,ONE,TEN,TOL                 00000280
      DOUBLE PRECISION FJAC(65,40),FNM(60),FVEC(65),WA(265),X(40)       00000290
      DOUBLE PRECISION ENORM                                            00000300
      EXTERNAL FCN                                                      00000310
      COMMON /REFNUM/ NPROB,NFEV,NJEV                                   00000320
C                                                                       00000330
C     LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.                     00000340
C     LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.                    00000350
C                                                                       00000360
      DATA NREAD,NWRITE /5,6/                                           00000370
C                                                                       00000380
      DATA ONE,TEN,TOL /1.0D0,1.0D1,1.D-10/                             00000390
      LDFJAC = 65                                                       00000400
      LWA = 265                                                         00000410
      IC = 0                                                            00000420
   10 CONTINUE                                                          00000430
         READ (NREAD,50) NPROB,N,M,NTRIES                               00000440
         IF (NPROB .LE. 0) GO TO 30                                     00000450
         FACTOR = ONE                                                   00000460
         DO 20 K = 1, NTRIES                                            00000470
            IC = IC + 1                                                 00000480
            CALL INITPT(N,X,NPROB,FACTOR)                               00000490
            CALL SSQFCN(M,N,X,FVEC,NPROB)                               00000500
            FNORM1 = ENORM(M,FVEC)                                      00000510
            WRITE (NWRITE,60) NPROB,N,M                                 00000520
            NFEV = 0                                                    00000530
            NJEV = 0                                                    00000540
            CALL SOLVER(FCN,M,N,X,FVEC,FJAC,LDFJAC,TOL,INFO,IWA,WA,     00000550
     *                  LWA)                                            00000560
            CALL SSQFCN(M,N,X,FVEC,NPROB)                               00000570
            FNORM2 = ENORM(M,FVEC)                                      00000580
            NP(IC) = NPROB                                              00000590
            NA(IC) = N                                                  00000600
            MA(IC) = M                                                  00000610
            NF(IC) = NFEV                                               00000620
            NJ(IC) = NJEV                                               00000630
            NX(IC) = INFO                                               00000640
            FNM(IC) = FNORM2                                            00000650
            WRITE (NWRITE,70)                                           00000660
     *            FNORM1,FNORM2,NFEV,NJEV,INFO,(X(I), I = 1, N)         00000670
            FACTOR = TEN*FACTOR                                         00000680
   20       CONTINUE                                                    00000690
         GO TO 10                                                       00000700
   30 CONTINUE                                                          00000710
      WRITE (NWRITE,80) IC                                              00000720
      WRITE (NWRITE,90)                                                 00000730
      DO 40 I = 1, IC                                                   00000740
         WRITE (NWRITE,100) NP(I),NA(I),MA(I),NF(I),NJ(I),NX(I),FNM(I)  00000750
   40    CONTINUE                                                       00000760
      STOP                                                              00000770
   50 FORMAT (4I5)                                                      00000780
   60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 11H DIMENSIONS, 2I5, 5X //  00000790
     *         )                                                        00000800
   70 FORMAT (5X, 33H INITIAL L2 NORM OF THE RESIDUALS, D15.7 // 5X,    00000810
     *        33H FINAL L2 NORM OF THE RESIDUALS  , D15.7 // 5X,        00000820
     *        33H NUMBER OF FUNCTION EVALUATIONS  , I10 // 5X,          00000830
     *        33H NUMBER OF JACOBIAN EVALUATIONS  , I10 // 5X,          00000840
     *        15H EXIT PARAMETER, 18X, I10 // 5X,                       00000850
     *        27H FINAL APPROXIMATE SOLUTION // (5X, 5D15.7))           00000860
   80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO LMDER1 /)               00000870
   90 FORMAT (49H NPROB   N    M   NFEV  NJEV  INFO  FINAL L2 NORM /)   00000880
  100 FORMAT (3I5, 3I6, 2X, D15.7)                                      00000890
C                                                                       00000900
C     LAST CARD OF DRIVER.                                              00000910
C                                                                       00000920
      END                                                               00000930
      SUBROUTINE FCN(M,N,X,FVEC,FJAC,LDFJAC,IFLAG)                      00000940
      INTEGER M,N,LDFJAC,IFLAG
      DOUBLE PRECISION X(N),FVEC(M),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     LEAST-SQUARES SOLVER. FCN SHOULD ONLY CALL THE TESTING
C     FUNCTION AND JACOBIAN SUBROUTINES SSQFCN AND SSQJAC WITH
C     THE APPROPRIATE VALUE OF PROBLEM NUMBER (NPROB).
C
C     SUBPROGRAMS CALLED
C
C       MINPACK-SUPPLIED ... SSQFCN,SSQJAC
C
C     MINPACK. VERSION OF JULY 1978.
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 SSQFCN(M,N,X,FVEC,NPROB)
      IF (IFLAG .EQ. 2) CALL SSQJAC(M,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
C ===== 11. SAMPLE DRIVER FOR SINGLE PRECISION NONLINEAR LEAST-SQUARES.
C     **********                                                        00000010
C                                                                       00000020
C     THIS PROGRAM TESTS CODES FOR THE LEAST-SQUARES SOLUTION OF        00000030
C     M NONLINEAR EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER     00000040
C     AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA,        00000050
C     CALLS THE NONLINEAR LEAST-SQUARES SOLVER, AND FINALLY PRINTS      00000060
C     OUT INFORMATION ON THE PERFORMANCE OF THE SOLVER. THIS IS         00000070
C     ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE        00000080
C     INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE    00000090
C     FORMS OF CALLING SEQUENCES USED BY THE FUNCTION AND JACOBIAN      00000100
C     SUBROUTINES IN THE VARIOUS NONLINEAR LEAST-SQUARES SOLVERS.       00000110
C                                                                       00000120
C     SUBPROGRAMS CALLED                                                00000130
C                                                                       00000140
C       USER-SUPPLIED ...... ENORM,FCN,SOLVER                           00000150
C                                                                       00000160
C       MINPACK-SUPPLIED ... INITPT,SSQFCN                              00000170
C                                                                       00000180
C       FORTRAN-SUPPLIED ... SQRT                                       00000190
C                                                                       00000200
C     MINPACK. VERSION OF NOVEMBER 1978.                                00000210
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE             00000220
C                                                                       00000230
C     **********                                                        00000240
      INTEGER I,IC,INFO,K,LDFJAC,LWA,M,N,NFEV,NJEV,NPROB,NREAD,NTRIES,  00000250
     *        NWRITE                                                    00000260
      INTEGER IWA(40),MA(60),NA(60),NF(60),NJ(60),NP(60),NX(60)         00000270
      REAL FACTOR,FNORM1,FNORM2,ONE,TEN,TOL                             00000280
      REAL FJAC(65,40),FNM(60),FVEC(65),WA(265),X(40)                   00000290
      REAL ENORM                                                        00000300
      EXTERNAL FCN                                                      00000310
      COMMON /REFNUM/ NPROB,NFEV,NJEV                                   00000320
C                                                                       00000330
C     LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.                     00000340
C     LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.                    00000350
C                                                                       00000360
      DATA NREAD,NWRITE /5,6/                                           00000370
C                                                                       00000380
      DATA ONE,TEN,TOL /1.0E0,1.0E1,1.E-5/                              00000390
      LDFJAC = 65                                                       00000400
      LWA = 265                                                         00000410
      IC = 0                                                            00000420
   10 CONTINUE                                                          00000430
         READ (NREAD,50) NPROB,N,M,NTRIES                               00000440
         IF (NPROB .LE. 0) GO TO 30                                     00000450
         FACTOR = ONE                                                   00000460
         DO 20 K = 1, NTRIES                                            00000470
            IC = IC + 1                                                 00000480
            CALL INITPT(N,X,NPROB,FACTOR)                               00000490
            CALL SSQFCN(M,N,X,FVEC,NPROB)                               00000500
            FNORM1 = ENORM(M,FVEC)                                      00000510
            WRITE (NWRITE,60) NPROB,N,M                                 00000520
            NFEV = 0                                                    00000530
            NJEV = 0                                                    00000540
            CALL SOLVER(FCN,M,N,X,FVEC,FJAC,LDFJAC,TOL,INFO,IWA,WA,     00000550
     *                  LWA)                                            00000560
            CALL SSQFCN(M,N,X,FVEC,NPROB)                               00000570
            FNORM2 = ENORM(M,FVEC)                                      00000580
            NP(IC) = NPROB                                              00000590
            NA(IC) = N                                                  00000600
            MA(IC) = M                                                  00000610
            NF(IC) = NFEV                                               00000620
            NJ(IC) = NJEV                                               00000630
            NX(IC) = INFO                                               00000640
            FNM(IC) = FNORM2                                            00000650
            WRITE (NWRITE,70)                                           00000660
     *            FNORM1,FNORM2,NFEV,NJEV,INFO,(X(I), I = 1, N)         00000670
            FACTOR = TEN*FACTOR                                         00000680
   20       CONTINUE                                                    00000690
         GO TO 10                                                       00000700
   30 CONTINUE                                                          00000710
      WRITE (NWRITE,80) IC                                              00000720
      WRITE (NWRITE,90)                                                 00000730
      DO 40 I = 1, IC                                                   00000740
         WRITE (NWRITE,100) NP(I),NA(I),MA(I),NF(I),NJ(I),NX(I),FNM(I)  00000750
   40    CONTINUE                                                       00000760
      STOP                                                              00000770
   50 FORMAT (4I5)                                                      00000780
   60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 11H DIMENSIONS, 2I5, 5X //  00000790
     *         )                                                        00000800
   70 FORMAT (5X, 33H INITIAL L2 NORM OF THE RESIDUALS, E15.7 // 5X,    00000810
     *        33H FINAL L2 NORM OF THE RESIDUALS  , E15.7 // 5X,        00000820
     *        33H NUMBER OF FUNCTION EVALUATIONS  , I10 // 5X,          00000830
     *        33H NUMBER OF JACOBIAN EVALUATIONS  , I10 // 5X,          00000840
     *        15H EXIT PARAMETER, 18X, I10 // 5X,                       00000850
     *        27H FINAL APPROXIMATE SOLUTION // (5X, 5E15.7))           00000860
   80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO LMDER1 /)               00000870
   90 FORMAT (49H NPROB   N    M   NFEV  NJEV  INFO  FINAL L2 NORM /)   00000880
  100 FORMAT (3I5, 3I6, 2X, E15.7)                                      00000890
C                                                                       00000900
C     LAST CARD OF DRIVER.                                              00000910
C                                                                       00000920
      END                                                               00000930
      SUBROUTINE FCN(M,N,X,FVEC,FJAC,LDFJAC,IFLAG)                      00000940
      INTEGER M,N,LDFJAC,IFLAG
      REAL X(N),FVEC(M),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     LEAST-SQUARES SOLVER. FCN SHOULD ONLY CALL THE TESTING
C     FUNCTION AND JACOBIAN SUBROUTINES SSQFCN AND SSQJAC WITH
C     THE APPROPRIATE VALUE OF PROBLEM NUMBER (NPROB).
C
C     SUBPROGRAMS CALLED
C
C       MINPACK-SUPPLIED ... SSQFCN,SSQJAC
C
C     MINPACK. VERSION OF JULY 1978.
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 SSQFCN(M,N,X,FVEC,NPROB)
      IF (IFLAG .EQ. 2) CALL SSQJAC(M,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
C ===== 12. SAMPLE DRIVER FOR DOUBLE PRECISION UNCONSTRAINED NONLINEAR
C =====     MINIMIZATION.
C     **********                                                        00000010
C                                                                       00000020
C     THIS PROGRAM TESTS CODES FOR THE UNCONSTRAINED OPTIMIZATION OF    00000030
C     A NONLINEAR FUNCTION OF N VARIABLES. IT CONSISTS OF A DRIVER      00000040
C     AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA,        00000050
C     CALLS THE UNCONSTRAINED OPTIMIZER, AND FINALLY PRINTS OUT         00000060
C     INFORMATION ON THE PERFORMANCE OF THE OPTIMIZER. THIS IS          00000070
C     ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE        00000080
C     INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE    00000090
C     FORMS OF CALLING SEQUENCES USED BY THE FUNCTION SUBROUTINES       00000100
C     IN THE VARIOUS UNCONSTRAINED OPTIMIZERS.                          00000110
C                                                                       00000120
C     SUBPROGRAMS CALLED                                                00000130
C                                                                       00000140
C       USER-SUPPLIED ...... ENORM,FCN,SOLVER                           00000150
C                                                                       00000160
C       MINPACK-SUPPLIED ... GRDFCN,INITPT,OBJFCN                       00000170
C                                                                       00000180
C       FORTRAN-SUPPLIED ... DSQRT                                      00000190
C                                                                       00000200
C     MINPACK. VERSION OF NOVEMBER 1978.                                00000210
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE             00000220
C                                                                       00000230
C     **********                                                        00000240
      INTEGER I,IC,INFO,K,LWA,N,NFEV,NPROB,NREAD,NTRIES,NWRITE          00000250
      INTEGER NA(120),NF(120),NP(120),NX(120)                           00000260
      DOUBLE PRECISION FACTOR,F1,F2,GNORM1,GNORM2,ONE,TEN,TOL           00000270
      DOUBLE PRECISION FVAL(120),GVEC(100),GNM(120),WA(6130),X(100)     00000280
      DOUBLE PRECISION ENORM                                            00000290
      EXTERNAL FCN                                                      00000300
      COMMON /REFNUM/ NPROB,NFEV                                        00000310
C                                                                       00000320
C     LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.                     00000330
C     LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.                    00000340
C                                                                       00000350
      DATA NREAD,NWRITE /5,6/                                           00000360
C                                                                       00000370
      DATA ONE,TEN,TOL /1.0D0,1.0D1,1.D-10/                             00000380
      LWA = 6130                                                        00000390
      IC = 0                                                            00000400
   10 CONTINUE                                                          00000410
         READ (NREAD,50) NPROB,N,NTRIES                                 00000420
         IF (NPROB .LE. 0) GO TO 30                                     00000430
         FACTOR = ONE                                                   00000440
         DO 20 K = 1, NTRIES                                            00000450
            IC = IC + 1                                                 00000460
            CALL INITPT(N,X,NPROB,FACTOR)                               00000470
            CALL OBJFCN(N,X,F1,NPROB)                                   00000480
            CALL GRDFCN(N,X,GVEC,NPROB)                                 00000490
            GNORM1 = ENORM(N,GVEC)                                      00000500
            WRITE (NWRITE,60) NPROB,N                                   00000510
            NFEV = 0                                                    00000520
            CALL SOLVER(FCN,N,X,F2,GVEC,TOL,INFO,WA,LWA)                00000530
            CALL OBJFCN(N,X,F2,NPROB)                                   00000540
            CALL GRDFCN(N,X,GVEC,NPROB)                                 00000550
            GNORM2 = ENORM(N,GVEC)                                      00000560
            NP(IC) = NPROB                                              00000570
            NA(IC) = N                                                  00000580
            NF(IC) = NFEV                                               00000590
            NX(IC) = INFO                                               00000600
            FVAL(IC) = F2                                               00000610
            GNM(IC) = GNORM2                                            00000620
            WRITE (NWRITE,70)                                           00000630
     *            F1,F2,GNORM1,GNORM2,NFEV,INFO,(X(I), I = 1, N)        00000640
            FACTOR = TEN*FACTOR                                         00000650
   20       CONTINUE                                                    00000660
         GO TO 10                                                       00000670
   30 CONTINUE                                                          00000680
      WRITE (NWRITE,80) IC                                              00000690
      WRITE (NWRITE,90)                                                 00000700
      DO 40 I = 1, IC                                                   00000710
         WRITE (NWRITE,100) NP(I),NA(I),NF(I),NX(I),FVAL(I),GNM(I)      00000720
   40    CONTINUE                                                       00000730
      STOP                                                              00000740
   50 FORMAT (3I5)                                                      00000750
   60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 10H DIMENSION, I5, 5X //)   00000760
   70 FORMAT (5X, 23H INITIAL FUNCTION VALUE, D15.7 // 5X,              00000770
     *        23H FINAL FUNCTION VALUE  , D15.7 // 5X,                  00000780
     *        23H INITIAL GRADIENT NORM , D15.7 // 5X,                  00000790
     *        23H FINAL GRADIENT NORM   , D15.7 // 5X,                  00000800
     *        33H NUMBER OF FUNCTION EVALUATIONS  , I10 // 5X,          00000810
     *        15H EXIT PARAMETER, 18X, I10 // 5X,                       00000820
     *        27H FINAL APPROXIMATE SOLUTION // (5X, 5D15.7))           00000830
   80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO DRVCR1 /)               00000840
   90 FORMAT (25H NPROB   N    NFEV  INFO ,                             00000850
     *        42H FINAL FUNCTION VALUE  FINAL GRADIENT NORM /)          00000860
  100 FORMAT (I4, I6, I7, I6, 5X, D15.7, 6X, D15.7)                     00000870
C                                                                       00000880
C     LAST CARD OF DRIVER.                                              00000890
C                                                                       00000900
      END                                                               00000910
      SUBROUTINE FCN(N,X,F,GVEC,IFLAG)                                  00000920
      INTEGER N,IFLAG
      DOUBLE PRECISION F
      DOUBLE PRECISION X(N),GVEC(N)
C     **********
C
C     THE CALLING SEQUENCE OF FCN SHOULD BE IDENTICAL TO THE
C     CALLING SEQUENCE OF THE FUNCTION SUBROUTINE IN THE
C     UNCONSTRAINED OPTIMIZER. FCN SHOULD ONLY CALL THE TESTING
C     FUNCTION AND GRADIENT SUBROUTINES OBJFCN AND GRDFCN WITH
C     THE APPROPRIATE VALUE OF PROBLEM NUMBER (NPROB).
C
C     SUBPROGRAMS CALLED
C
C       MINPACK-SUPPLIED ... GRDFCN,OBJFCN
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER NPROB,NFEV
      COMMON /REFNUM/ NPROB,NFEV
      CALL OBJFCN(N,X,F,NPROB)
      CALL GRDFCN(N,X,GVEC,NPROB)
      NFEV = NFEV + 1
      RETURN
C
C     LAST CARD OF INTERFACE SUBROUTINE FCN.
C
      END
C ===== 13. SAMPLE DRIVER FOR SINGLE PRECISION UNCONSTRAINED NONLINEAR
C =====     MINIMIZATION.
C     **********                                                        00000010
C                                                                       00000020
C     THIS PROGRAM TESTS CODES FOR THE UNCONSTRAINED OPTIMIZATION OF    00000030
C     A NONLINEAR FUNCTION OF N VARIABLES. IT CONSISTS OF A DRIVER      00000040
C     AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA,        00000050
C     CALLS THE UNCONSTRAINED OPTIMIZER, AND FINALLY PRINTS OUT         00000060
C     INFORMATION ON THE PERFORMANCE OF THE OPTIMIZER. THIS IS          00000070
C     ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE        00000080
C     INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE    00000090
C     FORMS OF CALLING SEQUENCES USED BY THE FUNCTION SUBROUTINES       00000100
C     IN THE VARIOUS UNCONSTRAINED OPTIMIZERS.                          00000110
C                                                                       00000120
C     SUBPROGRAMS CALLED                                                00000130
C                                                                       00000140
C       USER-SUPPLIED ...... ENORM,FCN,SOLVER                           00000150
C                                                                       00000160
C       MINPACK-SUPPLIED ... GRDFCN,INITPT,OBJFCN                       00000170
C                                                                       00000180
C       FORTRAN-SUPPLIED ... SQRT                                       00000190
C                                                                       00000200
C     MINPACK. VERSION OF NOVEMBER 1978.                                00000210
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE             00000220
C                                                                       00000230
C     **********                                                        00000240
      INTEGER I,IC,INFO,K,LWA,N,NFEV,NPROB,NREAD,NTRIES,NWRITE          00000250
      INTEGER NA(120),NF(120),NP(120),NX(120)                           00000260
      REAL FACTOR,F1,F2,GNORM1,GNORM2,ONE,TEN,TOL                       00000270
      REAL FVAL(120),GVEC(100),GNM(120),WA(6130),X(100)                 00000280
      REAL ENORM                                                        00000290
      EXTERNAL FCN                                                      00000300
      COMMON /REFNUM/ NPROB,NFEV                                        00000310
C                                                                       00000320
C     LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.                     00000330
C     LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.                    00000340
C                                                                       00000350
      DATA NREAD,NWRITE /5,6/                                           00000360
C                                                                       00000370
      DATA ONE,TEN,TOL /1.0E0,1.0E1,1.E-5/                              00000380
      LWA = 6130                                                        00000390
      IC = 0                                                            00000400
   10 CONTINUE                                                          00000410
         READ (NREAD,50) NPROB,N,NTRIES                                 00000420
         IF (NPROB .LE. 0) GO TO 30                                     00000430
         FACTOR = ONE                                                   00000440
         DO 20 K = 1, NTRIES                                            00000450
            IC = IC + 1                                                 00000460
            CALL INITPT(N,X,NPROB,FACTOR)                               00000470
            CALL OBJFCN(N,X,F1,NPROB)                                   00000480
            CALL GRDFCN(N,X,GVEC,NPROB)                                 00000490
            GNORM1 = ENORM(N,GVEC)                                      00000500
            WRITE (NWRITE,60) NPROB,N                                   00000510
            NFEV = 0                                                    00000520
            CALL SOLVER(FCN,N,X,F2,GVEC,TOL,INFO,WA,LWA)                00000530
            CALL OBJFCN(N,X,F2,NPROB)                                   00000540
            CALL GRDFCN(N,X,GVEC,NPROB)                                 00000550
            GNORM2 = ENORM(N,GVEC)                                      00000560
            NP(IC) = NPROB                                              00000570
            NA(IC) = N                                                  00000580
            NF(IC) = NFEV                                               00000590
            NX(IC) = INFO                                               00000600
            FVAL(IC) = F2                                               00000610
            GNM(IC) = GNORM2                                            00000620
            WRITE (NWRITE,70)                                           00000630
     *            F1,F2,GNORM1,GNORM2,NFEV,INFO,(X(I), I = 1, N)        00000640
            FACTOR = TEN*FACTOR                                         00000650
   20       CONTINUE                                                    00000660
         GO TO 10                                                       00000670
   30 CONTINUE                                                          00000680
      WRITE (NWRITE,80) IC                                              00000690
      WRITE (NWRITE,90)                                                 00000700
      DO 40 I = 1, IC                                                   00000710
         WRITE (NWRITE,100) NP(I),NA(I),NF(I),NX(I),FVAL(I),GNM(I)      00000720
   40    CONTINUE                                                       00000730
      STOP                                                              00000740
   50 FORMAT (3I5)                                                      00000750
   60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 10H DIMENSION, I5, 5X //)   00000760
   70 FORMAT (5X, 23H INITIAL FUNCTION VALUE, E15.7 // 5X,              00000770
     *        23H FINAL FUNCTION VALUE  , E15.7 // 5X,                  00000780
     *        23H INITIAL GRADIENT NORM , E15.7 // 5X,                  00000790
     *        23H FINAL GRADIENT NORM   , E15.7 // 5X,                  00000800
     *        33H NUMBER OF FUNCTION EVALUATIONS  , I10 // 5X,          00000810
     *        15H EXIT PARAMETER, 18X, I10 // 5X,                       00000820
     *        27H FINAL APPROXIMATE SOLUTION // (5X, 5E15.7))           00000830
   80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO DRVCR1 /)               00000840
   90 FORMAT (25H NPROB   N    NFEV  INFO ,                             00000850
     *        42H FINAL FUNCTION VALUE  FINAL GRADIENT NORM /)          00000860
  100 FORMAT (I4, I6, I7, I6, 5X, E15.7, 6X, E15.7)                     00000870
C                                                                       00000880
C     LAST CARD OF DRIVER.                                              00000890
C                                                                       00000900
      END                                                               00000910
      SUBROUTINE FCN(N,X,F,GVEC,IFLAG)                                  00000920
      INTEGER N,IFLAG
      REAL F
      REAL X(N),GVEC(N)
C     **********
C
C     THE CALLING SEQUENCE OF FCN SHOULD BE IDENTICAL TO THE
C     CALLING SEQUENCE OF THE FUNCTION SUBROUTINE IN THE
C     UNCONSTRAINED OPTIMIZER. FCN SHOULD ONLY CALL THE TESTING
C     FUNCTION AND GRADIENT SUBROUTINES OBJFCN AND GRDFCN WITH
C     THE APPROPRIATE VALUE OF PROBLEM NUMBER (NPROB).
C
C     SUBPROGRAMS CALLED
C
C       MINPACK-SUPPLIED ... GRDFCN,OBJFCN
C
C     MINPACK. VERSION OF JULY 1978.
C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C     **********
      INTEGER NPROB,NFEV
      COMMON /REFNUM/ NPROB,NFEV
      CALL OBJFCN(N,X,F,NPROB)
      CALL GRDFCN(N,X,GVEC,NPROB)
      NFEV = NFEV + 1
      RETURN
C
C     LAST CARD OF INTERFACE SUBROUTINE FCN.
C
      END
C ===== 14. DATA (NONLINEAR EQUATIONS).
    1    2    3                                                         00000010
    2    4    3                                                         00000020
    3    2    2                                                         00000030
    4    4    3                                                         00000040
    5    3    3                                                         00000050
    6    6    2                                                         00000060
    6    9    2                                                         00000070
    7    5    3                                                         00000080
    7    6    3                                                         00000090
    7    7    3                                                         00000100
    7    8    1                                                         00000110
    7    9    1                                                         00000120
    8   10    3                                                         00000130
    8   30    1                                                         00000140
    8   40    1                                                         00000150
    9   10    3                                                         00000160
   10    1    3                                                         00000170
   10   10    3                                                         00000180
   11   10    3                                                         00000190
   12   10    3                                                         00000200
   13   10    3                                                         00000210
   14   10    3                                                         00000220
    0    0    0                                                         00000230
C ===== 15. DATA (NONLINEAR LEAST SQUARES).
    1    5   10    1                                                    00000010
    1    5   50    1                                                    00000020
    2    5   10    1                                                    00000030
    2    5   50    1                                                    00000040
    3    5   10    1                                                    00000050
    3    5   50    1                                                    00000060
    4    2    2    3                                                    00000070
    5    3    3    3                                                    00000080
    6    4    4    3                                                    00000090
    7    2    2    3                                                    00000100
    8    3   15    3                                                    00000110
    9    4   11    3                                                    00000120
   10    3   16    3                                                    00000130
   11    6   31    3                                                    00000140
   11    9   31    3                                                    00000150
   11   12   31    3                                                    00000160
   12    3   10    1                                                    00000170
   13    2   10    1                                                    00000180
   14    4   20    3                                                    00000190
   15    1    8    3                                                    00000200
   15    8    8    1                                                    00000210
   15    9    9    1                                                    00000220
   15   10   10    1                                                    00000230
   16   10   10    3                                                    00000240
   16   30   30    1                                                    00000250
   16   40   40    1                                                    00000260
   17    5   33    1                                                    00000270
   18   11   65    1                                                    00000280
    0    0    0    0                                                    00000290
C ===== 16. DATA (UNCONSTRAINED NONLINEAR OPTIMIZATION).
    1    3    3                                                         00000010
    2    6    1                                                         00000020
    3    3    1                                                         00000030
    4    2    1                                                         00000040
    5    3    1                                                         00000050
    6   10    3                                                         00000060
    7    9    3                                                         00000070
    7   12    3                                                         00000080
    8   10    3                                                         00000090
    9    1    3                                                         00000100
    9    4    3                                                         00000110
    9   10    3                                                         00000120
   10    2    3                                                         00000130
   11    4    3                                                         00000140
   12    3    2                                                         00000150
   13   10    3                                                         00000160
   14    2    3                                                         00000170
   15    4    3                                                         00000180
   16    2    3                                                         00000190
   17    4    3                                                         00000200
   18    7    1                                                         00000210
   18    8    1                                                         00000220
   18    9    1                                                         00000230
   18   10    1                                                         00000240
    0    0    0                                                         00000250


		
.

NEW PAGES:

[ODDNUGGET]

[GOPHER]