49 lines
1.3 KiB
Text
49 lines
1.3 KiB
Text
test: procedure options (main); /* 1 October 2012 */
|
|
declare n fixed binary;
|
|
|
|
put ('Conjugate a complex square matrix.');
|
|
put skip list ('What is the order of the matrix?:');
|
|
get (n);
|
|
begin;
|
|
declare (M, MH, MM, MM_MMH, MM_MHM, IDENTITY)(n,n) fixed complex;
|
|
declare i fixed binary;
|
|
|
|
IDENTITY = 0; do i = 1 to n; IDENTITY(I,I) = 1; end;
|
|
put skip list ('Please type the matrix:');
|
|
get list (M);
|
|
do i = 1 to n;
|
|
put skip list (M(i,*));
|
|
end;
|
|
do i = 1 to n;
|
|
MH(i,*) = conjg(M(*,i));
|
|
end;
|
|
put skip list ('The conjugate transpose is:');
|
|
do i = 1 to n;
|
|
put skip list (MH(i,*));
|
|
end;
|
|
if all(M=MH) then
|
|
put skip list ('Matrix is Hermitian');
|
|
call MMULT(M, MH, MM_MMH);
|
|
call MMULT(MH, M, MM_MHM);
|
|
|
|
if all(MM_MMH = MM_MHM) then
|
|
put skip list ('Matrix is Normal');
|
|
|
|
if all(ABS(MM_MMH - IDENTITY) < 0.0001) then
|
|
put skip list ('Matrix is unitary');
|
|
if all(ABS(MM_MHM - IDENTITY) < 0.0001) then
|
|
put skip list ('Matrix is unitary');
|
|
end;
|
|
|
|
MMULT: procedure (M, MH, MM);
|
|
declare (M, MH, MM)(*,*) fixed complex;
|
|
declare (i, j, n) fixed binary;
|
|
|
|
n = hbound(M,1);
|
|
do i = 1 to n;
|
|
do j = 1 to n;
|
|
MM(i,j) = sum(M(i,*) * MH(*,j) );
|
|
end;
|
|
end;
|
|
end MMULT;
|
|
end test;
|