scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
quantum-espresso/GWW/minpack/test.f90

676 lines
19 KiB
Fortran
Raw Permalink Blame History

! **********
!
! 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
Reference in New Issue View Git Blame Copy Permalink