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. После этого графическая программа стартует в режиме полноэкранного окна.

numxpixels - число пикселей по оси х,

numypixels - число пикселей по оси у,

numtextcols – число доступных текстовых колонок,

numtextrows - число доступных текстовых строк,

numcolors – число доступных цветов,

fontsize – размер шрифта по умолчанию.

data wc.numxpixels, wc.numypixels, wc.numtextcols, &

wc.numtextrows, wc.numcolors, wc.fontsize / 6*-1 /

Инициализация окна строкой в стиле С.

wc.title = "Интерполяционный многочлен Лагранжа"C

Читаем параметры видеоокна. getwindowconfig возвращает информацию об активном окне в структуру wc. Если свойства окна не были установлены с помощью SETWINDOWCONFIG, функция GETWINDOWCONFIG возвращает параметры окна по умолчанию. Логический результат res равен true, если функция выполнена успешно, false – в противном случае.

res = getwindowconfig(wc)

Графическая функция рисует прямоугольник текущим цветом и стилем. RECTANGLE использует коодинаты видеопорта, RECTANGLE_W использует систему координат окна.

result = RECTANGLE (control, x1, y1, x2, y2)

result = RECTANGLE_W (control, wx1, wy1, wx2, wy2)

control - флаг заполнения прямоугольника целого типа. Одна из символических констант заполнения:

• $GFILLINTERIOR – рисует сплошную фигуру текущим цветом и заполнением.

• $GBORDER – рисует фигуру без заполнения.

x1, y1 - координаты верхнего-левого угла прямоугольника типа (Input) INTEGER(2) в системе координат видеопорта.

x2, y2 - координаты нижнего-правого угла прямоугольника типа (Input) INTEGER(2) в системе координат видеопорта.

wx1, wy1 - координаты верхнего-левого угла прямоугольника типа (Input) REAL(8) в системе координат окна. wx2, wy2 - координаты нижнего-правого угла прямоугольника типа (Input) REAL(8) в системе координат окна.

result – результат целого типа INTEGER(2) возвращает ненулевое число в случае успешного завершения функции, 0 – иначе.

Графическая функция. Устанавливает текущий цвет рисования.

result = SETCOLOR (color)

• color - индекс цвета рисования типа (Input) INTEGER(2);

• result - результат типа INTEGER(2) имеет значение индекса предыдущего цвета; иначе -1.

Графическая процедура переустанавливает графический видеопорт, определяя область клипа. Любая установка окна рисования с помощью функции SETWINDOW выполняется относительно видеопорта, а не всего экрана.

CALL SETVIEWPORT (x1, y1, x2, y2)

• x1, y1 - (Input) INTEGER(2). Физические координаты верхнего-левого угла видеопорта (прямоугольной области клипа);

• x2, y2 - (Input) INTEGER(2). Физические координаты нижнего-правого угла видеопорта.

Графическая функция SETWINDOW определяет систему координат, которую используют все рисующие графические подпрограммы, имена которых заканчивается на _W (например, ARC_W, RECTANGLE_W или LINETO_W). Любая установка окна рисования с помощью функции SETWINDOW выполняется относительно видеопорта, а не всего экрана.

result = SETWINDOW (finvert, wx1, wy1, wx2, wy2)

• finvert - (Input) LOGICAL(2). Определяет направление оси y. Если finvert равен .TRUE., ось y направлена от низа окна к верху. Если finvert равен .FALSE., ось y направлена от верха окна к низу (как и координаты пиксела);

• wx1, wy1 - (Input) REAL(8). Координаты верхнего-левого угла окна;

• wx2, wy2 - (Input) REAL(8). Координаты нижнего-правого угла окна;

• result - INTEGER(2). Результат имеет ненулевое значение, если функция завершена успешно; иначе, 0 (например, если программа вызывает SETWINDOW, но находится не в графическом режиме).

Производный тип (структура) xycoord. содержит координаты (x,y) видеопорта и определена как:

TYPE xycoord

INTEGER(2) xcoord ! x-coordinate

INTEGER(2) ycoord ! y-coordinate

END TYPE xycoord

Объявление переменной xyпроизводного типа (структуры) xycoord. которая содержит координаты (x,y) видеопорта

type(xycoord) xy

Производный тип (структура) wxycoord. содержит координаты (x,y) окна и определена как:

TYPE wxycoord

REAL(8) wx ! x window coordinate

REAL(8) wy ! y window coordinate

END TYPE wxycoord

Графическая функция MOVETO перемещает текущую графическую позицию в заданную точку видеопорта с координатами (x, y). Графическая функция MOVETO_W перемещает текущую графическую позицию в заданную точку окна с координатами (wx, wy). При этом рисования не происходит. Функции MOVETO и MOVETO_W присваивает координаты предыдущей позиции переменным t и wt, соответственно.

