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

◆ serrlqt()

subroutine serrlqt ( character*3  path,
integer  nunit 
)

SERRLQT

Purpose:
 DERRLQT tests the error exits for the DOUBLE PRECISION routines
 that use the LQT 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 serrlqt.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, sgelqt3, sgelqt,
81 $ sgemlqt
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 real
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. / real( i+j )
105 c( i, j ) = 1. / real( i+j )
106 t( i, j ) = 1. / real( i+j )
107 END DO
108 w( j ) = 0.
109 END DO
110 ok = .true.
111*
112* Error exits for LQT factorization
113*
114* SGELQT
115*
116 srnamt = 'SGELQT'
117 infot = 1
118 CALL sgelqt( -1, 0, 1, a, 1, t, 1, w, info )
119 CALL chkxer( 'SGELQT', infot, nout, lerr, ok )
120 infot = 2
121 CALL sgelqt( 0, -1, 1, a, 1, t, 1, w, info )
122 CALL chkxer( 'SGELQT', infot, nout, lerr, ok )
123 infot = 3
124 CALL sgelqt( 0, 0, 0, a, 1, t, 1, w, info )
125 CALL chkxer( 'SGELQT', infot, nout, lerr, ok )
126 infot = 5
127 CALL sgelqt( 2, 1, 1, a, 1, t, 1, w, info )
128 CALL chkxer( 'SGELQT', infot, nout, lerr, ok )
129 infot = 7
130 CALL sgelqt( 2, 2, 2, a, 2, t, 1, w, info )
131 CALL chkxer( 'SGELQT', infot, nout, lerr, ok )
132*
133* SGELQT3
134*
135 srnamt = 'SGELQT3'
136 infot = 1
137 CALL sgelqt3( -1, 0, a, 1, t, 1, info )
138 CALL chkxer( 'SGELQT3', infot, nout, lerr, ok )
139 infot = 2
140 CALL sgelqt3( 0, -1, a, 1, t, 1, info )
141 CALL chkxer( 'SGELQT3', infot, nout, lerr, ok )
142 infot = 4
143 CALL sgelqt3( 2, 2, a, 1, t, 1, info )
144 CALL chkxer( 'SGELQT3', infot, nout, lerr, ok )
145 infot = 6
146 CALL sgelqt3( 2, 2, a, 2, t, 1, info )
147 CALL chkxer( 'SGELQT3', infot, nout, lerr, ok )
148*
149* SGEMLQT
150*
151 srnamt = 'SGEMLQT'
152 infot = 1
153 CALL sgemlqt( '/', 'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
154 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
155 infot = 2
156 CALL sgemlqt( 'L', '/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
157 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
158 infot = 3
159 CALL sgemlqt( 'L', 'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
160 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
161 infot = 4
162 CALL sgemlqt( 'L', 'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
163 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
164 infot = 5
165 CALL sgemlqt( 'L', 'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
166 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
167 infot = 5
168 CALL sgemlqt( 'R', 'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
169 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
170 infot = 6
171 CALL sgemlqt( 'L', 'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
172 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
173 infot = 8
174 CALL sgemlqt( 'R', 'N', 2, 2, 2, 1, a, 1, t, 1, c, 1, w, info )
175 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
176 infot = 8
177 CALL sgemlqt( 'L', 'N', 2, 2, 2, 1, a, 1, t, 1, c, 1, w, info )
178 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
179 infot = 10
180 CALL sgemlqt( 'R', 'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
181 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
182 infot = 12
183 CALL sgemlqt( 'L', 'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
184 CALL chkxer( 'SGEMLQT', infot, nout, lerr, ok )
185*
186* Print a summary line.
187*
188 CALL alaesm( path, ok, nout )
189*
190 RETURN
191*
192* End of SERRLQT
193*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgelqt3
recursive subroutine sgelqt3(m, n, a, lda, t, ldt, info)
SGELQT3
Definition sgelqt3.f:116
sgelqt
subroutine sgelqt(m, n, mb, a, lda, t, ldt, work, info)
SGELQT
Definition sgelqt.f:124
sgemlqt
subroutine sgemlqt(side, trans, m, n, k, mb, v, ldv, t, ldt, c, ldc, work, info)
SGEMLQT
Definition sgemlqt.f:153
Here is the call graph for this function:
Here is the caller graph for this function: