LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ serrqrt()

subroutine serrqrt ( character*3  path,
integer  nunit 
)

SERRQRT

Purpose:
 SERRQRT tests the error exits for the REAL routines
 that use the QRT decomposition of a general matrix.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file serrqrt.f.

55 IMPLICIT NONE
56*
57* -- LAPACK test routine --
58* -- LAPACK is a software package provided by Univ. of Tennessee, --
59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60*
61* .. Scalar Arguments ..
62 CHARACTER*3 PATH
63 INTEGER NUNIT
64* ..
65*
66* =====================================================================
67*
68* .. Parameters ..
69 INTEGER NMAX
70 parameter( nmax = 2 )
71* ..
72* .. Local Scalars ..
73 INTEGER I, INFO, J
74* ..
75* .. Local Arrays ..
76 REAL A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77 $ C( NMAX, NMAX )
78* ..
79* .. External Subroutines ..
80 EXTERNAL alaesm, chkxer, sgeqrt2, sgeqrt3, sgeqrt,
81 $ sgemqrt
82* ..
83* .. Scalars in Common ..
84 LOGICAL LERR, OK
85 CHARACTER*32 SRNAMT
86 INTEGER INFOT, NOUT
87* ..
88* .. Common blocks ..
89 COMMON / infoc / infot, nout, ok, lerr
90 COMMON / srnamc / srnamt
91* ..
92* .. Intrinsic Functions ..
93 INTRINSIC float
94* ..
95* .. Executable Statements ..
96*
97 nout = nunit
98 WRITE( nout, fmt = * )
99*
100* Set the variables to innocuous values.
101*
102 DO j = 1, nmax
103 DO i = 1, nmax
104 a( i, j ) = 1.0 / float( i+j )
105 c( i, j ) = 1.0 / float( i+j )
106 t( i, j ) = 1.0 / float( i+j )
107 END DO
108 w( j ) = 0.0
109 END DO
110 ok = .true.
111*
112* Error exits for QRT factorization
113*
114* SGEQRT
115*
116 srnamt = 'SGEQRT'
117 infot = 1
118 CALL sgeqrt( -1, 0, 1, a, 1, t, 1, w, info )
119 CALL chkxer( 'SGEQRT', infot, nout, lerr, ok )
120 infot = 2
121 CALL sgeqrt( 0, -1, 1, a, 1, t, 1, w, info )
122 CALL chkxer( 'SGEQRT', infot, nout, lerr, ok )
123 infot = 3
124 CALL sgeqrt( 0, 0, 0, a, 1, t, 1, w, info )
125 CALL chkxer( 'SGEQRT', infot, nout, lerr, ok )
126 infot = 5
127 CALL sgeqrt( 2, 1, 1, a, 1, t, 1, w, info )
128 CALL chkxer( 'SGEQRT', infot, nout, lerr, ok )
129 infot = 7
130 CALL sgeqrt( 2, 2, 2, a, 2, t, 1, w, info )
131 CALL chkxer( 'SGEQRT', infot, nout, lerr, ok )
132*
133* SGEQRT2
134*
135 srnamt = 'SGEQRT2'
136 infot = 1
137 CALL sgeqrt2( -1, 0, a, 1, t, 1, info )
138 CALL chkxer( 'SGEQRT2', infot, nout, lerr, ok )
139 infot = 2
140 CALL sgeqrt2( 0, -1, a, 1, t, 1, info )
141 CALL chkxer( 'SGEQRT2', infot, nout, lerr, ok )
142 infot = 4
143 CALL sgeqrt2( 2, 1, a, 1, t, 1, info )
144 CALL chkxer( 'SGEQRT2', infot, nout, lerr, ok )
145 infot = 6
146 CALL sgeqrt2( 2, 2, a, 2, t, 1, info )
147 CALL chkxer( 'SGEQRT2', infot, nout, lerr, ok )
148*
149* SGEQRT3
150*
151 srnamt = 'SGEQRT3'
152 infot = 1
153 CALL sgeqrt3( -1, 0, a, 1, t, 1, info )
154 CALL chkxer( 'SGEQRT3', infot, nout, lerr, ok )
155 infot = 2
156 CALL sgeqrt3( 0, -1, a, 1, t, 1, info )
157 CALL chkxer( 'SGEQRT3', infot, nout, lerr, ok )
158 infot = 4
159 CALL sgeqrt3( 2, 1, a, 1, t, 1, info )
160 CALL chkxer( 'SGEQRT3', infot, nout, lerr, ok )
161 infot = 6
162 CALL sgeqrt3( 2, 2, a, 2, t, 1, info )
163 CALL chkxer( 'SGEQRT3', infot, nout, lerr, ok )
164*
165* SGEMQRT
166*
167 srnamt = 'SGEMQRT'
168 infot = 1
169 CALL sgemqrt( '/', 'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
170 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
171 infot = 2
172 CALL sgemqrt( 'L', '/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
173 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
174 infot = 3
175 CALL sgemqrt( 'L', 'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
176 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
177 infot = 4
178 CALL sgemqrt( 'L', 'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
179 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
180 infot = 5
181 CALL sgemqrt( 'L', 'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
182 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
183 infot = 5
184 CALL sgemqrt( 'R', 'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
185 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
186 infot = 6
187 CALL sgemqrt( 'L', 'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
188 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
189 infot = 8
190 CALL sgemqrt( 'R', 'N', 1, 2, 1, 1, a, 1, t, 1, c, 1, w, info )
191 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
192 infot = 8
193 CALL sgemqrt( 'L', 'N', 2, 1, 1, 1, a, 1, t, 1, c, 1, w, info )
194 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
195 infot = 10
196 CALL sgemqrt( 'R', 'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
197 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
198 infot = 12
199 CALL sgemqrt( 'L', 'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
200 CALL chkxer( 'SGEMQRT', infot, nout, lerr, ok )
201*
202* Print a summary line.
203*
204 CALL alaesm( path, ok, nout )
205*
206 RETURN
207*
208* End of SERRQRT
209*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgemqrt
subroutine sgemqrt(side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work, info)
SGEMQRT
Definition sgemqrt.f:168
sgeqrt2
subroutine sgeqrt2(m, n, a, lda, t, ldt, info)
SGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY represen...
Definition sgeqrt2.f:127
sgeqrt3
recursive subroutine sgeqrt3(m, n, a, lda, t, ldt, info)
SGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact...
Definition sgeqrt3.f:132
sgeqrt
subroutine sgeqrt(m, n, nb, a, lda, t, ldt, work, info)
SGEQRT
Definition sgeqrt.f:141
Here is the call graph for this function:
Here is the caller graph for this function: