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

       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')

        read(50,*) a, b

        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'

        read *, 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