248225-you.f90.txt

抛物线插值源程序

   !求一元函数φ(t)=(t+1)*(t-2)**2当t>=0时的极小点
   function fy(t) result(y)
   real t,y
   y=(t+1)*((t-2)**2) 
   end function fy	
   
   !搜索区间的确定
   subroutine search_zone(t0,h,t1,t2,t3,f1,f2,f3)
   real t0,t1,t2,t3,f1,f2,f3,h,a,b,c,d,r,s,u,v,w,fy
   a=fy(t0)
   b=fy(t0+h)
   if(b.lt.a) then 
      s=h 
      goto 10 
   else	
      s=-h
	  c=fy(t0+s)
       if (c.gt.a) then
           t1=t0+s;t2=t0;t3=t0-s;f1=c;f2=a;f3=b
	    else  
		  b=c
  10   u=t0
       v=t0+s
       end if  
  20    s=2*s
       w=v+s
	   c=fy(w)
	   if(c.lt.b) then
	       u=v;a=b;v=w;b=c
		   goto 20
	   else 
	       r=0.5*(v+w); d=fy(r)
	  if(s<0) then
	     if(d.lt.b)  then   
		     t1=w;t2=r;t3=v;f1=c;f2=d;f3=b
		 else 
		     t1=r;t2=v;t3=u;f1=d;f2=b;f3=a
		 end if
	  else if(d.lt.b) then 
	           t1=v;t2=r;t3=w;f1=b;f2=d;f3=c
		   else
		       t1=u;t2=v;t3=r;f1=a;f2=b;f3=d
		  end if
		end if  	   	  		            
    print*,"t1=",t1
	print*,"t2=",t2
	print*,"t3=",t3
  end if
  end subroutine search_zone

! 插值法的主程序
 program chazhi_pao
 real t1,t2,t3,t4,f1,f2,f3,f4,e,e1,m,n
 e1=0.05
 read*,t0,h
 call search_zone(t0,h,t1,t2,t3,f1,f2,f3)
     
30	m=(t2**2-t3**2)*f1+(t3**2-t1**2)*f2+(t1**2-t2**2)*f3
    n=2*((t2-t3)*f1+(t3-t1)*f2+(t1-t2)*f3)
	t4=m/n
	e=abs(f4-f2)/(abs(f2))
	f4=fy(t4)
	if(e.lt.e1) then
	     print*,"t*=",t4
	     print*,"fy*=",f4
      else 
	     if(t4.gt.t2) then
           if(f2.ge.f4.and.f4.le.f3) then
             t1=t2;t2=t4;f1=f2;f2=f4
			 goto 30
           else
             t3=t4;f3=f4
		 	 goto 30
           end if
         else if(f1.ge.f4.and.f4.le.f2) then
                t3=t2;t2=t4;f3=f2;f2=f4  
		        goto 30   
             else 
                t1=t4;f1=f4 
	            goto 30 	
             end if 
	     end if 
  end program chazhi_pao