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

[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

[bad_boy_2007]

سلام
من این برنامه رو برای حل معادله 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

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

برای مشاهده محتوا ، لطفا وارد شوید یا ثبت نام کنید

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

[yokhsan]

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

[fluid92]

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

[sahandem]

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

[فااطمه]

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

[sahandem]

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

[iman.mousavi69@gma]

سلام دوستان الر می تونید کمک کنید.
برای توابع زیر در فاصله (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

[iman.mousavi69@gma]

سلام بافرترن برای اسپیلاین در فاصله (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

[hanis29268]

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