Деякі розлади мислення

Дата добавления: 2015-03-11; просмотров: 541

!******************************************************************

subroutine curve() ! График функции у =fx(x)

real(8) xt, yt !

real(8) X1,X2,Y1,Y2 ! координаты углов маркера узла

integer(2):: color=1_2

Integer mm

Integer i,j

TYPE (wxycoord) xy

status = setcolor(color) ! График функции цветом color

! формирование и рисование маркеров узлов

do i=0,n-1

X1=X(i)-0.05; X2=X(i)+0.05

Y1=Y(i)-0.05; Y2=Y(i)+0.05

status = RECTANGLE_w ($GFILLINTERIOR , X1, Y1, X2, Y2)

Enddo

! рисование точками графика полинома

color=4_2

HX=(X(n-1)-X(0))/NT ! шаг изменения Х графика

! открыть файл результатов

open(unit=fpw,file='DZ2_V1.out')

! построение полинома степени m

do mm=1,2

call Gram(N-1,mm,X,Y,A); ! расчет расширенной матрицы к-тов

call GA(mm,A,c); ! решение системы уравнений методом Гаусса

! формирование данных полинома

do i=0,NT

xt=X(0)+i*HX ! абсцисса графика

yt=func(mm,c,xt) ! ордината графика

if(mm==1) then

! Вывод точки графика

status=setpixel_w(xt, yt)

Else

if(i==0) then

! переход на точку графика

Call moveto_w(xt, yt,xy)

Else

! рисование линии до точки графика

status=lineto_w(xt, yt)

Endif

Endif

Enddo

Enddo

Close(fpw)

End subroutine curve

!***********************************************************

!----- значение аппрокс.полинома в точке x1 ----------------

Real(8) function func(m,c,x1)

Integer m

real(8) c(0:m) ! массив коэффициентов аппрокс.полинома Pm(x)

Real(8) x1

Real(8) p

Integer i

!-----------------------------------------------------------

p=c(m) ! аппроксимирующaя функция

do i=m-1,0,-1

p=c(i)+x1*p ! полиномы Лежандра

Enddo

func=p

End function func

!***********************************************************

!----- построение матрицы Грама A(m,m+1) -------------------

Subroutine Gram(N,m,X,Y,A)

Integer N,m

real(8) X(0:n),Y(0:n) ! таблица данных X(N),Y(N)

real(8) A(0:m+1,0:m+1) ! матрица коэффициентов системы

! уравнений

Integer i,j

Real(8) p,q,r,s

!-----------------------------------------------------------

do j=0,m ! проход по строкам матрицы коэф-тов системы ур-ний

s=0.0

r=0.0

q=0.0

do i=0,N

p=X(i)**j

s=s+p

r=r+p*Y(i)

q=q+p*X(i)**m

Enddo

A(0,j)=s ! диагональный элемент матрицы

A(j,m+1)=r ! свободный член

A(j,m)=q

Enddo

do i=1,m

do j=0,m-1

A(i,j)=A(i-1,j+1)

Enddo

Enddo

End subroutine Gram

!***********************************************************

!----- метод Гаусса для СЛАУ -------------------------------

Subroutine GA(m,A,C)

Integer m

real(8) C(0:m) ! массив коэффициентов

! аппрокс.полинома Pm(x)

real(8) A(0:m+1,0:m+1) ! матрица коэффициентов системы

! уравнений

Integer i,j,k

Real(8) r,s

Integer k1,n1

!-----------------------------------------------------------

n1=m+1

do k=0,m

k1=k+1

s=A(k,k)

do j=k1,n1

A(k,j)=A(k,j)/s

Enddo

do i=k1,m

r=A(i,k)

do j=k1,n1

A(i,j)=A(i,j)-A(k,j)*r

Enddo

Enddo

Enddo

do i=m,0,-1

s=A(i,n1)

do j=i+1,m

s=s-A(i,j)*C(j)

Enddo

C(i)=s

Enddo

! вывод результатов в файл

write(fpw,*) "Расширенная матрица коэффициентов A(i,j):"

do i=0,m

write(fpw,'(100f8.4)') (a(i,j),j=0,m+1)

Enddo

write(fpw,*) "Коэффициенты полинома Pm(x):"

write(fpw,'(100f8.4)') (c(i),i=0,m)

End subroutine GA

!***********************************************************

МЕТОДОМ НАИМЕНЬШИХ КВАДРАТОВ

(Контрольные вопросы – правильные варианты)

КАТЕГОРИЯ 1. Графические подпрограммы.

Подключение модуля стандартных процедур

use msflib

Объявление структуры параметров окна

type(windowconfig) wc

Автоматическая настройка конфигурации окна. Чтобы установить наибольшую возможную разрешающую способность, надо присвоить значение -1 параметрам структуры окна wc. После этого графическая программа стартует в режиме полноэкранного окна.