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