# Практическое исследование порядка точности на полиномах

### Содержание работы

subroutine vvod

implicit real*8 (a-h,o-z)

common /int/ rintegr,a,b,isig,n

!real*8 rintegr

9     format(d20.15,d20.15)

open (50,file='E:\fortran\l4\input.txt')

close(50)

if(a.gt.b)then

c=a

a=b

b=c

isig=2

endif

end

subroutine proverka

implicit real*8 (a-h,o-z)

common /int/ rintegr,a,b,isig,n

!real*8 rintegr

print *, 'Enter n'

if(n.le.0)then

print *, 'N incorrected!'

isig=1

end if

end

subroutine tint

implicit real*8 (a-h,o-z)

common /int/ rintegr,a,b,isig,n

!real*8 rintegr

an=n

rintegr=((b-a)/an)*(f(a)+f(b))/2D00

do i=1,n-1,1

ai=i

rintegr=rintegr+f(a+((ai)*(b-a)/an))*((b-a)/an)

end do

end

subroutine g2int

implicit real*8 (a-h,o-z)

common /int/ rintegr,a,b,isig,n

!real*8 rintegr

x1=0.577350269189625D00

q1=1.0

an=n

h=(b-a)/an

do i=0,n-1,1

ai=i

rintegr=rintegr+q1*f((h*x1+2D00*a+(2D00*ai+1D00)*h)/2D00)

rintegr=rintegr+q1*f((-h*x1+2D00*a+(2D00*ai+1D00)*h)/2D00)

end do

rintegr=rintegr*(h/2D00)

end

subroutine g4int

implicit real*8 (a-h,o-z)

common /int/ rintegr,a,b,isig,n

!real*8 rintegr

x1=0.339981043584856D00

x2=0.861136311594053D00

q1=0.652145154862546D00

q2=0.347854845137454D00

an=n

h=(b-a)/an

do i=0,n-1,1

ai=i

rintegr=rintegr+q1*f((h*x1+2D00*a+(2D00*ai+1D00)*h)/2D00)

rintegr=rintegr+q1*f((-h*x1+2D00*a+(2D00*ai+1D00)*h)/2D00)

rintegr=rintegr+q2*f((h*x2+2D00*a+(2D00*ai+1D00)*h)/2D00)

rintegr=rintegr+q2*f((-h*x2+2D00*a+(2D00*ai+1D00)*h)/2D00)

end do

rintegr=rintegr*(h/2D00)

end

!real*8 function f(x)

!F=3*x*Sin(3*x)/3.1459265358979D00

!return

!end

!real function f(x)

! F=EXP(Sin(x))

!return

!end

real*8 function f(x)

implicit real*8 (a-h,o-z)

F=x*Sin(x)

return

end

subroutine Out

implicit real*8 (a-h,o-z)

common /int/ rintegr,a,b,isig,n

!real*8 rintegr

if(isig.ne.2)then

print *, 'Integral  =',rintegr

else

print *, 'Integral  =', -rintegr

pause

end if

return

end

subroutine trapec

common /int/ rintegr,a,b,isig,n

real*8 rintegr

open(1,file='out.csv',status='old')

call proverka

if(isig.ne.1)then

rintegr=0.0

n=5

a=0.0

b=0.5

call tint

call Out

write(1,'(I8,a,f20.15,a,f20.15)') n,';',rintegr,

*';',(b-a)/n

rintegr=0.0

n=2

a=0.5

b=0.8

call tint

call Out

write(1,'(I8,a,f20.15,a,f20.15)') n,';',rintegr,

*';',(b-a)/n

a=0.8

b=1.5

rintegr=0.0

n=10

call tint

call Out

write(1,'(I8,a,f20.15,a,f20.15)') n,';',rintegr,

*';',(b-a)/n

a=1.5

rintegr=0.0

n=2

b=1.8

call tint

call Out

write(1,'(I8,a,f20.15,a,f20.15)') n,';',rintegr,

*';',(b-a)/n

a=1.8

b=2.55

rintegr=0.0

n=10

call tint

call Out

write(1,'(I8,a,f20.15,a,f20.15)') n,';',rintegr,

*';',(b-a)/n

a=2.55

b=2.75

rintegr=0.0

n=2

call tint

call Out

write(1,'(I8,a,f20.15,a,f20.15)') n,';',rintegr,

*';',(b-a)/n

a=2.75

rintegr=0.0

### Информация о работе

Тип:
Отчеты по лабораторным работам
Размер файла:
41 Kb
Скачали:
0