Mercurial > octave
annotate liboctave/external/lapack-xtra/crsf2csf.f @ 29358:0a5b15007766 stable
update Octave Project Developers copyright for the new year
In files that have the "Octave Project Developers" copyright notice,
update for 2021.
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Wed, 10 Feb 2021 09:52:15 -0500 |
| parents | 9f9ac219896d |
| children | 796f54d4ddbf |
| rev | line source |
|---|---|
|
29358
0a5b15007766
update Octave Project Developers copyright for the new year
John W. Eaton <jwe@octave.org>
parents:
27985
diff
changeset
|
1 c Copyright (C) 2010-2021 The Octave Project Developers |
|
27918
b442ec6dda5c
use centralized file for copyright info for individual contributors
John W. Eaton <jwe@octave.org>
parents:
26376
diff
changeset
|
2 c |
|
27923
bd51beb6205e
update formatting of copyright notices
John W. Eaton <jwe@octave.org>
parents:
27919
diff
changeset
|
3 c See the file COPYRIGHT.md in the top-level directory of this |
|
bd51beb6205e
update formatting of copyright notices
John W. Eaton <jwe@octave.org>
parents:
27919
diff
changeset
|
4 c distribution or <https://octave.org/copyright/>. |
| 10822 | 5 c |
| 6 c This file is part of Octave. | |
| 7 c | |
|
24534
194eb4bd202b
maint: Update punctuation for GPL v3 license text.
Rik <rik@octave.org>
parents:
23434
diff
changeset
|
8 c Octave is free software: you can redistribute it and/or modify it |
|
22802
0dcff7695e26
maint: Update more Copyright statements to use standard form.
Rik <rik@octave.org>
parents:
22323
diff
changeset
|
9 c under the terms of the GNU General Public License as published by |
|
24534
194eb4bd202b
maint: Update punctuation for GPL v3 license text.
Rik <rik@octave.org>
parents:
23434
diff
changeset
|
10 c the Free Software Foundation, either version 3 of the License, or |
| 10822 | 11 c (at your option) any later version. |
| 12 c | |
|
22802
0dcff7695e26
maint: Update more Copyright statements to use standard form.
Rik <rik@octave.org>
parents:
22323
diff
changeset
|
13 c Octave is distributed in the hope that it will be useful, but |
|
0dcff7695e26
maint: Update more Copyright statements to use standard form.
Rik <rik@octave.org>
parents:
22323
diff
changeset
|
14 c WITHOUT ANY WARRANTY; without even the implied warranty of |
| 10822 | 15 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 16 c GNU General Public License for more details. | |
| 17 c | |
| 18 c You should have received a copy of the GNU General Public License | |
|
22802
0dcff7695e26
maint: Update more Copyright statements to use standard form.
Rik <rik@octave.org>
parents:
22323
diff
changeset
|
19 c along with Octave; see the file COPYING. If not, see |
|
24534
194eb4bd202b
maint: Update punctuation for GPL v3 license text.
Rik <rik@octave.org>
parents:
23434
diff
changeset
|
20 c <https://www.gnu.org/licenses/>. |
| 10822 | 21 c |
| 22 | |
| 23 subroutine crsf2csf(n,t,u,c,s) | |
| 24 integer n | |
| 25 complex t(n,n),u(n,n) | |
| 26 real c(n-1),s(n-1) | |
| 27 real x,y,z | |
| 28 integer j | |
|
14460
6c3441f3146b
Fix logm for complex matrix with real eigenvalues (bug #34893).
Marco Caliari <marco.caliari@univr.it>
parents:
14138
diff
changeset
|
29 do j = 1,n-1 |
|
6c3441f3146b
Fix logm for complex matrix with real eigenvalues (bug #34893).
Marco Caliari <marco.caliari@univr.it>
parents:
14138
diff
changeset
|
30 c(j) = 1 |
|
6c3441f3146b
Fix logm for complex matrix with real eigenvalues (bug #34893).
Marco Caliari <marco.caliari@univr.it>
parents:
14138
diff
changeset
|
31 end do |
| 10822 | 32 j = 1 |
| 33 do while (j < n) | |
| 34 c apply previous rotations to rows | |
| 35 call crcrot1(j,t(1,j),c,s) | |
| 36 | |
| 37 y = t(j+1,j) | |
| 38 if (y /= 0) then | |
|
13141
e81ddf9cacd5
maint: untabify and remove trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
39 c 2x2 block, form Givens rotation [c, i*s; i*s, c] |
| 10822 | 40 z = t(j,j+1) |
|
10823
3d89d262f5d4
slight simplification in rsf2csf code
Jaroslav Hajek <highegg@gmail.com>
parents:
10822
diff
changeset
|
41 c(j) = sqrt(z/(z-y)) |
|
14460
6c3441f3146b
Fix logm for complex matrix with real eigenvalues (bug #34893).
Marco Caliari <marco.caliari@univr.it>
parents:
14138
diff
changeset
|
42 s(j) = sqrt(y/(y-z)) |
| 10822 | 43 c apply new rotation to t(j:j+1,j) |
| 44 call crcrot1(2,t(j,j),c(j),s(j)) | |
| 45 c apply all rotations to t(1:j+1,j+1) | |
| 46 call crcrot1(j+1,t(1,j+1),c,s) | |
| 47 c apply new rotation to columns j,j+1 | |
|
13141
e81ddf9cacd5
maint: untabify and remove trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
48 call crcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) |
| 10822 | 49 c zero subdiagonal entry, skip next row |
| 50 t(j+1,j) = 0 | |
| 51 j = j + 2 | |
| 52 else | |
| 53 j = j + 1 | |
| 54 end if | |
| 55 end do | |
| 56 | |
| 57 c apply rotations to last column if needed | |
| 58 if (j == n) then | |
| 59 call crcrot1(j,t(1,j),c,s) | |
| 60 end if | |
| 61 | |
| 62 c apply stored rotations to all columns of u | |
| 63 do j = 1,n-1 | |
| 64 if (c(j) /= 1) then | |
| 65 call crcrot2(n,u(1,j),u(1,j+1),c(j),s(j)) | |
| 66 end if | |
| 67 end do | |
| 68 | |
| 69 end subroutine | |
| 70 | |
| 71 subroutine crcrot1(n,x,c,s) | |
| 72 c apply rotations to a column from the left | |
| 73 integer n | |
| 74 complex x(n), t | |
| 75 real c(n-1),s(n-1) | |
| 76 integer i | |
| 77 do i = 1,n-1 | |
| 78 if (c(i) /= 1) then | |
| 79 t = x(i)*c(i) - x(i+1)*cmplx(0,s(i)) | |
| 80 x(i+1) = x(i+1)*c(i) - x(i)*cmplx(0,s(i)) | |
| 81 x(i) = t | |
| 82 endif | |
| 83 end do | |
| 84 end subroutine | |
| 85 | |
| 86 subroutine crcrot2(n,x,y,c,s) | |
| 87 c apply a single rotation from the right to a pair of columns | |
| 88 integer n | |
| 89 complex x(n),y(n),t | |
| 90 real c, s | |
| 91 integer i | |
| 92 do i = 1,n | |
| 93 t = x(i)*c + y(i)*cmplx(0,s) | |
| 94 y(i) = y(i)*c + x(i)*cmplx(0,s) | |
| 95 x(i) = t | |
| 96 end do | |
| 97 end subroutine |