mirror of https://gitlab.com/QEF/q-e.git
676 lines
19 KiB
Fortran
676 lines
19 KiB
Fortran
! **********
|
|
!
|
|
! THIS PROGRAM TESTS CODES FOR THE LEAST-SQUARES SOLUTION OF
|
|
! M NONLINEAR EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER
|
|
! AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA,
|
|
! CALLS THE NONLINEAR LEAST-SQUARES SOLVER, AND FINALLY PRINTS
|
|
! OUT INFORMATION ON THE PERFORMANCE OF THE SOLVER. THIS IS
|
|
! ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE
|
|
! INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE
|
|
! FORMS OF CALLING SEQUENCES USED BY THE FUNCTION AND JACOBIAN
|
|
! SUBROUTINES IN THE VARIOUS NONLINEAR LEAST-SQUARES SOLVERS.
|
|
!
|
|
! SUBPROGRAMS CALLED
|
|
!
|
|
! USER-SUPPLIED ...... FCN
|
|
!
|
|
! MINPACK-SUPPLIED ... DPMPAR,ENORM,INITPT,LMDIF1,SSQFCN
|
|
!
|
|
! FORTRAN-SUPPLIED ... DSQRT
|
|
!
|
|
! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
|
|
! BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
|
|
!
|
|
! **********
|
|
INTEGER I,IC,INFO,K,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 FNM(60),FVEC(65),WA(2865),X(40)
|
|
DOUBLE PRECISION DPMPAR,ENORM
|
|
EXTERNAL FCN
|
|
COMMON /REFNUM/ NPROB,NFEV,NJEV
|
|
!
|
|
! LOGICAL INPUT UNIT IS ASSUMED TO BE NUMBER 5.
|
|
! LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.
|
|
!
|
|
DATA NREAD,NWRITE /5,6/
|
|
!
|
|
DATA ONE,TEN /1.0D0,1.0D1/
|
|
TOL = DSQRT(DPMPAR(1))
|
|
LWA = 2865
|
|
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 LMDIF1(FCN,M,N,X,FVEC,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
|
|
NJEV = NJEV/N
|
|
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 LMDIF1 /)
|
|
90 FORMAT (49H NPROB N M NFEV NJEV INFO FINAL L2 NORM /)
|
|
100 FORMAT (3I5, 3I6, 1X, D15.7)
|
|
!
|
|
! LAST CARD OF DRIVER.
|
|
!
|
|
END
|
|
SUBROUTINE FCN(M,N,X,FVEC,IFLAG)
|
|
INTEGER M,N,IFLAG
|
|
DOUBLE PRECISION X(N),FVEC(M)
|
|
! **********
|
|
!
|
|
! THE CALLING SEQUENCE OF FCN SHOULD BE IDENTICAL TO THE
|
|
! CALLING SEQUENCE OF THE FUNCTION SUBROUTINE IN THE NONLINEAR
|
|
! LEAST-SQUARES SOLVER. FCN SHOULD ONLY CALL THE TESTING
|
|
! FUNCTION SUBROUTINE SSQFCN WITH THE APPROPRIATE VALUE OF
|
|
! PROBLEM NUMBER (NPROB).
|
|
!
|
|
! SUBPROGRAMS CALLED
|
|
!
|
|
! MINPACK-SUPPLIED ... SSQFCN
|
|
!
|
|
! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
|
|
! BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
|
|
!
|
|
! **********
|
|
INTEGER NPROB,NFEV,NJEV
|
|
COMMON /REFNUM/ NPROB,NFEV,NJEV
|
|
CALL SSQFCN(M,N,X,FVEC,NPROB)
|
|
IF (IFLAG .EQ. 1) NFEV = NFEV + 1
|
|
IF (IFLAG .EQ. 2) NJEV = NJEV + 1
|
|
RETURN
|
|
!
|
|
! LAST CARD OF INTERFACE SUBROUTINE FCN.
|
|
!
|
|
END
|
|
SUBROUTINE SSQFCN(M,N,X,FVEC,NPROB)
|
|
INTEGER M,N,NPROB
|
|
DOUBLE PRECISION X(N),FVEC(M)
|
|
! **********
|
|
!
|
|
! SUBROUTINE SSQFCN
|
|
!
|
|
! THIS SUBROUTINE DEFINES THE FUNCTIONS OF EIGHTEEN NONLINEAR
|
|
! LEAST SQUARES PROBLEMS. THE ALLOWABLE VALUES OF (M,N) FOR
|
|
! FUNCTIONS 1,2 AND 3 ARE VARIABLE BUT WITH M .GE. N.
|
|
! FOR FUNCTIONS 4,5,6,7,8,9 AND 10 THE VALUES OF (M,N) ARE
|
|
! (2,2),(3,3),(4,4),(2,2),(15,3),(11,4) AND (16,3), RESPECTIVELY.
|
|
! FUNCTION 11 (WATSON) HAS M = 31 WITH N USUALLY 6 OR 9.
|
|
! HOWEVER, ANY N, N = 2,...,31, IS PERMITTED.
|
|
! FUNCTIONS 12,13 AND 14 HAVE N = 3,2 AND 4, RESPECTIVELY, BUT
|
|
! ALLOW ANY M .GE. N, WITH THE USUAL CHOICES BEING 10,10 AND 20.
|
|
! FUNCTION 15 (CHEBYQUAD) ALLOWS M AND N VARIABLE WITH M .GE. N.
|
|
! FUNCTION 16 (BROWN) ALLOWS N VARIABLE WITH M = N.
|
|
! FOR FUNCTIONS 17 AND 18, THE VALUES OF (M,N) ARE
|
|
! (33,5) AND (65,11), RESPECTIVELY.
|
|
!
|
|
! THE SUBROUTINE STATEMENT IS
|
|
!
|
|
! SUBROUTINE SSQFCN(M,N,X,FVEC,NPROB)
|
|
!
|
|
! WHERE
|
|
!
|
|
! M AND N ARE POSITIVE INTEGER INPUT VARIABLES. N MUST NOT
|
|
! EXCEED M.
|
|
!
|
|
! X IS AN INPUT ARRAY OF LENGTH N.
|
|
!
|
|
! FVEC IS AN OUTPUT ARRAY OF LENGTH M WHICH CONTAINS THE NPROB
|
|
! FUNCTION EVALUATED AT X.
|
|
!
|
|
! NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
|
|
! NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
|
|
!
|
|
! SUBPROGRAMS CALLED
|
|
!
|
|
! FORTRAN-SUPPLIED ... DATAN,DCOS,DEXP,DSIN,DSQRT,DSIGN
|
|
!
|
|
! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
|
|
! BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
|
|
!
|
|
! **********
|
|
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
|
|
!
|
|
! FUNCTION ROUTINE SELECTOR.
|
|
!
|
|
GO TO (10,40,70,110,120,130,140,150,170,190,210,250,270,290,310, &
|
|
& 360,390,410), NPROB
|
|
!
|
|
! LINEAR FUNCTION - FULL RANK.
|
|
!
|
|
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
|
|
!
|
|
! LINEAR FUNCTION - RANK 1.
|
|
!
|
|
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
|
|
!
|
|
! LINEAR FUNCTION - RANK 1 WITH ZERO COLUMNS AND ROWS.
|
|
!
|
|
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
|
|
!
|
|
! ROSENBROCK FUNCTION.
|
|
!
|
|
110 CONTINUE
|
|
FVEC(1) = TEN*(X(2) - X(1)**2)
|
|
FVEC(2) = ONE - X(1)
|
|
GO TO 430
|
|
!
|
|
! HELICAL VALLEY FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! POWELL SINGULAR FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! FREUDENSTEIN AND ROTH FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! BARD FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! KOWALIK AND OSBORNE FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! MEYER FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! WATSON FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! BOX 3-DIMENSIONAL FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! JENNRICH AND SAMPSON FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! BROWN AND DENNIS FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! CHEBYQUAD FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! BROWN ALMOST-LINEAR FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! OSBORNE 1 FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! OSBORNE 2 FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! LAST CARD OF SUBROUTINE SSQFCN.
|
|
!
|
|
END
|
|
SUBROUTINE INITPT(N,X,NPROB,FACTOR)
|
|
INTEGER N,NPROB
|
|
DOUBLE PRECISION FACTOR
|
|
DOUBLE PRECISION X(N)
|
|
! **********
|
|
!
|
|
! SUBROUTINE INITPT
|
|
!
|
|
! THIS SUBROUTINE SPECIFIES THE STANDARD STARTING POINTS FOR THE
|
|
! FUNCTIONS DEFINED BY SUBROUTINE SSQFCN. THE SUBROUTINE RETURNS
|
|
! IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR
|
|
! THE 11TH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN
|
|
! THIS CASE, IF FACTOR IS NOT UNITY, THEN THE SUBROUTINE RETURNS
|
|
! THE VECTOR X(J) = FACTOR, J=1,...,N.
|
|
!
|
|
! THE SUBROUTINE STATEMENT IS
|
|
!
|
|
! SUBROUTINE INITPT(N,X,NPROB,FACTOR)
|
|
!
|
|
! WHERE
|
|
!
|
|
! N IS A POSITIVE INTEGER INPUT VARIABLE.
|
|
!
|
|
! X IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE STANDARD
|
|
! STARTING POINT FOR PROBLEM NPROB MULTIPLIED BY FACTOR.
|
|
!
|
|
! NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE
|
|
! NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18.
|
|
!
|
|
! FACTOR IS AN INPUT VARIABLE WHICH SPECIFIES THE MULTIPLE OF
|
|
! THE STANDARD STARTING POINT. IF FACTOR IS UNITY, NO
|
|
! MULTIPLICATION IS PERFORMED.
|
|
!
|
|
! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980.
|
|
! BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
|
|
!
|
|
! **********
|
|
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
|
|
!
|
|
! SELECTION OF INITIAL POINT.
|
|
!
|
|
GO TO (10,10,10,30,40,50,60,70,80,90,100,120,130,140,150,170, &
|
|
& 190,200), NPROB
|
|
!
|
|
! LINEAR FUNCTION - FULL RANK OR RANK 1.
|
|
!
|
|
10 CONTINUE
|
|
DO 20 J = 1, N
|
|
X(J) = ONE
|
|
20 CONTINUE
|
|
GO TO 210
|
|
!
|
|
! ROSENBROCK FUNCTION.
|
|
!
|
|
30 CONTINUE
|
|
X(1) = -C1
|
|
X(2) = ONE
|
|
GO TO 210
|
|
!
|
|
! HELICAL VALLEY FUNCTION.
|
|
!
|
|
40 CONTINUE
|
|
X(1) = -ONE
|
|
X(2) = ZERO
|
|
X(3) = ZERO
|
|
GO TO 210
|
|
!
|
|
! POWELL SINGULAR FUNCTION.
|
|
!
|
|
50 CONTINUE
|
|
X(1) = THREE
|
|
X(2) = -ONE
|
|
X(3) = ZERO
|
|
X(4) = ONE
|
|
GO TO 210
|
|
!
|
|
! FREUDENSTEIN AND ROTH FUNCTION.
|
|
!
|
|
60 CONTINUE
|
|
X(1) = HALF
|
|
X(2) = -TWO
|
|
GO TO 210
|
|
!
|
|
! BARD FUNCTION.
|
|
!
|
|
70 CONTINUE
|
|
X(1) = ONE
|
|
X(2) = ONE
|
|
X(3) = ONE
|
|
GO TO 210
|
|
!
|
|
! KOWALIK AND OSBORNE FUNCTION.
|
|
!
|
|
80 CONTINUE
|
|
X(1) = C2
|
|
X(2) = C3
|
|
X(3) = C4
|
|
X(4) = C3
|
|
GO TO 210
|
|
!
|
|
! MEYER FUNCTION.
|
|
!
|
|
90 CONTINUE
|
|
X(1) = C5
|
|
X(2) = C6
|
|
X(3) = C7
|
|
GO TO 210
|
|
!
|
|
! WATSON FUNCTION.
|
|
!
|
|
100 CONTINUE
|
|
DO 110 J = 1, N
|
|
X(J) = ZERO
|
|
110 CONTINUE
|
|
GO TO 210
|
|
!
|
|
! BOX 3-DIMENSIONAL FUNCTION.
|
|
!
|
|
120 CONTINUE
|
|
X(1) = ZERO
|
|
X(2) = TEN
|
|
X(3) = TWENTY
|
|
GO TO 210
|
|
!
|
|
! JENNRICH AND SAMPSON FUNCTION.
|
|
!
|
|
130 CONTINUE
|
|
X(1) = C8
|
|
X(2) = C9
|
|
GO TO 210
|
|
!
|
|
! BROWN AND DENNIS FUNCTION.
|
|
!
|
|
140 CONTINUE
|
|
X(1) = TWNTF
|
|
X(2) = FIVE
|
|
X(3) = -FIVE
|
|
X(4) = -ONE
|
|
GO TO 210
|
|
!
|
|
! CHEBYQUAD FUNCTION.
|
|
!
|
|
150 CONTINUE
|
|
H = ONE/DFLOAT(N+1)
|
|
DO 160 J = 1, N
|
|
X(J) = DFLOAT(J)*H
|
|
160 CONTINUE
|
|
GO TO 210
|
|
!
|
|
! BROWN ALMOST-LINEAR FUNCTION.
|
|
!
|
|
170 CONTINUE
|
|
DO 180 J = 1, N
|
|
X(J) = HALF
|
|
180 CONTINUE
|
|
GO TO 210
|
|
!
|
|
! OSBORNE 1 FUNCTION.
|
|
!
|
|
190 CONTINUE
|
|
X(1) = HALF
|
|
X(2) = C10
|
|
X(3) = -ONE
|
|
X(4) = C11
|
|
X(5) = C5
|
|
GO TO 210
|
|
!
|
|
! OSBORNE 2 FUNCTION.
|
|
!
|
|
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
|
|
!
|
|
! COMPUTE MULTIPLE OF INITIAL POINT.
|
|
!
|
|
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
|
|
!
|
|
! LAST CARD OF SUBROUTINE INITPT.
|
|
!
|
|
END
|