CALL MOVETO (x, y, t)

CALL MOVETO_W (wx, wy, wt)

• x, y - (Input) INTEGER(2). Координаты новой графической позиции в системе координат видеопорта;

• t - (Output) производный тип xycoord. Координаты предыдущей графической позиции в системе координат видеопорта;

• wx, wy - (Input) REAL(8). Координаты новой графической позиции в системе координат окна;

• wt - (Output) производный тип wxycoord. Координаты предыдущей графической позиции в системе координат окна.

Графическая функция рисует линию из текущей графической позиции в заданную конечную точку включительно. Линия рисуется текущим цветом (устанавливается с помощью SETCOLORRGB), в логическом режиме вывода (устанавливается SETWRITEMODE) и стилем (устанавливается SETLINESTYLE). Если не возникает ошибок, LINETO устанавливает текущую графическую позицию в точку видеопорта (x, y), а LINETO_W устанавливает текущую графическую позицию в точку окна (wx, wy).

result = LINETO (x, y)

result = LINETO_W (wx, wy)

x, y - (Input) INTEGER(2). Конечная точка видеопорта;

wx, wy - (Input) REAL(8). Конечная точка окна;

result - INTEGER(2). Результат имеет ненулевое значение, если успешно завершена функция, иначе 0.

Графическая функция SETPIXEL устанавливает заданный пиксел в текущий цвет, который устанавливается SETCOLOR и может быть получен с помощью GETCOLOR. Не RGB цветовые функции (такие как SETCOLOR and SETPIXELS) используют индексы цвета вместо реальных значений цвета.

result = SETPIXEL (x, y)

result = SETPIXEL_W (wx, wy)

x, y - (Input) INTEGER(2). Координаты заданного пиксела в системе координат видеопорта;

wx, wy - (Input) REAL(8). Координаты заданного пиксела в системе координат окна;

result - INTEGER(2). Результатом является предыдущий цвет заданного пиксела, если функция успешна; в противном случае, -1 (например, если пиксел находится вне области рисования).

КАТЕГОРИЯ 2. Реализация процедуры W вывода в текстовый файл 'DZ2.out' массива С коэффициентов полинома аппроксимации степени m

Вариант 1

subroutine W(m,C)

integer,parameter::fpw=2 ! устройство вывода

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

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

open(unit=fpw,file='DZ2.out') ! открыть файл

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

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

close(fpw) ! закрыть файл

end subroutine W

Вариант 2

subroutine W(m,C)

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

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

open(unit=2,file="DZ2.out") ! открыть файл

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

write(2,"(100f8.4)") (c(i),i=0,m)

close(2) ! закрыть файл

end subroutine

Вариант 3

subroutine W(m,C)

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

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

open(2,file='DZ2.out') ! открыть файл

write(2,10) 'Коэффициенты полинома Pm(x):'

10 format(a)

do i=0,m

write(2,11) c(i),' '

end do

11 format(f8.4,a,$)

close(2) ! закрыть файл

end

КАТЕГОРИЯ 3. Реализация процедуры R считывания из текстового файла 'DZ.txt' динамических массивов X, Y координат n узлов аппроксимации.

Текстовый файл DZ.txt .

Вариант 1

subroutine R(n,X,Y)

implicit none

integer,parameter::fi=1 ! устройство ввода

integer,parameter::MAX=100 ! максимальное количество точек

integer i ! счетчик точек полинома

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

integer n ! количество точек функции (i=0..n-1)

open(unit=fi,file='DZ.txt') ! открытие файла данных

read(fi,*) n ! чтение количества узлов аппроксимации

do i=0,n-1 ! проход по узлам аппроксимации

read(fi,*) X(i),Y(i) ! чтение координат узлов

enddo

close(fi) ! закрытие файла

end subroutine R

Вариант 2

subroutine R1(n,X,Y)

implicit none

integer,parameter::MAX=100 ! максимальное количество точек

integer i ! счетчик точек полинома

double precision X(0:MAX),Y(0:MAX) ! таблица данных X(n),Y(n)

integer n ! количество точек функции (i=0..n-1)

open(unit=1,file='DZ.txt') ! открытие файла данных

read(1,*) n ! чтение количества узлов

do 2 i=0,n-1 ! проход по узлам аппроксимации

read(1,*) X(i),Y(i) ! чтение координат узлов

2 continue

close(1) ! закрытие файла

end subroutine

Вариант 3

subroutine R2(n,X,Y)

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

open(1,file='DZ.txt') ! открытие файла данных

read(1,*) n ! чтение количества узлов аппроксимации

do 2 i=0,n-1 ! проход по узлам аппроксимации

2 read(1,*) X(i),Y(i) ! чтение координат узлов

close(1) ! закрытие файла

end