• API
• FAQ
• Tools
• Archive
SHARE
TWEET roots_body starm100  Apr 2nd, 2019 (edited) 93 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. program lab1
2. use roots
3. implicit none
4. real(8)::x1,x2,xk,eps
5. real(8),parameter::mm1=1.4455,m2=0.5368,m1=1.0194,mm2=0.8813
6. integer::i=0,method
7. interface !If a procedure has another procedure as dummy argument then one has to specify its type, just as the type of other parameters.
8.           !An interface block is used for this case. It consists of the procedure statement with the definitions of its arguments.
9.
10.     real(8) function f(x)
11.     real(8) :: x
12.     end function f
13.
14.     real(8) function df(x)
15.     real(8) :: x
16.     end function df
17.
18.     real(8) function d2f(x)
19.     real(8) :: x
20.     end function d2f
21.
22. end interface
23. print*, 'Input x1,x2,and eps'
25. if (f(x1)*f(x2).GT.0) then
26.     print*,'Error, f(x1)*f(x2)>0'
27.     stop
28. else
29.     continue
30. end if
31. print*,'Choose method (1-Newtons,2-Chord,3-Secant,4-Fixed-point iteration)'
33. select case (method) !Выбор метода
34.     case (1)
35.         print*,'Newtons'
36.         call kas(f,df,d2f,x1,x2,xk,eps,i,mm2,m1)
37.     case (2)
38.         print*, 'Chord'
39.         call hord(f,x1,x2,xk,eps,i,mm1,m1)
40.     case (3)
41.         print*,'Secant'
42.         call sec(f,x1,x2,xk,eps,i,m1)
43.     case (4)
44.         print*, 'Fixed-point iteration'
45.         call iter(f,df,x1,x2,xk,eps,i)
46.     case default
47.         print*, 'Error'
48. end select
49. print*, 'Results::'
50. print*, 'xk=',xk
51. print*, 'f(xk)=',f(xk)
52. print*, 'iterations-',i
53. end program lab1
54.
55.     function f(x)
56.     implicit none
57.     real(8)::f,x
58.     f=exp(-x)-cos(x+4)
59.     end function f
60.
61.     function df(x)
62.     implicit none
63.     real(8)::df,x
64.     df=sin(x+4)-exp(-x)
65.     end function df
66.
67.     function d2f(x)
68.     implicit none
69.     real(8)::d2f,x
70.     d2f=exp(-x)+cos(x+4)
71.     end function d2f
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!

Top