-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
(f77) fix added f77 interfaces for a few Lapack QR RQ functions
- Loading branch information
1 parent
38f3c7c
commit 2c00961
Showing
9 changed files
with
219 additions
and
14 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,40 @@ | ||
| #:mute | ||
| subroutine {s,d}org{2r,r2}( | ||
| subroutine {c,z}ung{2r,r2}( | ||
| integer m, | ||
| integer n, | ||
| integer k, | ||
| type(wp) a(lda,*), | ||
| integer lda, | ||
| type(wp) tau(*), | ||
| type(wp) work(*), | ||
| integer info | ||
| ) | ||
|
|
||
| #:def org2r_orgr2_ung2r_ungr2(NAME,pfxs) | ||
| #:set wp=pfxs[0] | ||
| #:if NAME.endswith('2r') | ||
| !> This routine generates an \(M \times N \) ${type(wp)}$ | ||
| !> matrix \( Q \) with orthonormal columns, | ||
| !> which is defined as the first \( N \) columns of a product of \( K \) elementary | ||
| !> reflectors of order \( M \). | ||
| !> \( Q = H(1) H(2) . . . H(k) \) | ||
| !> as returned by [[f77_geqrf:${wp}$geqrf]]. | ||
| #:elif NAME.endswith('r2') | ||
| !> This routine generates an \(M \times N \) ${type(wp)}$ | ||
| !> matrix \( Q \) with orthonormal rows, | ||
| !> which is defined as the last \( M \) rows of a product of \( K \) elementary | ||
| !> reflectors of order \( N \). | ||
| !> \( Q = H(1)^\dagger H(2)^\dagger \cdots H(k)^\dagger \) | ||
| !> as returned by [[f77_gerqf:${wp}$gerqf]]. | ||
| #:endif | ||
| pure subroutine ${NAME}$(m, n, k, a, lda, tau, work, info) | ||
| $:imports(pfxs) | ||
| @:args(${type(wp)}$, inout, a(lda,*)) | ||
| @:args(${type(wp)}$, out, work(*)) | ||
| @:args(${type(wp)}$, in, tau(*)) | ||
| @:args(integer, in, m, n, k, lda) | ||
| @:args(integer, out, info) | ||
| end subroutine | ||
| #:enddef | ||
| #:endmute |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,38 @@ | ||
| #:mute | ||
| subroutine {s,d}org{qr,rq}( | ||
| subroutine {c,z}ung{qr,rq}( | ||
| integer m, | ||
| integer n, | ||
| integer k, | ||
| type(wp) a(lda,*), | ||
| integer lda, | ||
| type(wp) tau(*), | ||
| type(wp) work(*), | ||
| integer lwork, | ||
| integer info | ||
| ) | ||
|
|
||
| #:def orgqr_orgrq_ungqr_ungrq(NAME,pfxs) | ||
| #:set wp=pfxs[0] | ||
| !> This routine generates an \(M \times N \) ${type(wp)}$ | ||
| !> matrix \( Q \) with orthonormal columns, | ||
| !> which is defined as the first \( N \) columns of a product of \( K \) elementary | ||
| #:if NAME.endswith('qr') | ||
| !> reflectors of order \( M \). | ||
| !> \( Q = H(1) H(2) . . . H(k) \) | ||
| !> as returned by [[f77_geqrf:${wp}$geqrf]]. | ||
| #:elif NAME.endswith('rq') | ||
| !> reflectors of order \( N \). | ||
| !> \( Q = H(1)^\dagger H(2)^\dagger . . . H(k)^\dagger \) | ||
| !> as returned by [[f77_gerqf:${wp}$gerqf]]. | ||
| #:endif | ||
| pure subroutine ${NAME}$(m, n, k, a, lda, tau, work, lwork, info) | ||
| $:imports(pfxs) | ||
| @:args(${type(wp)}$, inout, a(lda,*)) | ||
| @:args(${type(wp)}$, out, work(*)) | ||
| @:args(${type(wp)}$, in, tau(*)) | ||
| @:args(integer, in, m, n, k, lda, lwork) | ||
| @:args(integer, out, info) | ||
| end subroutine | ||
| #:enddef | ||
| #:endmute |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,48 @@ | ||
| #:mute | ||
| subroutine {s,d}orm{2r,r2} ( | ||
| subroutine {c,z}unm{2r,r2} ( | ||
| character side, | ||
| character trans, | ||
| integer m, | ||
| integer n, | ||
| integer k, | ||
| type(wp) a(lda,*), | ||
| integer lda, | ||
| type(wp) tau(*), | ||
| type(wp) c(ldc,*), | ||
| integer ldc, | ||
| type(wp) work(*), | ||
| integer info | ||
| ) | ||
|
|
||
| #:def orm2r_ormr2_unm2r_unmr2(NAME,pfxs) | ||
| #:set wp=pfxs[0] | ||
| !> This routine overwrites the general complex \(M \times N\) matrix \( C \) with | ||
| !>```fortran | ||
| !> SIDE = 'L' SIDE = 'R' | ||
| !> TRANS = 'N': Q * C C * Q | ||
| !> TRANS = 'C': Q**H * C C * Q**H | ||
| !>``` | ||
| !> where Q is a complex unitary matrix defined as the product of k | ||
| !> elementary reflectors | ||
| !> | ||
| #:if NAME.endswith('2r') | ||
| !> \( Q = H(1) H(2) \cdots H(k) \) | ||
| !> as returned by [[f77_geqrf:${wp}$geqrf]]. | ||
| #:elif NAME.endswith('r2') | ||
| !> \( Q = H(1)^\dagger H(2)^\dagger \cdots H(k)^\dagger \) | ||
| !> as returned by [[f77_gerqf:${wp}$gerqf]]. | ||
| #:endif | ||
| !> \( Q \) is of order \( M \) if `SIDE = 'L'` | ||
| !> and of order \( N \) if `SIDE = 'R'`. | ||
| pure subroutine ${NAME}$(side, trans, m, n, k, a, lda, tau, c, ldc, work, info) | ||
| $:imports(pfxs) | ||
| @:args(character, in, side, trans) | ||
| @:args(${type(wp)}$, inout, a(lda,*), c(ldc,*)) | ||
| @:args(${type(wp)}$, out, work(*)) | ||
| @:args(${type(wp)}$, in, tau(*)) | ||
| @:args(integer, in, m, n, k, lda, ldc) | ||
| @:args(integer, out, info) | ||
| end subroutine | ||
| #:enddef | ||
| #:endmute |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,49 @@ | ||
| #:mute | ||
| subroutine {s,d}orm{qr,rq} ( | ||
| subroutine {c,z}unm{qr,rq} ( | ||
| character side, | ||
| character trans, | ||
| integer m, | ||
| integer n, | ||
| integer k, | ||
| type(wp) a(lda,*), | ||
| integer lda, | ||
| type(wp) tau(*), | ||
| type(wp) c(ldc,*), | ||
| integer ldc, | ||
| type(wp) work(*), | ||
| integer lwork, | ||
| integer info | ||
| ) | ||
|
|
||
| #:def ormqr_ormrq_unmqr_unmrq(NAME,pfxs) | ||
| #:set wp=pfxs[0] | ||
| !> This routine overwrites the general complex \(M \times N\) matrix \( C \) with | ||
| !>```fortran | ||
| !> SIDE = 'L' SIDE = 'R' | ||
| !> TRANS = 'N': Q * C C * Q | ||
| !> TRANS = 'C': Q**H * C C * Q**H | ||
| !>``` | ||
| !> where Q is a complex unitary matrix defined as the product of k | ||
| !> elementary reflectors | ||
| !> | ||
| #:if NAME.endswith('qr') | ||
| !> \( Q = H(1) H(2) \cdots H(k) \) | ||
| !> as returned by [[f77_geqrf:${wp}$geqrf]]. | ||
| #:elif NAME.endswith('rq') | ||
| !> \( Q = H(1)^\dagger H(2)^\dagger \cdots H(k)^\dagger \) | ||
| !> as returned by [[f77_gerqf:${wp}$gerqf]]. | ||
| #:endif | ||
| !> \( Q \) is of order \( M \) if `SIDE = 'L'` | ||
| !> and of order \( N \) if `SIDE = 'R'`. | ||
| pure subroutine ${NAME}$(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info) | ||
| $:imports(pfxs) | ||
| @:args(character, in, side, trans) | ||
| @:args(${type(wp)}$, inout, a(lda,*), c(ldc,*)) | ||
| @:args(${type(wp)}$, out, work(*)) | ||
| @:args(${type(wp)}$, in, tau(*)) | ||
| @:args(integer, in, m, n, k, lda, ldc, lwork) | ||
| @:args(integer, out, info) | ||
| end subroutine | ||
| #:enddef | ||
| #:endmute |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters