C ********** C C THIS PROGRAM TESTS CODES FOR THE LEAST-SQUARES SOLUTION OF C M NONLINEAR EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER C AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA, C CALLS THE NONLINEAR LEAST-SQUARES SOLVER, AND FINALLY PRINTS C OUT INFORMATION ON THE PERFORMANCE OF THE SOLVER. THIS IS C ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE C INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE C FORMS OF CALLING SEQUENCES USED BY THE FUNCTION AND JACOBIAN C SUBROUTINES IN THE VARIOUS NONLINEAR LEAST-SQUARES SOLVERS. C C SUBPROGRAMS CALLED C C USER-SUPPLIED ...... FCN C C MINPACK-SUPPLIED ... DPMPAR,ENORM,INITPT,LMSTR1,SSQFCN C C FORTRAN-SUPPLIED ... DSQRT C C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE C C ********** INTEGER I,IC,INFO,K,LDFJAC,LWA,M,N,NFEV,NJEV,NPROB,NREAD,NTRIES, * NWRITE INTEGER IWA(40),MA(60),NA(60),NF(60),NJ(60),NP(60),NX(60) DOUBLE PRECISION FACTOR,FNORM1,FNORM2,ONE,TEN,TOL DOUBLE PRECISION FJAC(40,40),FNM(60),FVEC(65),WA(265),X(40) DOUBLE PRECISION DPMPAR,ENORM EXTERNAL FCN COMMON /REFNUM/ NPROB,NFEV,NJEV C C LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5. C LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6. C DATA NREAD,NWRITE /5,6/ C DATA ONE,TEN /1.0D0,1.0D1/ TOL = DSQRT(DPMPAR(1)) LDFJAC = 40 LWA = 265 IC = 0 10 CONTINUE READ (NREAD,50) NPROB,N,M,NTRIES IF (NPROB .LE. 0) GO TO 30 FACTOR = ONE DO 20 K = 1, NTRIES IC = IC + 1 CALL INITPT(N,X,NPROB,FACTOR) CALL SSQFCN(M,N,X,FVEC,NPROB) FNORM1 = ENORM(M,FVEC) WRITE (NWRITE,60) NPROB,N,M NFEV = 0 NJEV = 0 CALL LMSTR1(FCN,M,N,X,FVEC,FJAC,LDFJAC,TOL,INFO,IWA,WA, * LWA) CALL SSQFCN(M,N,X,FVEC,NPROB) FNORM2 = ENORM(M,FVEC) NP(IC) = NPROB NA(IC) = N MA(IC) = M NF(IC) = NFEV NJ(IC) = NJEV NX(IC) = INFO FNM(IC) = FNORM2 WRITE (NWRITE,70) * FNORM1,FNORM2,NFEV,NJEV,INFO,(X(I), I = 1, N) FACTOR = TEN*FACTOR 20 CONTINUE GO TO 10 30 CONTINUE WRITE (NWRITE,80) IC WRITE (NWRITE,90) DO 40 I = 1, IC WRITE (NWRITE,100) NP(I),NA(I),MA(I),NF(I),NJ(I),NX(I),FNM(I) 40 CONTINUE STOP 50 FORMAT (4I5) 60 FORMAT ( //// 5X, 8H PROBLEM, I5, 5X, 11H DIMENSIONS, 2I5, 5X // * ) 70 FORMAT (5X, 33H INITIAL L2 NORM OF THE RESIDUALS, D15.7 // 5X, * 33H FINAL L2 NORM OF THE RESIDUALS , D15.7 // 5X, * 33H NUMBER OF FUNCTION EVALUATIONS , I10 // 5X, * 33H NUMBER OF JACOBIAN EVALUATIONS , I10 // 5X, * 15H EXIT PARAMETER, 18X, I10 // 5X, * 27H FINAL APPROXIMATE SOLUTION // (5X, 5D15.7)) 80 FORMAT (12H1SUMMARY OF , I3, 16H CALLS TO LMSTR1 /) 90 FORMAT (49H NPROB N M NFEV NJEV INFO FINAL L2 NORM /) 100 FORMAT (3I5, 3I6, 1X, D15.7) C C LAST CARD OF DRIVER. C END SUBROUTINE FCN(M,N,X,FVEC,FJROW,IFLAG) INTEGER M,N,IFLAG DOUBLE PRECISION X(N),FVEC(M),FJROW(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. IF IFLAG = 1, FCN SHOULD ONLY CALL THE C TESTING FUNCTION SUBROUTINE SSQFCN. IF IFLAG = I, I .GE. 2, C FCN SHOULD ONLY CALL SUBROUTINE SSQJAC TO CALCULATE THE C (I-1)-ST ROW OF THE JACOBIAN. (THE SSQJAC SUBROUTINE PROVIDED C HERE FOR TESTING PURPOSES CALCULATES THE ENTIRE JACOBIAN C MATRIX AND IS THEREFORE CALLED ONLY WHEN IFLAG = 2.) EACH C CALL TO SSQFCN OR SSQJAC SHOULD SPECIFY THE APPROPRIATE C VALUE OF PROBLEM NUMBER (NPROB). C C SUBPROGRAMS CALLED C C MINPACK-SUPPLIED ... SSQFCN,SSQJAC C C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE C C ********** INTEGER NPROB,NFEV,NJEV,J DOUBLE PRECISION TEMP(65,40) 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,TEMP,65,NPROB) IF (IFLAG .EQ. 1) NFEV = NFEV + 1 IF (IFLAG .EQ. 2) NJEV = NJEV + 1 IF (IFLAG .EQ. 1) GO TO 120 DO 110 J = 1, N FJROW(J) = TEMP(IFLAG-1,J) 110 CONTINUE 120 CONTINUE RETURN C C LAST CARD OF INTERFACE SUBROUTINE FCN. C END SUBROUTINE SSQJAC(M,N,X,FJAC,LDFJAC,NPROB) 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 ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. 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, * ONE,PROD,S2,TEMP,TEN,THREE,TI,TMP1,TMP2,TMP3, * 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 * /0.0D0,1.0D0,2.0D0,3.0D0,4.0D0,5.0D0,8.0D0,1.0D1,1.4D1, * 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) * /4.0D0,2.0D0,1.0D0,5.0D-1,2.5D-1,1.67D-1,1.25D-1,1.0D-1, * 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, * 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 SUBROUTINE INITPT(N,X,NPROB,FACTOR) INTEGER N,NPROB DOUBLE PRECISION FACTOR DOUBLE PRECISION X(N) C ********** C C SUBROUTINE INITPT C C THIS SUBROUTINE SPECIFIES THE STANDARD STARTING POINTS FOR 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 ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE C C ********** INTEGER IVAR,J DOUBLE PRECISION C1,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 DOUBLE PRECISION DFLOAT DATA ZERO,HALF,ONE,TWO,THREE,FIVE,SEVEN,TEN,TWENTY,TWNTF * /0.0D0,5.0D-1,1.0D0,2.0D0,3.0D0,5.0D0,7.0D0,1.0D1,2.0D1, * 2.5D1/ DATA C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16,C17 * /1.2D0,2.5D-1,3.9D-1,4.15D-1,2.0D-2,4.0D3,2.5D2,3.0D-1, * 4.0D-1,1.5D0,1.0D-2,1.3D0,6.5D-1,7.0D-1,6.0D-1,4.5D0, * 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, * 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) 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 ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. 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, * S1,S2,TEMP,TEN,TI,TMP1,TMP2,TMP3,TMP4,TPI,TWO, * 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 * /0.0D0,2.5D-1,5.0D-1,1.0D0,2.0D0,5.0D0,8.0D0,1.0D1,1.3D1, * 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) * /4.0D0,2.0D0,1.0D0,5.0D-1,2.5D-1,1.67D-1,1.25D-1,1.0D-1, * 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), * Y1(10),Y1(11),Y1(12),Y1(13),Y1(14),Y1(15) * /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.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), * Y2(10),Y2(11) * /1.957D-1,1.947D-1,1.735D-1,1.6D-1,8.44D-2,6.27D-2,4.56D-2, * 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), * Y3(10),Y3(11),Y3(12),Y3(13),Y3(14),Y3(15),Y3(16) * /3.478D4,2.861D4,2.365D4,1.963D4,1.637D4,1.372D4,1.154D4, * 9.744D3,8.261D3,7.03D3,6.005D3,5.147D3,4.427D3,3.82D3, * 3.307D3,2.872D3/ 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.44D-1,9.08D-1,9.32D-1,9.36D-1,9.25D-1,9.08D-1,8.81D-1, * 8.5D-1,8.18D-1,7.84D-1,7.51D-1,7.18D-1,6.85D-1,6.58D-1, * 6.28D-1,6.03D-1,5.8D-1,5.58D-1,5.38D-1,5.22D-1,5.06D-1, * 4.9D-1,4.78D-1,4.67D-1,4.57D-1,4.48D-1,4.38D-1,4.31D-1, * 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), * 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.366D0,1.191D0,1.112D0,1.013D0,9.91D-1,8.85D-1,8.31D-1, * 8.47D-1,7.86D-1,7.25D-1,7.46D-1,6.79D-1,6.08D-1,6.55D-1, * 6.16D-1,6.06D-1,6.02D-1,6.26D-1,6.51D-1,7.24D-1,6.49D-1, * 6.49D-1,6.94D-1,6.44D-1,6.24D-1,6.61D-1,6.12D-1,5.58D-1, * 5.33D-1,4.95D-1,5.0D-1,4.23D-1,3.95D-1,3.75D-1,3.72D-1, * 3.91D-1,3.96D-1,4.05D-1,4.28D-1,4.29D-1,5.23D-1,5.62D-1, * 6.07D-1,6.53D-1,6.72D-1,7.08D-1,6.33D-1,6.68D-1,6.45D-1, * 6.32D-1,5.91D-1,5.59D-1,5.97D-1,6.25D-1,7.39D-1,7.1D-1, * 7.29D-1,7.2D-1,6.36D-1,5.81D-1,4.28D-1,2.92D-1,1.62D-1, * 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, * 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)) * + (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) * - (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