C C COLVILLE 1 C REAL*8 Y(5),S,T REAL*8 X(15),LE(50),LI(15),U(100),DF(15),BL(15),BU(15),W(100) REAL*8 VF,CT,ER,ST REAL*8 A(10,15),B(10),C(5,5),D(5),E(5),VALF INTEGER IA(15),K,IO,IT real zzz(2) COMMON A,B,C,D,E,NF,NDF EXTERNAL VALF,GRADF DATA A/-16.D0,0.D0,-3.5D0,0.D0,0.D0,2.D0,-1.D0,-1.D0,1.D0,1.D0, 1 2.D0,-2.D0,0.D0,-2.D0,-9.D0,0.D0,-1.D0,-2.D0,2.D0,1.D0, 2 0.D0,0.D0,2.D0,0.D0,-2.D0,-4.D0,-1.D0,-3.D0,3.D0,1.D0, 3 1.D0,.4D0,0.D0,-4.D0,1.D0,0.D0,-1.D0,-2.D0,4.D0,1.D0, 4 0.D0,2.D0,0.D0,-1.D0,-2.8D0,0.D0,-1.D0,-1.D0,5.D0,1.D0, 5 -1.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 6 0.D0,-1.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 7 0.D0,0.D0,-1.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 8 0.D0,0.D0,0.D0,-1.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 9 0.D0,0.D0,0.D0,0.D0,-1.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 1 0.D0,0.D0,0.D0,0.D0,0.D0,-1.D0,0.D0,0.D0,0.D0,0.D0, 2 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,-1.D0,0.D0,0.D0,0.D0, 3 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,-1.D0,0.D0,0.D0, 4 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,-1.D0,0.D0, 5 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,-1.D0/ DATA B/-40.D0,-2.D0,-.25D0,-4.D0,-4.D0,-1.D0,-40.D0, 1 -60.D0,5.D0,1.D0/ DATA C/30.D0,-20.D0,-10.D0,32.D0,-10.D0, 1 -20.D0,39.D0,-6.D0,-31.D0,32.D0, 2 -10.D0,-6.D0,10.D0,-6.D0,-10.D0, 3 32.D0,-31.D0,-6.D0,39.D0,-20.D0, 4 -10.D0,32.D0,-10.D0,-20.D0,30.D0/ DATA D/4.D0,8.D0,10.D0,6.D0,2.D0/ DATA E/-15.D0,-27.D0,-36.D0,-18.D0,-12.D0/ DATA X/0.D0,0.D0,0.D0,0.D0,1.D0,40.D0,4.D0,.25D0,3.D0, 1 1.2D0,1.D0,39.D0,59.D0,0.D0,0.D0/ DATA BL/0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 1 0.D0,0.D0,0.D0,0.D0/ DATA BU/90.D0,90.D0,90.D0,90.D0,90.D0,90.D0,90.D0,90.D0,90.D0, 1 90.D0,90.D0,90.D0,90.D0,90.D0,90.D0/ NF = 0 NDF= 0 LA = 10 N = 15 ST = 0. CT = 1.D-4 strt = etime(zzz) CALL LMIN(X,LE,LI,U,IA,K,VF,DF,ER,IT,ST,IO, 1 4,1.D-6,500,A,10,10,15,B,BL,BU,CT,VALF,GRADF,W) CALL ERR(IO) time = etime(zzz) - strt write(6,*) 'total time =',time WRITE(6,*) 'BINDERS:' WRITE(6,*) (IA(I), I=1,N) WRITE(6,*) 'VALUE:',VF WRITE(6,*) 'ITERATIONS:',IT WRITE(6,*) 'FREE VARIABLES:',K WRITE(6,*) 'NUMBER OF FUNCTION EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF GRADIENT EVALUATIONS:',NDF DATA Y/.3D0,.33346761D0,.4D0,.42831010D0,.22396487D0/ T = 0. S = 0. DO 10 I = 1,5 WRITE(6,*) I,Y(I),X(I) T = T + (X(I)-Y(I))**2 S = S + Y(I)**2 10 CONTINUE S = DSQRT(T/S) WRITE(6,*) 'RELATIVE ERROR:',S STOP END DOUBLE PRECISION FUNCTION VALF(X) REAL*8 X(1),S,T REAL*8 A(10,15),B(10),C(5,5),D(5),E(5) COMMON A,B,C,D,E,NF,NDF NF = NF + 1 T = 0. DO 20 J = 1,5 S = 0. DO 10 I = 1,5 10 S = S + C(I,J)*X(I) 20 T = T + E(J)*X(J) + D(J)*X(J)**3 + S*X(J) VALF = T RETURN END SUBROUTINE GRADF(DF,X) REAL*8 DF(1),X(1),T REAL*8 A(10,15),B(10),C(5,5),D(5),E(5) COMMON A,B,C,D,E,NF,NDF NDF = NDF + 1 DO 20 J = 1,5 T = 0. DO 10 I = 1,5 10 T = T + C(I,J)*X(I) 20 DF(J) = E(J) + T + T + 3.*D(J)*X(J)*X(J) DO 30 J = 6,15 30 DF(J) = 0. RETURN END ======================= C C COLVILLE 2 C REAL*8 Y(15),SS,TT REAL*8 X(25),LE(10),LI(25),U(300),G(5),DF(25),DG(5,25) REAL*8 AA(10,25),BL(25),BU(25),W(200) REAL*8 A(5,10),B(10),C(5,5),D(5),E(5) REAL*8 CT,F,ER,PN,PNI,ST,TL,T,VALF INTEGER IA(25),IO,IN,K,IT,L,LA,LG,LM,NL,N real zzz(2) COMMON A,B,C,D,E,NF,NG,NDF,NDG EXTERNAL VALF,VALG,GRADF,GRADG DATA A/-16.D0,2.D0,0.D0,1.D0,0.D0, 1 0.D0,-2.D0,0.D0,.4D0,2.D0, 2 -3.5D0,0.D0,2.D0,0.D0,0.D0, 3 0.D0,-2.D0,0.D0,-4.D0,-1.D0, 4 0.D0,-9.D0,-2.D0,1.D0,-2.8D0, 5 2.D0,0.D0,-4.D0,0.D0,0.D0, 6 -1.D0,-1.D0,-1.D0,-1.D0,-1.D0, 7 -1.D0,-2.D0,-3.D0,-2.D0,-1.D0, 8 1.D0,2.D0,3.D0,4.D0,5.D0, 9 1.D0,1.D0,1.D0,1.D0,1.D0/ DATA B/-40.D0,-2.D0,-.25D0,-4.D0,-4.D0,-1.D0,-40.D0, 1 -60.D0,5.D0,1.D0/ DATA C/30.D0,-20.D0,-10.D0,32.D0,-10.D0, 1 -20.D0,39.D0,-6.D0,-31.D0,32.D0, 2 -10.D0,-6.D0,10.D0,-6.D0,-10.D0, 3 32.D0,-31.D0,-6.D0,39.D0,-20.D0, 4 -10.D0,32.D0,-10.D0,-20.D0,30.D0/ DATA D/4.D0,8.D0,10.D0,6.D0,2.D0/ DATA E/-15.D0,-27.D0,-36.D0,-18.D0,-12.D0/ NF = 0 NG = 0 NDF = 0 NDG = 0 DO 10 I = 1,5 DO 10 J = 1,10 10 AA(I,J) = A(I,J) DO 40 I = 1,5 DO 20 J = 11,15 20 AA(I,J) = -2*C(I,J-10) DO 30 J = 16,25 30 AA(I,J) = 0. AA(I,15+I) = -3*D(I) AA(I,20+I) = 1 40 CONTINUE DO 60 I = 1,5 DO 50 J = 1,25 50 DG(I,J) = 0. DG(I,I+15) = 1 60 CONTINUE DO 70 I = 21,25 70 DF(I) = 0. DO 80 I = 1,25 BL(I) = 0. 80 BU(I) = 200. DO 90 I = 16,20 90 BL(I) = -200. C C FEASIBLE STARTING GUESS C IN = 4 DO 100 I = 1,15 100 X(I) = 1.D-4 X(7) = 60. DO 105 I = 1,5 105 X(I+15) = X(I+10)**2 DO 115 I = 1,5 T = E(I) DO 110 J = 1,20 110 T = T - AA(I,J)*X(J) X(I+20) = T 115 CONTINUE C C INFEASIBLE STARTING GUESS C C IN = 0 C DO 100 I = 1,10 C100 X(I) = B(I) C DO 110 I = 11,25 C110 X(I) = 0. C X(15) = 1 C X(20) = 1 TL = .0001 LM = 250 C C ORIGINAL PENALTY WAS 40, THEN TRIED 10, 50, 250 C PNI = 10 L = 5 N = 25 LA = 10 LG = 5 NL = 5 ST = 0 CT = 1.D-4 CALL NORM(AA,LA,L,N,E,W) strt = etime(zzz) CALL MIN(X,LE,LI,U,IA,K,F,G,DF,DG,ER,IT,ST,PN,IO, 1 IN,TL,LM,PNI,AA,LA,LG,L,NL,N,E,BL,BU,CT,VALF,VALG,GRADF,GRADG,W) CALL ERR(IO) time = etime(zzz) - strt write(6,*) 'total time =',time WRITE(6,*) 'VALUE:',F WRITE(6,*) 'LE MULTIPLIERS:' J = L + NL DO 120 I = 1,J 120 WRITE(6,*) I,LE(I) WRITE(6,*) 'LI MULTIPLIERS:' DO 130 I = 1,N 130 WRITE(6,*) I,LI(I) WRITE(6,*) 'NUMBER OF F EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF G EVALUATIONS:',NG WRITE(6,*) 'NUMBER OF DF EVALUATIONS:',NDF WRITE(6,*) 'NUMBER OF DG EVALUATIONS:',NDG DATA Y/0.D0,0.D0,5.1740399D0,0.D0,3.0611083D0,11.8395453D0, & 0.D0,0.D0,.10389602D0,0.D0,.3D0,.33346761D0,.4D0, & .4283101D0,.22396487D0/ TT = 0. SS = 0. DO 200 I = 1,15 TT = TT + (X(I)-Y(I))**2 SS = SS + Y(I)**2 WRITE(6,*) I,Y(I),X(I) 200 CONTINUE SS = DSQRT(TT/SS) WRITE(6,*) 'RELATIVE ERROR:',SS STOP END DOUBLE PRECISION FUNCTION VALF(X) REAL*8 X(1),A(5,10),B(10),C(5,5),D(5),E(5),S,T COMMON A,B,C,D,E,NF,NG,NDF,NDG NF = NF + 1 T = 0. DO 10 I = 1,10 10 T = T - B(I)*X(I) DO 30 J = 1,5 S = 0. DO 20 I = 1,5 20 S = S + C(I,J)*X(I+10) 30 T = T + S*X(J+10) DO 40 I = 1,5 40 T = T + 2.*D(I)*X(I+10)*X(I+15) VALF = T RETURN END SUBROUTINE GRADF(DF,X) REAL*8 DF(1),X(1),A(5,10),B(10),C(5,5),D(5),E(5),T COMMON A,B,C,D,E,NF,NG,NDF,NDG NDF = NDF + 1 DO 10 I = 1,10 10 DF(I) = -B(I) DO 30 J = 1,5 T = 0. DO 20 I = 1,5 20 T = T + C(I,J)*X(I+10) 30 DF(J+10) = T + T + 2.*D(J)*X(J+15) DO 40 I = 16,20 40 DF(I) = 2.*D(I-15)*X(I-5) RETURN END SUBROUTINE VALG(G,X) REAL*8 G(1),X(1) REAL*8 A(5,10),B(10),C(5,5),D(5),E(5) COMMON A,B,C,D,E,NF,NG,NDF,NDG NG = NG + 1 DO 10 I = 11,15 10 G(I-10) = X(I+5) - X(I)**2 RETURN END SUBROUTINE GRADG(DG,X) REAL*8 DG(5,1),X(1) REAL*8 A(5,10),B(10),C(5,5),D(5),E(5) COMMON A,B,C,D,E,NF,NG,NDF,NDG NDG = NDG + 1 DO 10 I = 1,5 DG(I,I+10) = -2.*X(I+10) 10 CONTINUE RETURN END ===================== C C COLVILLE 3 C REAL*8 Y(5),SS,TT REAL*8 X(8),LE(3),LI(8),G(3),DF(8),DG(3,8),W(200),U(100),A(3,8) REAL*8 B(1),BL(8),BU(8),VALF REAL*8 CT,E,F,ST,TL,PN,PNI real zzz(2) INTEGER IA(8),K COMMON NF,NG,NDF,NDG EXTERNAL VALF,VALG,GRADF,GRADG DATA BL/78.D0,33.D0,27.D0,27.D0,27.D0,0.D0,90.D0,20.D0/ DATA BU/102.D0,45.D0,45.D0,45.D0,45.D0,92.D0,110.D0,25.D0/ NF = 0 NG = 0 NDF = 0 NDG = 0 N = 8 NL = 3 LG = 3 LA = 3 DO 10 J = 1,N DO 10 I = 1,NL 10 DG(I,J) = 0. DF(2) = 0. DF(4) = 0. DF(6) = 0. DF(7) = 0. DF(8) = 0. C C FEASIBLE STARTING GUESS C IN = 4 X(1) = 78.62D0 X(2) = 33.44D0 X(3) = 31.07D0 X(4) = 44.18D0 X(5) = 35.32D0 X(6) = 0.D0 X(7) = 0.D0 X(8) = 0.D0 CALL VALG(G,X) X(6) = G(1) X(7) = G(2) X(8) = G(3) C C NONFEASIBLE STARTING GUESS C IN = 0 X(1) = 78.D0 X(2) = 33.D0 X(3) = 27.D0 X(4) = 27.D0 X(5) = 27.D0 X(6) = 0.D0 X(7) = 0.D0 X(8) = 0.D0 CALL VALG(G,X) X(6) = G(1) X(7) = G(2) X(8) = G(3) ST = 0. PNI = 10.D0 TL = 1.D-6 CT = 1.D-4 strt = etime(zzz) CALL MIN(X,LE,LI,U,IA,K,F,G,DF,DG,E,IT,ST,PN,IO, 1 IN,TL,500,PNI,A,LA,LG,0,NL,N,B,BL,BU,CT,VALF,VALG,GRADF,GRADG,W) CALL ERR(IO) time = etime(zzz) - strt write(6,*) 'total time =',time WRITE(6,*) 'ERROR TOLERANCE:',E WRITE(6,*) 'NUMBER OF ITERATIONS:',IT F = F - 40792.141D0 WRITE(6,*) 'VALUE:',F WRITE(6,*) 'NUMBER OF F EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF G EVALUATIONS:',NG WRITE(6,*) 'NUMBER OF DF EVALUATIONS:',NDF WRITE(6,*) 'NUMBER OF DG EVALUATIONS:',NDG DATA Y/78.D0,33.D0,29.995256025D0,45.D0,36.7758129058D0/ TT = 0. SS = 0. DO 200 I = 1,5 TT = TT + (X(I)-Y(I))**2 SS = SS + Y(I)**2 WRITE(6,*) I,Y(I),X(I) 200 CONTINUE SS = DSQRT(TT/SS) WRITE(6,*) 'RELATIVE ERROR:',SS STOP END DOUBLE PRECISION FUNCTION VALF(X) REAL*8 X(1),T COMMON NF,NG,NDF,NDG NF = NF + 1 T = 5.3578547D0*X(3)*X(3)+.8356891D0*X(1)*X(5)+37.293239D0*X(1) VALF = T RETURN END SUBROUTINE GRADF(DF,X) REAL*8 DF(1),X(1) COMMON NF,NG,NDF,NDG NDF = NDF + 1 DF(1) = 37.293239D0 + .8356891D0*X(5) DF(3) = 10.7157094D0*X(3) DF(5) = .8356891D0*X(1) RETURN END SUBROUTINE VALG(G,X) REAL*8 G(1),X(1),T COMMON NF,NG,NDF,NDG NG = NG + 1 T = 85.334407D0+.0056858D0*X(2)*X(5)+.0006262D0*X(1)*X(4) G(1) = T - .0022053D0*X(3)*X(5) - X(6) T = 80.51249D0+.0071317D0*X(2)*X(5)+.0029955D0*X(1)*X(2) G(2) = T + .0021813D0*X(3)*X(3) - X(7) T = (.0047026D0*X(5)+.0012547D0*X(1)+.0019085D0*X(4))*X(3) G(3) = 9.300961D0 + T - X(8) RETURN END SUBROUTINE GRADG(DG,X) REAL*8 DG(3,1),X(1) COMMON NF,NG,NDF,NDG NDG = NDG + 1 DG(1,1) = .0006262D0*X(4) DG(1,2) = .0056858D0*X(5) DG(1,3) = -.0022053D0*X(5) DG(1,4) = .0006262D0*X(1) DG(1,5) = .0056858D0*X(2) - .0022053D0*X(3) DG(1,6) = -1.D0 DG(2,1) = .0029955D0*X(2) DG(2,2) = .0071317D0*X(5)+.0029955D0*X(1) DG(2,3) = .0043626D0*X(3) DG(2,5) = .0071317D0*X(2) DG(2,7) = -1.D0 DG(3,1) = .0012547D0*X(3) DG(3,3) = .0047026D0*X(5)+.0012547D0*X(1)+.0019085D0*X(4) DG(3,4) = .0019085D0*X(3) DG(3,5) = .0047026D0*X(3) DG(3,8) = -1.D0 RETURN END ===================== C C COLVILLE 4 C REAL*8 Y(4),SS,TT REAL*8 X(4),BL(4),BU(4),DF(4),W(200) REAL*8 CT,E,VF,ST,TL,VALF INTEGER IA(4),K,IO,IN,LM,N real zzz(2) COMMON NF,NDF EXTERNAL VALF,GRADF DATA X/-3.D0,-1.D0,-3.D0,-1.D0/ DATA BL/-10.D0,-10.D0,-10.D0,-10.D0/ DATA BU/10.D0,10.D0,10.D0,10.D0/ NF = 0 NDF = 0 N = 4 ST = 0. TL = 1.D-6 CT = 1.D-4 IN = 0 LM = 500 strt = etime(zzz) CALL BMIN(X,IA,K,VF,DF,E,IT,ST,IO, & IN,TL,LM,N,BL,BU,CT,VALF,GRADF,W) time = etime(zzz) - strt write(6,*) 'total time =',time CALL ERR(IO) WRITE(6,*) 'ERROR TOLERANCE:',E WRITE(6,*) 'NUMBER OF ITERATIONS:',IT WRITE(6,*) 'VALUE:',VF WRITE(6,*) 'NUMBER OF F EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF DF EVALUATIONS:',NDF DATA Y/1.D0,1.D0,1.D0,1.D0/ TT = 0. SS = 0. DO 200 I = 1,4 TT = TT + (X(I)-Y(I))**2 SS = SS + Y(I)**2 WRITE(6,*) I,Y(I),X(I) 200 CONTINUE SS = DSQRT(TT/SS) WRITE(6,*) 'RELATIVE ERROR:',SS STOP END DOUBLE PRECISION FUNCTION VALF(X) REAL*8 X(1),T COMMON NF,NDF NF = NF + 1 T = 100*(X(2)-X(1)**2)**2 + (1-X(1))**2 T = T + 90*(X(4)-X(3)**2)**2 + (1-X(3))**2 T = T + 10.1D0*((X(2)-1)**2+(X(4)-1)**2) T = T + 19.8D0*(X(2)-1)*(X(4)-1) VALF = T RETURN END SUBROUTINE GRADF(DF,X) REAL*8 DF(1),X(1) REAL*8 A,B COMMON NF,NDF NDF = NDF + 1 A = X(2) - X(1)**2 B = X(4) - X(3)**2 DF(1) = -400*A*X(1) - 2*(1-X(1)) DF(2) =20.2D0*(X(2)-1) + 200*A + 19.8D0*(X(4)-1) DF(3) = -360*B*X(3) - 2*(1-X(3)) DF(4) = 180*B + 20.2D0*(X(4)-1) + 19.8D0*(X(2)-1) RETURN END ===================== C C COLVILLE 6 C REAL*8 Y(6),SS,TT REAL*8 X(6),LE(4),LI(6),U(300),G(4),DF(6),DG(4,6) REAL*8 A(4,6),BL(6),BU(6),E(1),W(200) REAL*8 CT,F,ER,PN,PNI,ST,TL,VALF REAL*8 B,BB,C,D,CN,SN real zzz(2) INTEGER IA(6),IO,IN,K,IT,L,LA,LG,LM,NL,N COMMON B,BB,C,D,CN,SN,NF,NG,NDF,NDG EXTERNAL VALF,VALG,GRADF,GRADG DATA BL/0.D0,0.D0,340.D0,340.D0,-1000.D0,0.D0/ DATA BU/400.D0,1000.D0,420.D0,420.D0,1000.D0,.5236D0/ DATA X/390.D0,1000.D0,419.5D0,340.5D0,198.175D0,.5D0/ NF = 0 NG = 0 NDF = 0 NDG = 0 B = 1.48477D0 C = 300 D = 200 BB = 1.D0/131.078D0 CN = (.90798D0*BB)*DCOS(B-.00889D0) SN = (.90798D0*BB)*DSIN(B-.00889D0) DF(3) = 0. DF(4) = 0. DF(5) = 0. DF(6) = 0. DG(1,1) = 1. DG(1,2) = 0. DG(1,5) = 0. DG(2,1) = 0. DG(2,2) = 1. DG(2,5) = 0. DG(3,1) = 0. DG(3,2) = 0. DG(3,5) = 0. DG(4,1) = 0. DG(4,2) = 0. DG(4,5) = 1. C C NONFEASIBLE STARTING GUESS C IN = 0 TL = .000001 LM = 1000 PNI = 10 L = 0 N = 6 LA = 4 LG = 4 NL = 4 ST = 0. CT = 1.D-4 strt = etime(zzz) CALL MIN(X,LE,LI,U,IA,K,F,G,DF,DG,ER,IT,ST,PN,IO, 1 IN,TL,LM,PNI,A,LA,LG,L,NL,N,E,BL,BU,CT,VALF,VALG,GRADF,GRADG,W) CALL ERR(IO) time = etime(zzz) - strt write(6,*) 'total time =',time WRITE(6,*) 'VALUE:',F WRITE(6,*) 'NUMBER OF F EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF G EVALUATIONS:',NG WRITE(6,*) 'NUMBER OF DF EVALUATIONS:',NDF WRITE(6,*) 'NUMBER OF DG EVALUATIONS:',NDG DATA Y/107.8119312D0,196.3186138D0,373.8307277D0,420.D0, & 21.307132490D0,.1532919593D0/ TT = 0. SS = 0. DO 200 I = 1,6 TT = TT + (X(I)-Y(I))**2 SS = SS + Y(I)**2 WRITE(6,*) I,Y(I),X(I) 200 CONTINUE SS = DSQRT(TT/SS) WRITE(6,*) 'RELATIVE ERROR:',SS STOP END DOUBLE PRECISION FUNCTION VALF(X) REAL*8 X(1),B,BB,C,D,CN,SN,T COMMON B,BB,C,D,CN,SN,NF,NG,NDF,NDG NF = NF + 1 T = 0. IF ( X(1) .GT. 300 ) GOTO 10 T = T + 30*X(1) GOTO 20 10 T = 9000 + 31*(X(1)-300) 20 IF ( X(2) .GT. 100 ) GOTO 30 T = T + 28*X(2) GOTO 50 30 IF ( X(2) .GT. 200 ) GOTO 40 T = T + 2800 + 29*(X(2)-100) GOTO 50 40 T = T + 5700 + 30*(X(2)-200) 50 VALF = T RETURN END SUBROUTINE GRADF(DF,X) REAL*8 DF(1),X(1) REAL*8 B,BB,C,D,CN,SN COMMON B,BB,C,D,CN,SN,NF,NG,NDF,NDG NDF = NDF + 1 DF(1) = 30 IF ( X(1) .GT. 300 ) DF(1) = 31 DF(2) = 28 IF ( X(2) .GT. 100 ) DF(2) = 29 IF ( X(2) .GT. 200 ) DF(2) = 30 RETURN END SUBROUTINE VALG(G,X) REAL*8 G(1),X(1) REAL*8 B,BB,C,D,CN,SN COMMON B,BB,C,D,CN,SN,NF,NG,NDF,NDG NG = NG + 1 G(1) = X(1) - C + BB*X(3)*X(4)*DCOS(B-X(6)) - CN*X(3)**2 G(2) = X(2) + BB*X(3)*X(4)*DCOS(B+X(6)) - CN*X(4)**2 G(3) = D - BB*X(3)*X(4)*DSIN(B-X(6)) + SN*X(3)**2 G(4) = X(5) + BB*X(3)*X(4)*DSIN(B+X(6)) - SN*X(4)**2 RETURN END SUBROUTINE GRADG(DG,X) REAL*8 DG(4,1),X(1) REAL*8 B,BB,C,D,CN,SN COMMON B,BB,C,D,CN,SN,NF,NG,NDF,NDG NDG = NDG + 1 DG(1,3) = BB*X(4)*DCOS(B-X(6)) - 2*CN*X(3) DG(1,4) = BB*X(3)*DCOS(B-X(6)) DG(1,6) = BB*X(3)*X(4)*DSIN(B-X(6)) DG(2,3) = BB*X(4)*DCOS(B+X(6)) DG(2,4) = BB*X(3)*DCOS(B+X(6)) - 2*CN*X(4) DG(2,6) = -BB*X(3)*X(4)*DSIN(B+X(6)) DG(3,3) = -BB*X(4)*DSIN(B-X(6)) + 2*SN*X(3) DG(3,4) = -BB*X(3)*DSIN(B-X(6)) DG(3,6) = BB*X(3)*X(4)*DCOS(B-X(6)) DG(4,3) = BB*X(4)*DSIN(B+X(6)) DG(4,4) = BB*X(3)*DSIN(B+X(6)) - 2*SN*X(4) DG(4,6) = BB*X(3)*X(4)*DCOS(B+X(6)) RETURN END ===================== C C COLVILLE 7 C REAL*8 Y(16),SS,TT REAL*8 X(16),LE(8),LI(16),DF(16),W(200),A(8,16),B(8),BL(16),BU(16) REAL*8 U(200),CT,ST,E,VF,VALUE INTEGER IA(16),IR(30),IC(30) real zzz(2) COMMON IR,IC,N,NF,NDF EXTERNAL VALUE,GRAD DATA A/ 0.22, -1.46, 1.29, -1.10, 0.00, 0.00, 1.12, 0.00, 1 0.20, 0.00, -0.89, -1.06, 0.00, -1.72, 0.00, 0.45, 2 0.19, -1.30, 0.00, 0.95, 0.00, -0.33, 0.00, 0.26, 3 0.25, 1.82, 0.00, -0.54, -1.43, 0.00, 0.31, -1.10, 4 0.15, -1.15, -1.16, 0.00, 1.51, 1.62, 0.00, 0.58, 5 0.11, 0.00, -0.96, -1.78, 0.59, 1.24, 0.00, 0.00, 6 0.12, 0.80, 0.00, -0.41, -0.33, 0.21, 1.12, -1.03, 7 0.13, 0.00, -0.49, 0.00, -0.43, -0.26, 0.00, 0.10, 8 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, -0.36, 0.00, 9 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 2 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 3 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 0.00, 4 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 0.00, 5 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 0.00, 6 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00/ DATA B/2.5D0,1.1D0,-3.1D0,-3.5D0,1.3D0,2.1D0,2.3D0,-1.5D0/ DATA BU/5.D0,5.D0,5.D0,5.D0,5.D0,5.D0,5.D0,5.D0,5.D0,5.D0, 1 5.D0,5.D0,5.D0,5.D0,5.D0,5.D0/ DATA BL/0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0, 1 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0/ DATA X/.0D0,.0D0,.0D0,.0D0,.0D0,.0D0,.0D0,.0D0,.0D0, 1 .0D0,.0D0,.0D0,.0D0,.0D0,.0D0,.0D0/ DATA IR/1,1,1,1,2,2,2,3,3,3,3,4,4,4,5,5,5,5,6,6,7,7,8,8,9,9, 1 10,11,12,13/ DATA IC/4,7,8,16,3,7,10,7,9,10,14,7,11,15,6,10,12,16,8,15,11,13, 1 10,15,12,16,14,13,14,14/ NF = 0 NG = 0 NDF = 0 NDG = 0 LA = 8 N = 16 M = 8 ST = 0 CT = 1.D-4 strt = etime(zzz) CALL LMIN(X,LE,LI,U,IA,K,VF,DF,E,IT,ST,IO, 1 0,1.D-6,500,A,LA,M,N,B,BL,BU,CT,VALUE,GRAD,W) time = etime(zzz) - strt write(6,*) 'total time =',time WRITE(6,*) 'OPTIMAL VALUE:',VF WRITE(6,*) 'ERROR:',E WRITE(6,*) 'ITERATIONS:',IT WRITE(6,*) 'NUMBER OF F EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF DF EVALUATIONS:',NDF DATA Y/.039847371D0,.7919831688D0,.2028703277D0,.84435796726D0, & 1.2699065D0,.9347386775D0,1.6819619415D0,.1553008715D0, & 1.5678703159D0,0.D0,0.D0,0.D0,.660204085777D0,0.D0, & .67425591386D0,0.D0/ TT = 0. SS = 0. DO 200 I = 1,16 TT = TT + (X(I)-Y(I))**2 SS = SS + Y(I)**2 WRITE(6,*) I,Y(I),X(I) 200 CONTINUE SS = DSQRT(TT/SS) WRITE(6,*) 'RELATIVE ERROR:',SS STOP END DOUBLE PRECISION FUNCTION VALUE(X) REAL*8 X(1),S,T INTEGER IR(30),IC(30) COMMON IR,IC,N,NF,NDF NF = NF + 1 T = 0. DO 10 I = 1,N 10 T = T + (X(I)*X(I)+X(I)+1)**2 DO 20 K = 1,30 I = IR(K) J = IC(K) S = (X(I)*X(I)+X(I)+1)*(X(J)*X(J)+X(J)+1) T = T + S 20 CONTINUE VALUE = T RETURN END SUBROUTINE GRAD(G,X) REAL*8 G(1),X(1),S,T INTEGER IR(30),IC(30) COMMON IR,IC,N,NF,NDF NDF = NDF + 1 DO 10 I = 1,N 10 G(I) = 2*(X(I)*X(I)+X(I)+1)*(X(I)+X(I)+1) DO 20 K = 1,30 I = IR(K) J = IC(K) S = (X(I)+X(I)+1)*(X(J)*X(J)+X(J)+1) T = (X(J)+X(J)+1)*(X(I)*X(I)+X(I)+1) G(I) = G(I) + S G(J) = G(J) + T 20 CONTINUE RETURN END ===================== C C COLVILLE 8 C REAL*8 Y(3),SS,TT REAL*8 X(10),LE(7),LI(10),U(300),G(7),DF(10),DG(7,10) REAL*8 A(7,10),B(1),BL(10),BU(10),W(200) REAL*8 CT,F,ER,PN,PNI,ST,TL,VALF real zzz(2) INTEGER IA(10),IO,IN,K,IT,L,LA,LG,LM,NL,N COMMON NF,NG,NDF,NDG EXTERNAL VALF,VALG,GRADF,GRADG DATA BL/0.D0,0.D0,0.D0,0.D0,0.D0,85.D0,90.D0,3.D0,.01D0,145.D0/ DATA BU/2000.,16000.D0,120.D0,5000.D0,2000.D0,93.D0, & 95.D0,12.D0,4.D0,162.D0/ DATA X/1745D0,12000.D0,110.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0/ DF(1) = 5.04D0 DF(2) = .035D0 DF(3) = 10. DF(5) = 3.36D0 DF(6) = 0. DF(8) = 0. DF(9) = 0. DF(10)= 0. DO 20 I = 1,7 DO 10 J = 1,10 10 DG(I,J) = 0. DG(I,3+I) = 1. 20 CONTINUE NF = 0 NG = 0 NDF = 0 NDG = 0 C C FEASIBLE STARTING GUESS C CALL VALG(G,X) DO 30 I = 4,10 30 X(I) = -G(I-3) NG = NG - 1 TL = .000001 LM = 250 PNI = 10 L = 0 N = 10 IN = 4 LA = 7 LG = 7 NL = 7 ST = 0 CT = 0.D-4 strt = etime(zzz) CALL MIN(X,LE,LI,U,IA,K,F,G,DF,DG,ER,IT,ST,PN,IO, 1 IN,TL,LM,PNI,A,LA,LG,L,NL,N,B,BL,BU,CT,VALF,VALG,GRADF,GRADG,W) CALL ERR(IO) time = etime(zzz) - strt write(6,*) 'total time =',time WRITE(6,*) 'VALUE:',F WRITE(6,*) 'NUMBER OF F EVALUATIONS:',NF WRITE(6,*) 'NUMBER OF G EVALUATIONS:',NG WRITE(6,*) 'NUMBER OF DF EVALUATIONS:',NDF WRITE(6,*) 'NUMBER OF DG EVALUATIONS:',NDG DATA Y/1728.371286d0,16000d0,98.14151402d0/ TT = 0. SS = 0. DO 200 I = 1,3 TT = TT + (X(I)-Y(I))**2 SS = SS + Y(I)**2 WRITE(6,*) I,Y(I),X(I) 200 CONTINUE SS = DSQRT(TT/SS) WRITE(6,*) 'RELATIVE ERROR:',SS STOP END DOUBLE PRECISION FUNCTION VALF(X) REAL*8 X(1),T COMMON NF,NG,NDF,NDG NF = NF + 1 T = 10.*X(3) + .035D0*X(2) + 3.36D0*X(5) + 5.04D0*X(1) T = T - .063D0*X(4)*X(7) VALF = T RETURN END SUBROUTINE GRADF(DF,X) REAL*8 DF(1),X(1) COMMON NF,NG,NDF,NDG NDF = NDF + 1 DF(4) = -.063D0*X(7) DF(7) = -.063D0*X(4) END SUBROUTINE VALG(G,X) REAL*8 G(1),X(1) REAL*8 Y2,Y3,Y4,Y5,Y6,Y7,Y8,C2,C4 COMMON NF,NG,NDF,NDG J1 = 0 J2 = 0 NG = NG + 1 Y2 = 1.6D0*X(1) 10 Y3 = 1.22D0*Y2 - X(1) Y6 = (X(2)+Y3)/X(1) C2 = X(1)*(1.12D0 + .13167D0*Y6-.6667D-2*Y6*Y6) IF ( DABS(C2-Y2) .LE. .001D0 ) GOTO 20 Y2 = C2 J1 = J1 + 1 GOTO 10 20 Y4 = 93. 30 Y5 = 86.35D0 + 1.098D0*Y6 - .038D0*Y6*Y6 + .325D0*(Y4-89.) Y8 = -133. + 3.*Y5 Y7 = 35.82D0 - .222D0*Y8 C4 = 98000.*X(3)/(Y2*Y7 + X(3)*1000) IF ( DABS(C4-Y4) .LE. .0001D0 ) GOTO 40 Y4 = C4 J2 = J2 + 1 GOTO 30 40 G(1) = X(4) - Y2 G(2) = X(5) - Y3 G(3) = X(6) - Y4 G(4) = X(7) - Y5 G(5) = X(8) - Y6 G(6) = X(9) - Y7 G(7) = X(10) - Y8 c WRITE(6,*) 'J1,J2',J1,J2 RETURN END SUBROUTINE GRADG(DG,X) REAL*8 DG(7,1),X(1) REAL*8 Y2,Y3,Y4,Y5,Y6,Y7,Y8,C2,C4 REAL*8 Y21,Y31,Y41,Y51,Y61,Y71,Y81 REAL*8 Y22,Y32,Y42,Y52,Y62,Y72,Y82 REAL*8 Y23,Y33,Y43,Y53,Y63,Y73,Y83 COMMON NF,NG,NDF,NDG NDG = NDG + 1 Y2 = 1.6D0*X(1) Y21 = 1.6D0 Y22 = 0. Y23 = 0. 10 Y3 = 1.22D0*Y2 - X(1) Y31 = 1.22D0*Y21 - 1 Y32 = 1.22D0*Y22 Y33 = 1.22D0*Y23 Y6 = (X(2)+Y3)/X(1) Y61 = -(X(2)+Y3)/X(1)**2 + Y31/X(1) Y62 = (1.+Y32)/X(1) Y63 = Y33/X(1) C2 = X(1)*(1.12D0 + .13167D0*Y6-.6667D-2*Y6*Y6) IF ( DABS(C2-Y2) .LE. .001D0 ) GOTO 20 Y2 = C2 Y21 = X(1)*(.13167D0*Y61 - 2*.6667D-2*Y6*Y61) Y21 = Y21 + 1.12D0 + .13167D0*Y6 - .6667D-2*Y6*Y6 Y22 = X(1)*(.13167D0*Y62 - 2.*.6667D-2*Y6*Y62) Y23 = X(1)*(.13167D0*Y63 - 2.*.6667D-2*Y6*Y63) GOTO 10 20 Y4 = 93. Y41 = 0. Y42 = 0. Y43 = 0. 30 Y5 = 86.35D0 + 1.098D0*Y6 - .038D0*Y6*Y6 + .325D0*(Y4-89.) Y51 = (1.098D0 - 2.*.038D0*Y6)*Y61 + .325D0*Y41 Y52 = (1.098D0 - 2.*.038D0*Y6)*Y62 + .325D0*Y42 Y53 = (1.098D0 - 2.*.038D0*Y6)*Y63 + .325D0*Y43 Y8 = -133. + 3.*Y5 Y81 = 3.*Y51 Y82 = 3.*Y52 Y83 = 3.*Y53 Y7 = 35.82D0 - .222D0*Y8 Y71 = -.222D0*Y81 Y72 = -.222D0*Y82 Y73 = -.222D0*Y83 C4 = 98000.*X(3)/(Y2*Y7 + X(3)*1000) IF ( DABS(C4-Y4) .LE. .0001D0 ) GOTO 40 Y4 = C4 Y41 = -98000.*X(3)*(Y21*Y7 + Y2*Y71)/(Y2*Y7+X(3)*1000.)**2 Y42 = -98000.*X(3)*(Y22*Y7 + Y2*Y72)/(Y2*Y7+X(3)*1000.)**2 Y43 = -98000.*X(3)*(Y23*Y7 + Y2*Y73 + 1000.) Y43 = (Y43/(Y2*Y7+X(3)*1000.) + 98000.)/(Y2*Y7+X(3)*1000.) GOTO 30 40 DG(1,1) = -Y21 DG(1,2) = -Y22 DG(1,3) = -Y23 DG(2,1) = -Y31 DG(2,2) = -Y32 DG(2,3) = -Y33 DG(3,1) = -Y41 DG(3,2) = -Y42 DG(3,3) = -Y43 DG(4,1) = -Y51 DG(4,2) = -Y52 DG(4,3) = -Y53 DG(5,1) = -Y61 DG(5,2) = -Y62 DG(5,3) = -Y63 DG(6,1) = -Y71 DG(6,2) = -Y72 DG(6,3) = -Y73 DG(7,1) = -Y81 DG(7,2) = -Y82 DG(7,3) = -Y83 RETURN END