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