方向加速法框圖與程序

方向加速法框圖與程序方向加速法框圖與程序方向加速法框圖與程序方向加速法框圖與程序編制僅供參考審核批準生效日期地址：電話：傳真:郵編:是否是否f2<=f3否是否是開始給定由x0出發(fā)，以步長t進行x方向探測移動得x1,f1=f(x1);再以x1出發(fā),以步長t進行y方向探測移動得x2,f2=f(x2)||x2-x0||<輸出最優(yōu)解x2，f2結(jié)束x3=2x2-x0或P=x2-x0方向加速法程序框圖以x2為基點,沿P方向求極小，所得點記為x0e(1,:)=e(2,:)e(2,:)=p!主程序：方向加速法 programmain implicitnone real,parameter::eps=,lamda=0.realx0(2),x1(2),x(2),x3(2),p(2),x2(2),e(2,2)realf0,y2,ff,drta,s1,s2,t1,t2,tp,a,b,c,d,q1,q2,f2,f1,f3 e(1,:)=(/1,0/)e(2,:)=(/0,1/) x0=(/0,0/) a=-20 b=20!確定步長t!探測移動100 callfg(x0,f0)callk(a,b,x0,e,t1) x1=x0+t1*e(1,:) callfg(x1,f1) calll(x1,e,t2) x2=x1+t2*e(2,:) callfg(x2,f2)s1=sqrt((x2(1)-x0(1))**2+(x2(2)-x0(2))**2)if(s1<=eps)thengoto300elsex3=2*x2-x0callfg(x3,f3)drta=max(f0-f1,f1-f2,f2-f3)endifff=(f0-2*f2+f3)/2if(f3>if(f2<=f3)thenx0=x2goto100else x0=x3goto100 endifelsep=x2-x0 callm(x2,p,tp) x0=x2+tp*p e(1,:)=e(2,:)e(2,:)=p s2=sqrt((x2(1)-x0(1))**2+(x2(2)-x0(2))**2)if(s2<=eps)thengoto300else goto100 endif endif300write(*,*)'最優(yōu)解x=' write(*,*)x2 write(*,*)'極小值f=' write(*,*)f2 end!子程序：計算函數(shù)值 subroutinefg(x,y) realx(2),y,e(2,2) y=10*(x(1)+x(2)-5)**2+(x(1)-x(2))**2 end subroutiney1(x0,e,t,y) realy,t real,dimension(2)::x0 real,dimension(2,2)::e y=10*(x0(1)+t*e(1,1)+x0(2)+t*e(1,2)-5)**2+((x0(1)+t*e(1,1))-(x0(2)+t*e(1,2)))**2end subroutiney2(x1,e,t,y) realt,y real,dimension(2)::x1 real,dimension(2,2)::e y=10*(x1(1)+t*e(2,1)+x1(2)+t*e(2,2)-5)**2+((x1(1)+t*e(2,1))-(x1(2)+t*e(2,2)))**2 endsubroutinepp(x2,p,tp,y) realtp,y real,dimension(2)::x2,p(2) y=10*(x2(1)+tp*p(1)+x2(2)+tp*p(2)-5)**2+((x2(1)+tp*p(1))-(x2(2)+tp*p(2)))**2 end subroutinek(a,b,x0,e,t1) real,parameter::eps=,lamda= reala,b,c,d,q1,q2,t1 real,dimension(2)::x0 a=-10 b=10400 c=a+(1-lamda)*(b-a) d=a+lamda*(b-a)cally1(x0,e,c,q1)cally1(x0,e,d,q2) if(q1<q2)then b=d d=c q2=q1 elseif(q1>q2)then a=c c=d q1=q2 else a=c b=d endif if((b-a)<eps)then t1=(a+b)/2 else goto400 endifendsubroutinel(x1,e,t2) real,parameter::eps=,lamda= reala,b,c,d,q1,q2,t2 a=-10 b=10600 c=a+(1-lamda)*(b-a) d=a+lamda*(b-a)cally2(x1,e,c,q1)cally2(x1,e,d,q2) if(q1<q2)then b=d d=c q2=q1 elseif(q1>q2)then a=c c=d q1=q2 else a=c b=d endif if((b-a)<eps)then t2=(a+b)/2 else goto600 endif endsubroutinem(x2,p,tp) real,parameter::eps=,lamda= reala,b,c,d,q1,q2,tp a=-10 b=10200 c=a+(1-lamda)*(b-a) d=a+lamda*(b-a)callpp(x2,p,c,q1)callpp(x2,p,d,q2) if(q1<q2)then b=d d=c q