Текст подпрограммы и версий
acp1r_p.zip , acp1e_p.zip 		Тексты тестовых примеров
tacp1r_p.zip , tacp1e_p.zip

Подпрограмма:  ACP1R (модуль ACP1R_p)

Назначение

Сингулярное разложение прямоугольной матрицы размера M на N (M ≥ N).

Математическое описание

Подпрограмма ACP1R осуществляет разложение прямоугольной матрицы A размера M на N (M ≥ N) в произведение А = UDVT, где U, V - ортогональные матрицы порядка М и N соответственно, D - прямоугольная матрица размера M на N, у которой все элементы, кpоме диагональных элементов dk = dkk, k = 1, 2, ..., N, равны нулю.

Последние M - N столбцов матрицы U, соответствующие заведомо нулевым собственным значениям матрицы AAT, обычно не используются и потому в данной подпрограмме не вычисляются.

Forsythe G.E., Malcolm M.A., Moler C.B. Computer Methods for Mathematical Computation. Prentice-Hall, 1977.

Использование 

procedure ACP1R(NM :Integer; M :Integer; N :Integer;
                var A :Array of Real; var W :Array of Real;
                MATU :Boolean; var U :Array of Real; MATV :Boolean;
                var V :Array of Real; var RV1 :Array of Real;
                var IERR :Integer); 

   Параметры
NM - число стpок в двумерных массивах A, U, V, причем NM ≥ M (тип: целый);
M - число стpок матриц A и U (тип: целый);
N - число столбцов матриц A и U и порядок матрицы V (тип: целый);
A - вещественный двумерный массив размера NM на N, в первых M стpоках которого задается исходная матрица;
W - вещественный вектоp длины N значений W(k) = dk вычисленных сингулярных чисел матрицы A;
MATU - признак необходимости вычисления матрицы U: при MATU = TRUE матрица U вычисляется, при MATU = FALSE - нет (тип: логический);
U - вещественный двумерный массив размера NM на N, в котоpом при MATU = TRUE содержатся вычисленные первые N столбцов матрицы U; при MATU = FALSE массив U используется как рабочий;
MATV - признак необходимости вычисления матрицы V: при MATV = TRUE матрица V вычисляется, при MATV = FALSE - нет (тип: логический);
V - вещественный двумерный массив размера NM на N, в котоpом при MATV = TRUE содержится вычисленная матрица V; при MATV = FALSE массив V не используется;
R - вещественный рабочий вектоp длины N;
IERR - целая переменная, служащая для сообщения об ошибках, обнаруженных в ходе работы подпрограммы; при этом:
 

IERR = K, если для вычисления К - го сингулярного числа потребовалось более 30 итераций; в этом случае правильно вычислены лишь сингулярные числа и сингулярные векторы с индексами K+1, K+2, ..., N. 

   Версии
ACP1E - сингулярное разложение прямоугольной матрицы размера M на N (M ≥ N), заданной с расширенной (Extended) точностью. 
   Вызываемые подпрограммы
UTAC10 - подпрограмма выдачи диагностических сообщений при работе подпрограмм ACP1R и ACP1E. 
   Замечания по использованию
  1.

При обращении к подпрограмме ACP1E параметры A, W, U, V, R должны иметь тип Extended.

  2.

B результате работы подпрограммы массив A сохраняется.

  3.

Допустимо совпадение параметров U или V с параметром A.

Пример использования 

Unit TACP1R_p;
interface
uses
SysUtils, Math, { Delphi }
LStruct, Lfunc, UtRes_p, ACP1R_p;

function TACP1R: String; 

implementation

function TACP1R: String;
var
I,IERR,J,M,N,NM :Integer;
A :Array [0..14] of Real;
U :Array [0..14] of Real;
V :Array [0..14] of Real;
SIGМА :Array [0..2] of Real;
WORK :Array [0..4] of Real;
label
_1,_3,_4,_5;
begin
Result := '';
NM := 5;
M := 5;
N := 3;
for I:=1 to M do
 begin
  for J:=1 to N do
   begin
    A[(I-1)+(J-1)*5] := I + (J-1)*M;
_1:
   end;
 end;
ACP1R(NM,M,N,A,SIGMA,True,U,True,V,WORK,IERR);
if ( IERR <> 0 ) 
 then  begin
       Result := Result + Format('%s',['  IERR=']);
       Result := Result + Format('%4d',[IERR]) + #$0D#$0A;
       end;
for J:=1 to N do
 begin
  Result := Result + Format('%20.16f ',[SIGMA[J-1]]) + #$0D#$0A;
_3:
 end;
Result := Result + Format('%s',['  ']) + #$0D#$0A; 
for I:=1 to M do
 begin
Result := Result + #$0D#$0A;
  for J:=1 to N do
   begin
    Result := Result + Format('%20.16f ',[U[(I-1)+(J-1)*5]]) + #$0D#$0A;
   end;
Result := Result + #$0D#$0A;
_4:
 end;
Result := Result + Format('%s',['  ']) + #$0D#$0A; 
for I:=1 to N do
 begin
Result := Result + #$0D#$0A;
  for J:=1 to N do
   begin
    Result := Result + Format('%20.16f ',[V[(I-1)+(J-1)*5]]) + #$0D#$0A;
   end;
Result := Result + #$0D#$0A;
_5:
 end;
UtRes('TACP1R',Result);  { вывод результатов в файл TACP1R.res }
exit;
end;

end.


Результаты:
          IERR  =  0, 

               | 35.127         |
     W  =  |   2.465         |     , 
               |   1.587E-11 |

              | -0.202    0.890    0.408  | 
     V  =  | -0.517    0.257   -0.816 |     , 
              | -0.832   -0.376    0.408 |

              | -0.355   -0.689    0.602 |
              | -0.399   -0.376   -0.517 |
     U  =  | -0.443   -0.062   -0.306 |
              | -0.487    0.251   -0.244 |
              | -0.531    0.564    0.466 |