DEV Community

seng
seng

Posted on

Solving univariate polynomial equations using the bisection and secant methods.

  1. 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
Enter fullscreen mode Exit fullscreen mode

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


Enter fullscreen mode Exit fullscreen mode
  1. 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

Enter fullscreen mode Exit fullscreen mode

Top comments (0)