LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ derrtsqr()

subroutine derrtsqr ( character*3  PATH,
integer  NUNIT 
)

DERRTSQR

Purpose:
 DERRTSQR tests the error exits for the DOUBLE PRECISION routines
 that use the TSQR 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.
Date
December 2016

Definition at line 57 of file derrtsqr.f.

57  IMPLICIT NONE
58 *
59 * -- LAPACK test routine (version 3.7.0) --
60 * -- LAPACK is a software package provided by Univ. of Tennessee, --
61 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
62 * December 2016
63 *
64 * .. Scalar Arguments ..
65  CHARACTER*3 PATH
66  INTEGER NUNIT
67 * ..
68 *
69 * =====================================================================
70 *
71 * .. Parameters ..
72  INTEGER NMAX
73  parameter( nmax = 2 )
74 * ..
75 * .. Local Scalars ..
76  INTEGER I, INFO, J, NB
77 * ..
78 * .. Local Arrays ..
79  DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
80  $ C( NMAX, NMAX ), TAU(NMAX)
81 * ..
82 * .. External Subroutines ..
83  EXTERNAL alaesm, chkxer, dgeqr,
84  $ dgemqr, dgelq, dgemlq
85 * ..
86 * .. Scalars in Common ..
87  LOGICAL LERR, OK
88  CHARACTER*32 SRNAMT
89  INTEGER INFOT, NOUT
90 * ..
91 * .. Common blocks ..
92  COMMON / infoc / infot, nout, ok, lerr
93  COMMON / srnamc / srnamt
94 * ..
95 * .. Intrinsic Functions ..
96  INTRINSIC dble
97 * ..
98 * .. Executable Statements ..
99 *
100  nout = nunit
101  WRITE( nout, fmt = * )
102 *
103 * Set the variables to innocuous values.
104 *
105  DO j = 1, nmax
106  DO i = 1, nmax
107  a( i, j ) = 1.d0 / dble( i+j )
108  c( i, j ) = 1.d0 / dble( i+j )
109  t( i, j ) = 1.d0 / dble( i+j )
110  END DO
111  w( j ) = 0.d0
112  END DO
113  ok = .true.
114 *
115 * Error exits for TS factorization
116 *
117 * DGEQR
118 *
119  srnamt = 'DGEQR'
120  infot = 1
121  CALL dgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
122  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
123  infot = 2
124  CALL dgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
125  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
126  infot = 4
127  CALL dgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
128  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
129  infot = 6
130  CALL dgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
131  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
132  infot = 8
133  CALL dgeqr( 3, 2, a, 3, tau, 7, w, 0, info )
134  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
135 *
136 * DGEMQR
137 *
138  tau(1)=1
139  tau(2)=1
140  srnamt = 'DGEMQR'
141  nb=1
142  infot = 1
143  CALL dgemqr( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
144  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
145  infot = 2
146  CALL dgemqr( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
147  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
148  infot = 3
149  CALL dgemqr( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
150  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
151  infot = 4
152  CALL dgemqr( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
153  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
154  infot = 5
155  CALL dgemqr( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
156  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
157  infot = 5
158  CALL dgemqr( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
159  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
160  infot = 7
161  CALL dgemqr( 'L', 'N', 2, 1, 0, a, 0, tau, 1, c, 1, w, 1,info)
162  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
163  infot = 9
164  CALL dgemqr( 'R', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
165  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
166  infot = 9
167  CALL dgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
168  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
169  infot = 11
170  CALL dgemqr( 'L', 'N', 2, 1, 1, a, 2, tau, 6, c, 0, w, 1,info)
171  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
172  infot = 13
173  CALL dgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
174  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
175 *
176 * DGELQ
177 *
178  srnamt = 'DGELQ'
179  infot = 1
180  CALL dgelq( -1, 0, a, 1, tau, 1, w, 1, info )
181  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
182  infot = 2
183  CALL dgelq( 0, -1, a, 1, tau, 1, w, 1, info )
184  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
185  infot = 4
186  CALL dgelq( 1, 1, a, 0, tau, 1, w, 1, info )
187  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
188  infot = 6
189  CALL dgelq( 2, 3, a, 3, tau, 1, w, 1, info )
190  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
191  infot = 8
192  CALL dgelq( 2, 3, a, 3, tau, 7, w, 0, info )
193  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
194 *
195 * DGEMLQ
196 *
197  tau(1)=1
198  tau(2)=1
199  srnamt = 'DGEMLQ'
200  nb=1
201  infot = 1
202  CALL dgemlq( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
203  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
204  infot = 2
205  CALL dgemlq( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
206  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
207  infot = 3
208  CALL dgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
209  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
210  infot = 4
211  CALL dgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
212  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
213  infot = 5
214  CALL dgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
215  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
216  infot = 5
217  CALL dgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
218  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
219  infot = 7
220  CALL dgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
221  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
222  infot = 9
223  CALL dgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
224  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
225  infot = 9
226  CALL dgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
227  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
228  infot = 11
229  CALL dgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
230  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
231  infot = 13
232  CALL dgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
233  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
234 *
235 * Print a summary line.
236 *
237  CALL alaesm( path, ok, nout )
238 *
239  RETURN
240 *
241 * End of DERRTSQR
242 *
Here is the call graph for this function:
Here is the caller graph for this function:
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
dgemqr
subroutine dgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
DGEMQR
Definition: dgemqr.f:172
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dgelq
subroutine dgelq(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
DGELQ
Definition: dgelq.f:172
dgeqr
subroutine dgeqr(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
DGEQR
Definition: dgeqr.f:174
dgemlq
subroutine dgemlq(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
DGEMLQ
Definition: dgemlq.f:171