Листинг программы на алгоритмическом языке Pascal

Листинг программы на алгоритмическом языке Pascal. Метод Лаверрье-Фаддеева Метод нахождения собственных чисел матриц M 1024,0,0Освобождение памяти для потомка uses Dos,Crt const N10 MainTextColor15 DiagonColor2 OutPutI3 OutPutJ7 ScaleI10 ScaleJ3 type TMatrixarray1 N,1 N of real TVecarray1 N of real Процедура решает задачу ввода порядка исходной матрицы procedure ReadRangevar Rangeinteger begin writelnБлок ввода данных writeВведите порядок исходной матрицы AMatrix readRange end Процедура считывания исходной матрицы procedure InputMatrixvar AMatrixTMatrixRangeinteger var i, j,cols, rowsinteger begin RowsRange ColsRange writelnВведите исходную матрицу for i1 to cols do for j1 to rows do begin GoToXYOutPutIScaleIi,OutPutJScaleJj readAMatrixi, j end end procedure PlotSameMatrixvar CEquivalTMatrixAMatrixTMatrixRangeintege r var i, jinteger begin for i1 to Range do for j1 to Range do begin CEquivali, jAMatrixi, j end ClrScr end Процедуры форматированного выводапечати матриц AMatrix procedure CoordAMatrixvar AMatrixTMatrixRangeinteger var i, j,kinteger begin for i1 to Range do for j1 to range do begin GoToXYOutPutIScaleIi,OutPutJScaleJj if ij then TextColorDiagonColor else TextColorMainTextColor writeAMatrixi, j42 end end procedure CoordVMatrixvar VMatrixTMatrixRangeinteger var i, jinteger begin for i1 to Range do for j1 to range do begin GoToXYOutPutIScaleIi,OutPutJScaleJj writeVMatrixi, j42 end end Суммирование диагональных элементов след матрицы function TraceRangeintegerAMatrixTMatrixreal var i,Ninteger diagsumreal begin Diagsum0 Trace0 NRange for i1 to N do begin DiagsumdiagsumAMatrixi, i TraceDiagsum end end Промежуточная матрица V procedure VIntervar VMatrixTMatrixBMatrix,AMatrixTMatrixRang einteger Pkreal var i, j,m, i0integer begin ClrScr TextColorMainTextColor writeln Промежуточная матрица Bn readln for i1 to Range do for j1 to Range do begin if ij then BMatrixi, jAMatrixi, j-Pk else BMatrixi, jAMatrixi, j VMatrixi, jBMatrixi, j CoordVMatrixVMatrix, Range end readln end Процедура формирования матрицы A последовательности матриц procedure AConsistancevar AMatrixTMatrixCEquival,VTMatrixRangeinte ger var i, j,kinteger begin ClrScr for i1 to Range do for j1 to Range do begin AMatrixi, j0 end for k1 to Range do for i1 to Range do begin for j1 to Range do begin AMatrixk, iAMatrixk, iCEquivalk, jVj, i end CoordAMatrixAMatrix,Range end end Промежуточная функция возведения в степень function powxrealyintegerreal begin if x0 then pow0 if x 0 then powexpylnx if x 0 and y mod 20 then powexpyln-x if x 0 and y mod 2 0 then pow-expyln-x end Окончательная функция function fxrealiintegerPVecTVecRangeintegerreal var kinteger begin k1 if Range4 then fpowx,4-PVeckpowx,3-PVeck1powx,2 - PVeck2x-PVeck3 if Range3 then fpowx,3-PVeckpowx,2-PVeck1x-PVeck2 end Derivative -вторая производная function FderivxrealiintegerPVecTVecRangeintegerr eal var kinteger begin k1 if Range4 then Fderiv12powx,2-6PVeckx-PVeck12 if Range3 then Fderiv6x-2PVeck end Реализация метода хорд для решения характеристического уравнения procedure ChordMethoodvar X,Yrealx1,x2,epsreali,RangeintegerPVecTV ec var Ya,Yb,Ykreal Xk,Xnreal kinteger begin Yafx1,i,PVec,Range Ybfx2,i,PVec,Range YFderivx1,i,PVec,RangeВторая производная if YaY 0 then begin Xkx1YkYaXx2 YYb end else begin Xkx2YkYb Xx1YYa end repeat XnXXXn-YY-YkXn-Xk YfX,i,PVec,Range until absX- Xk eps writelnLambda ,X54 writelnroot Y ,Y readln end Реализация метода уединения и уточнения коренй посредством метода хорд procedure Rootlimitvar alpha, betarealvar LVecTVecvar RootNuminteger i,RangeintegerPVecTVec const steph0.09 var x1,x2,y1,y2real Ya,Yb,Yk,Yreal Xk,Xn,Xreal epsreal kinteger begin k0 x1alpha x2x1steph y1fx1,i, PVec,Range while x2 beta do begin y2fx2,i,PVec,Range if y1y2 0 then begin TextColorMainTextColor writelnКорень лежит в этих пределах, x154 x254, Процедура уточнения корней характеристического уравнения ChordMethoodX,Y,x1,x2,eps, i,Range,PVec kk1 LVeckX end else x1x2 x2x1steph y1y2 end RootNumkЧисло действительных корней характеристического уравнения end Тело программы var AMatrix,CEquival,BMatrix,VMatrixTMatrix XSelfVec,LVec,UEMatrixTVec PCharacteristicParam,Pk,Pn,Lambda,Maxrea lПараметр p характеристического уравнения матрицы Range, k,k1,i, j,numinteger i0,minteger Cols,Rowsinteger PVecTVec Параметры характеристического уравнения уравнения Ya,Yb,Ykreal Xk,Xn, x1,x2real X,Yreal alpha, beta, epsreal RootNuminteger begin ClrScr TextColorMainTextColor Pn0 Pk0 ReadRangeRangeПроцедура считывает порядок матрицы InputMatrixAMatrix,RangeСчитываем исходную матрицу PlotSameMatrixCEquival,AMatrix,Range Блок вычисления коэффицентов характеристического уравнения матрицы ClrScr TextColorMainTextColor writelnКоэффиценты характеристического уравнения for k1 to Range-1 do begin PkTraceRange,AMatrixk Pk - коэффицент характкристич. уравнения PVeckPk writePk, k Pk94 readln VInterVMatrix,BMatrix,AMatrix,Range,Pk AConsistanceAMatrix,CEquival,VMatrix,Ran ge GoToXY39,1 writelnМатрица A,k1 readln end PnTraceRange, AMatrixRange PVeck1Pn Вектор параметров P writelnP,Range Pn92 readln ClrScr writelnВектор коэффицентов P for k1 to Range do begin GoToXYOutPutIScaleIk,OutPutJ TextColorMainTextColor writePVeck83 end readln Блок вычисления собственных чисел матрицы ClrScr TextColorMainTextColor writeln writelnВедите пределы, в которых располагаются корни уравнения. writeEnter alpha readlnalpha writeEnter beta readlnbeta writeEnter eps readlneps Rootlimitalpha, beta,LVec,RootNum, i,Range ,PVec ClrScr TextColorMainTextColor writeВектор собственных чисел for k1 to RootNum do begin GoToXYOutPutIScaleIk,OutPutJ writeLVeck84 end readln end.