二次插值法(quadratic interpolation)
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
program main
implicit none
real x1,x2,x3,x4,x5,x6,x7,x8,xp1,xp2,A,A1,A2,A3,Ap,B,M,N,F1,F2,F3,Fp,Ef,E1,e,P,K1,K2
write(*,*) "Search Interval [A,B]: "
read(*,*) A,B
write(*,*) "Start Point [x1,x2]: "
read(*,*) x1,x2
write(*,*) "Iteration Accuracy e: "
read(*,*) e
write(*,*) "Search Direction [M,N]: "
read(*,*) M,N
A1=A
A3=B
A2=(2*A1+A3)/3
x3=x1+A1*M
x4=x2+A1*N
F1=(x3)**2+(x4)**2-8*(x3)-12*(x4)+52
x5=x1+A2*M
x6=x2+A2*N
F2=(x5)**2+(x6)**2-8*(x5)-12*(x6)+52
x7=x1+A3*M
x8=x2+A3*N
F3=(x7)**2+(x8)**2-8*(x7)-12*(x8)+52
do while(.true.)
K1=(F3-F1)/(A3-A1)
K2=(((F2-F1)/(A2-A1))-K1)/(A2-A3)
if (K2/=0) then
Ap=0.5*(A1+A3-(K1/K2))
if ((AP-A1)*(A3-AP)>0) then
xp1=x1+Ap*M
xp2=x2+Ap*N
Fp=(xp1)**2+(xp2)**2-8*(xp1)-12*(xp2)+52
E1=abs(F2-Fp)
if (abs(F2)<=e) then
Ef=1
else
Ef=abs(F2)
end if
P=E1/Ef
if (P>e) then
if (Ap>A2) then
if (F2>Fp) then
A1=A2
F1=F2
A2=Ap
F2=Fp
else
A3=Ap
F3=Fp
end if
else
if (F2>Fp) then
A3=A2
F3=F2
A2=Ap
F2=Fp
else
A1=Ap
F1=Fp
end if
end if
else
if(F2>Fp) then
write(*,*) "The result is: ", Fp
exit
else
write(*,*) "The result is: ", F2
exit
end if
end if
else
Ap=A2
Fp=F2
write(*,*) "Ap is out of [A,B] ! The result is: ", Fp
exit
end if
else
Ap=A2
Fp=F2
write(*,*) "The result is: ", Fp
exit
end if
end do
pause
end