Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
Tutorialspoint

darageh3

    program Darageh3

    implicit none

    ! Variables
    real*8    :: a, b, c, d, root1, root2, root3, xn1, xn, fx, df, h, moshtagh, tabeh, deltax, a1, b1, c1
    integer*4 :: n,i
    logical*2 :: control=.true.
    xn = 0
    write(*,*) 'It is a cubic function(a can not be zero'
    write(*,*) 'Enter a'
    read (*,*) a
    write(*,*) 'Enter b'
    read (*,*) b
    write(*,*) 'Enter c'
    read (*,*) c
    write(*,*) 'Enter d'
    read (*,*) d
    write(*,*) 'Enter the first numeric value'
    read (*,*) xn





    ! Body of Darageh3
    do while(control)

        xn1 = xn - ( tabeh(xn,a,b,c,d)/moshtagh(xn) )

        if( dabs(xn - xn1) < 0.0001 ) then
            control=.false.
        else
            xn=xn1
        end if

    end do
    xn1 = root1
    a1     = a
    b1     = a*root1 + b
    c1     = a*(root1**2) + b*root1 + c
    deltax = b1**2 - 4*a1*c1
    if(deltax < 0.0) then
        write(*,*) 'root 1'
        write(*,*) root1
        write(*,*) 'The cubic function has only 1 root'
    else if( deltax == 0.0) then
        root2 = (-b1)/(2*a1)
        write(*,*) 'root 1'
        write(*,*) root1
        write(*,*) 'root 2'
        write(*,*) root2
        write(*,*) 'The cubic function has 2 roots'
    else
        root2 = ( -b1 + sqrt(deltax) ) / 2*a1
        root3 = ( -b1 - sqrt(deltax) ) / 2*a1
        write(*,*) 'root 1'
        write(*,*) root1
        write(*,*) 'root 2'
        write(*,*) root2
        write(*,*) 'root 3'
        write(*,*) root3
        write(*,*) 'The cubic equation has 3 roots'
    end if




    read(*,*)


    end program Darageh3

    function tabeh(xn,a,b,c,d) result(fx)
    implicit none

    real*8 :: a, b, c, d, xn, fx
    fx = a*(xn**3) + b*(xn**2) + c*(xn) + d

    end function

    function moshtagh(xn) result(df)
    implicit none

    real*8 :: tabeh, xn, h, df, a, b, c, d
    h  = 1.0D-6
    df = ( tabeh(xn,a,b,c,d) - tabeh(xn+h,a,b,c,d) ) / h

    end function

Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.