- the bisection algorithm
program hello
use bisect
implicit none
real::root
integer::err_flag
character(len=50)::err_msg
real,external::fun_root
call get_root(fun_root,-20.,20.,1.0E-7,root,err_flag,err_msg)
if (err_flag>0) then
write (*,*) "error:",err_msg
else
write (*,*) root
end if
end program
real function fun_root(x)
implicit none
real,intent(in)::x
fun_root=5*x**3-3*x**2+111*x+21
end function fun_root
addtional,you yet write the following code into the bisect.f90 file.
module bisect
implicit none
contains
subroutine get_root(func,x_a,x_b,tolerance,root,err_flag,err_msg)
integer,intent(out)::err_flag
character(len=50),intent(out)::err_msg
real,external::func
real,intent(out)::root
real,intent(in)::x_a,x_b,tolerance
real::a
real::b
real::fun_a,fun_b,fun_x,x
a=x_a
b=x_b
fun_a=func(a)
fun_b=func(b)
if (fun_a*fun_b>=0) then
err_flag=1
err_msg="f(a)f(b)>0"
return
end if
write (*,"(A1)",advance='no') "|"
do while ((b-a)/2>tolerance)
x=(a+b)/2
fun_x=func(x)
if (fun_x==0.) then
exit
endif
if (fun_x*fun_a<0.) then
b=x
fun_b=fun_x
else
a=x
fun_a=fun_x
end if
write (*,"(A1)",advance='no') "="
end do
write (*,"(A1/)",advance='no') ">"
root=(a+b)/2
err_flag=0
err_msg=""
end subroutine
end module bisect
- the secant algorithm
program hello
use equation_root
implicit none
real::root
real::a,b
integer::err_flag
character(len=50)::err_msg
real,external::fun_root
a=-50.
b=50.
call get_root(2,fun_root,a,b,1.0E-7,1.0E-35,root,err_flag,err_msg,50)
if (err_flag>0) then
write (*,*) "error:",err_msg
else
write (*,*) root
end if
end program
real function fun_root(x)
implicit none
real,intent(in)::x
fun_root=x**3+9*cos(x)
end function fun_root
Top comments (0)