حل معادله به روش نیوتن( نصف کردن) در فرترن

سلام
من این برنامه رو برای حل معادله f(x) = xsin(x)-1 به روش نیوتن ( نصف کردن) تو برنامه فرترن و تو بازه [0,2] نوشتم اما هیچ جوابی نمیاره. خودم فکر میکنم که اشکال از محاسبه سینوس باشه.
سینوس رو به صروت تابع فرعی و بسط هم نوشتم اما جواب نمیده
کسی میدونه درستش چیه؟
ممنون

program NEWTON

implicit none

real:: a,b,c,fa,fb,fc
print*,' Enter a '
read*, a
print*, ' Enter b '
read*, b
Do
c=(a+b)/2
fa=a*sin(((3.14159/180)*a))-1
fb=b*sin(((3.14159/180)*b))-1
fc=c*sin(((3.14159/180)*c))-1
if ( fa*fc<0) then
b=c
else if ( fb*fc<0) then
a=c
else if( (fc>=0) .and. (fc<=0) ) then
print*,' Root is = ' ,c
exit
else
print*, ' Root isnot exist!'
exit
end if
end do

end program NEWTON

نقل قول:

---

نوشته شده توسط elyartab [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

سلام
من این برنامه رو برای حل معادله f(x) = xsin(x)-1 به روش نیوتن ( نصف کردن) تو برنامه فرترن و تو بازه [0,2] نوشتم اما هیچ جوابی نمیاره. خودم فکر میکنم که اشکال از محاسبه سینوس باشه.
سینوس رو به صروت تابع فرعی و بسط هم نوشتم اما جواب نمیده
کسی میدونه درستش چیه؟
ممنون

program NEWTON

implicit none

real:: a,b,c,fa,fb,fc
print*,' Enter a '
read*, a
print*, ' Enter b '
read*, b
Do
c=(a+b)/2
fa=a*sin(((3.14159/180)*a))-1
fb=b*sin(((3.14159/180)*b))-1
fc=c*sin(((3.14159/180)*c))-1
if ( fa*fc<0) then
b=c
else if ( fb*fc<0) then
a=c
else if( (fc>=0) .and. (fc<=0) ) then
print*,' Root is = ' ,c
exit
else
print*, ' Root isnot exist!'
exit
end if
end do

end program NEWTON

---

اینطور تغییرش بده :

کد:

---

if ( fa*fc<0) then
        b=c
else if ( fb*fc>0) then
        a=c
else if( (fc=0) ) then

---

اگه تو فرترن قبول کنه که بجای آخری Else بنویسی هم که چه بهتر !

آيا روش كلي و ساده اي در فرترن 90 به بالا هست كه ريشه هاي معادله ي درجه ي سوم را پيدا كند و آنها را نشان دهد.(در صورت مبهم بودن جواب برنامه بگويد كه معادله جواب ندارد.)
اين برنامه رو قراره كه فردا صبح به عنوان پروژه تحويل استاد بدم!

دوستان bad boy .elyartab منو کمک کنید دوستان می تونید این معادله x+sinx=7 را توی فرترن90 به روش تنصیف در بازه 0تا100 حل کنید :n12:

در فرترن 90 برنامه ای بنویسید که تابع F(x)=sinx را برای 2π>x>0 بدست آورده و مقدار x و fx را در یک فایل بریزد و سپس فایل مربوط را به کمک Excell , matlab ,... باز کرده و نمودار sinx را رسم کند؟جواب تا 18/8/92 فقط خواهشا از دوستانی که بلد هستند دریغ نکنند.:n12::n12:

دوستان من فردا باید پروزه تحویل بدم کسی هست بتونه کمکم کنه؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ ؟؟؟؟؟؟

خودم نوشتم هر كسي هم خواست استفاده كنه بعد از نصب برنامه فرترن؛ اين فايلو دانلود و سپس اجرا كنه
http://s5.picofile.com/file/8151426818/fortran.rar.html
:n19::n19::n19::n19:

سلام دوستان الر می تونید کمک کنید.
برای توابع زیر در فاصله (0و1) انتگرال گیری کنید.(نیوتن -کوتز، رامبرگ، گوس، تطبیقی،نیوتن رافسون) با فرترن

F(x)=sin(mпx) m =108801133

F(x)=(1-x^m)^1/m m=-0.470028344

F(x)=e^-mx**2 m=-.0940056688

یک کد هم کمک کنید ممنون میشم
!************************************************* **********************
! *
! ROMBERG ALGORITHM 4.2 *
! *
!************************************************* **********************
!
!
!
! TO APPROXIMATE I = INTEGRAL((F(X) DX)) FROM A TO B:
!
! INPUT: ENDPOINTS A, B; INTEGER N.
!
! OUTPUT: AN ARRAY R. ( R(2,N) IS THE APPROXIMATION TO I.)
!
! R IS COMPUTED BY ROWS; ONLY 2 ROWS SAVED IN STORAGE
!
! DEFINE STORAGE FOR TWO ROWS OF THE TABLE
DIMENSION R(2,15)
CHARACTER*1 AA
LOGICAL OK
! CHANGE FUNCTION F FOR A NEW PROBLEM
F(XZ) =SIN(XZ)
OPEN(UNIT=5,FILE='CON',ACCESS='SEQUENTIAL')
OPEN(UNIT=6,FILE='CON',ACCESS='SEQUENTIAL')
WRITE(6,*) 'This is Romberg Integration.'
WRITE(6,*) 'Has the function F been created in the program? '
WRITE(6,*) 'Enter Y or N '
WRITE(6,*) ' '
READ(5,*) AA
IF(( AA .EQ. 'Y' ) .OR. ( AA .EQ. 'y' )) THEN
OK = .FALSE.
10 IF (OK) GOTO 11
WRITE(6,*) 'Input lower limit of integration and'
WRITE(6,*) 'upper limit of integration separated'
WRITE(6,*) 'by a blank.'
WRITE(6,*) ' '
READ(5,*) A, B
IF (A.GE.B) THEN
WRITE(6,*) 'lower limit must be less than upper limit'
WRITE(6,*) ' '
ELSE
OK = .TRUE.
ENDIF
GOTO 10
11 OK = .FALSE.
14 IF (OK) GOTO 15
WRITE(6,*) 'Input the number of rows - no decimal point.'
WRITE(6,*) ' '
READ(5,*) N
IF(N.GT.0) THEN
OK=.TRUE.
ELSE
WRITE(6,*) 'Must be positive integer '
WRITE(6,*) ' '
ENDIF
GOTO 14
15 CONTINUE
ELSE
WRITE(6,*) 'The program will end so that the function F '
WRITE(6,*) 'can be created '
OK = .FALSE.
ENDIF
IF (.NOT.OK) GOTO 400
! STEP 1
H = B-A
R(1,1) = (F(A)+F(B))/2*H
! STEP 2
WRITE(6,2) R(1,1)
! STEP 3
DO 20 I=2,N
! STEP 4
! APPROXIMATION FROM TRAPEZOIDAL METHOD
SUM = 0.0
M = 2**(I-2)
DO 30 K=1,M
30 SUM = SUM+F(A+(K-.5)*H)
R(2,1) = (R(1,1)+H*SUM)/2
! STEP 5
! EXTRAPOLATION
DO 40 J=2,I
L = 2**(2*(J-1))
40 R(2,J) = R(2,J-1)+(R(2,J-1)-R(1,J-1))/(L-1)
! STEP 6
! OUTPUT
WRITE(6,2) (R(2,K),K=1,I)
! STEP 7
H = H/2
! STEP 8
! SINCE ONLY TWO ROWS ARE KEPT IN STORAGE, THIS STEP
! IS TO PREPARE FOR THE NEXT ROW.
! UPDATE ROW 1 OF R
DO 20 J=1,I
20 R(1,J) = R(2,J)
! STEP 9
400 CLOSE(UNIT=5)
CLOSE(UNIT=6)
STOP
2 FORMAT(1X,(6(3X,E15.8)))
pause
END

سلام بافرترن برای اسپیلاین در فاصله (0و1) نوشتم جواب نمیده اگه می تونید کمک کنید. با تشکر

F(x)=sin(mпx) m =108801133
program main
real, parameter :: a=0.0, b=1.00000 pi = 3.1415926
real, dimension(0:n):: t,z
real :: d,h
integer ::i,j,k,n
doubleprecision id,m,dx,xx,y(1000),x(1000)

interface
subroutine spline3_coef(n,t,y,z)
integer, intent(in)::n
real, dimension(0:n), intent(in):: t,y
real, dimension(0:n), intent(out):: z
end subroutine spline3_coef
function spline3_eval(n,t,y,z,x)
integer, intent(in)::n
real, dimension(0:n), intent(in)::t,y,z
real, intent(in):: x
end function spline3_eval
end interface

write(*,*)"please enter your id:"
read*,id
m=(id/(10**9))*2
write(*,*)"please enter maximum of point:"
read*,n
write(*,*)"please enter x requested:"
read*,xx
do j=2,n
dx=1.0000000000000000/(j-1)
do i=1,j
if (i==1) then
x(1)=0
else if (i==j) then
x(j)=1
else
x(i)=x(i-1)+dx
end if
y(i)=sin(m*pi*x(i))
!write(*,*)"x","(",i,")",x(i)
!write(*,*)"y","(",i,")",y(i)
end do
call spline3_coef(n,t,y,z)
do i = 0,4*n
x = a + real(i)*h*0.25
d = sin(x) - spline3_eval(n,t,y,z,x)
print* "(i5,f22.14,e15.3)", i,x,d
end do
pause
end program main

subroutine spline3_coef(n,t,y,z)
integer, intent(in)::n
real, dimension(0:n), intent(in):: t,y
real, dimension(0:n-1) :: h,b
real, dimension(n-1)::u,v
real, dimension(0:n), intent(out):: z
integer :: i
do i = 0,n-1
h(i) = t(i+1) - t(i)
b(i) = (y(i+1) -y(i))/h(i)
end do
u(1) = 2.0*(h(0) + h(1))
v(1) = 6.0*(b(1) - b(0))
do i = 2,n-1
u(i) = 2.0*(h(i) + h(i-1)) - h(i-1)**2/u(i-1)
v(i) = 6.0*(b(i) - b(i-1)) - h(i-1)*v(i-1)/u(i-1)
end do
z(n) = 0.0
do i = n-1,1,-1
z(i) = (v(i) - h(i)*z(i+1))/u(i)
end do
z(0) = 0.0
pause
end subroutine spline3_coef

function spline3_eval(n,t,y,z,x)
integer, intent(in):: n
real, dimension(0:n), intent(in):: t,y,z
real, intent(in):: x
real :: h, temp
integer :: i
do i = n-1,1,-1
if( x - t(i) >= 0.0) exit
end do
h = t(i+1) - t(i)
temp = 0.5*z(i) + (x - t(i))*(z(i+1) - z(i))/(6.0*h)
temp = (y(i+1) - y(i))/h - h*(z(i+1) + 2.0*z(i))/6.0 + (x- t(i))*temp
spline3_eval = y(i) + (x - t(i))*temp
pause
end function spline3_eval

عرض ادب و احترام،
بنده میخوام قالب این سایت رو دریافت کنم، ولی نمیتونم، خیلی قشنگ برنامه نویسی شده:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
نرم افزار یا راهکاری خاصی دارید که بهم معرفی کنید.
سپاس فراوان