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.
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
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.
AcceptLearn more