LAPACK  3.10.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.

Definition at line 54 of file derrtsqr.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, NB
74 * ..
75 * .. Local Arrays ..
76  DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77  $ C( NMAX, NMAX ), TAU(NMAX*2)
78 * ..
79 * .. External Subroutines ..
80  EXTERNAL alaesm, chkxer, dgeqr,
81  $ dgemqr, dgelq, dgemlq
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 dble
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.d0 / dble( i+j )
105  c( i, j ) = 1.d0 / dble( i+j )
106  t( i, j ) = 1.d0 / dble( i+j )
107  END DO
108  w( j ) = 0.d0
109  END DO
110  ok = .true.
111 *
112 * Error exits for TS factorization
113 *
114 * DGEQR
115 *
116  srnamt = 'DGEQR'
117  infot = 1
118  CALL dgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
119  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
120  infot = 2
121  CALL dgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
122  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
123  infot = 4
124  CALL dgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
125  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
126  infot = 6
127  CALL dgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
128  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
129  infot = 8
130  CALL dgeqr( 3, 2, a, 3, tau, 7, w, 0, info )
131  CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
132 *
133 * DGEMQR
134 *
135  tau(1)=1
136  tau(2)=1
137  tau(3)=1
138  tau(4)=1
139  srnamt = 'DGEMQR'
140  nb=1
141  infot = 1
142  CALL dgemqr( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
143  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
144  infot = 2
145  CALL dgemqr( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
146  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
147  infot = 3
148  CALL dgemqr( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
149  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
150  infot = 4
151  CALL dgemqr( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
152  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
153  infot = 5
154  CALL dgemqr( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
155  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
156  infot = 5
157  CALL dgemqr( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
158  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
159  infot = 7
160  CALL dgemqr( 'L', 'N', 2, 1, 0, a, 0, tau, 1, c, 1, w, 1,info)
161  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
162  infot = 9
163  CALL dgemqr( 'R', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
164  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
165  infot = 9
166  CALL dgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
167  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
168  infot = 11
169  CALL dgemqr( 'L', 'N', 2, 1, 1, a, 2, tau, 6, c, 0, w, 1,info)
170  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
171  infot = 13
172  CALL dgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
173  CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
174 *
175 * DGELQ
176 *
177  srnamt = 'DGELQ'
178  infot = 1
179  CALL dgelq( -1, 0, a, 1, tau, 1, w, 1, info )
180  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
181  infot = 2
182  CALL dgelq( 0, -1, a, 1, tau, 1, w, 1, info )
183  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
184  infot = 4
185  CALL dgelq( 1, 1, a, 0, tau, 1, w, 1, info )
186  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
187  infot = 6
188  CALL dgelq( 2, 3, a, 3, tau, 1, w, 1, info )
189  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
190  infot = 8
191  CALL dgelq( 2, 3, a, 3, tau, 7, w, 0, info )
192  CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
193 *
194 * DGEMLQ
195 *
196  tau(1)=1
197  tau(2)=1
198  srnamt = 'DGEMLQ'
199  nb=1
200  infot = 1
201  CALL dgemlq( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
202  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
203  infot = 2
204  CALL dgemlq( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
205  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
206  infot = 3
207  CALL dgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
208  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
209  infot = 4
210  CALL dgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
211  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
212  infot = 5
213  CALL dgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
214  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
215  infot = 5
216  CALL dgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
217  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
218  infot = 7
219  CALL dgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
220  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
221  infot = 9
222  CALL dgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
223  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
224  infot = 9
225  CALL dgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
226  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
227  infot = 11
228  CALL dgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
229  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
230  infot = 13
231  CALL dgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
232  CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
233 *
234 * Print a summary line.
235 *
236  CALL alaesm( path, ok, nout )
237 *
238  RETURN
239 *
240 * End of DERRTSQR
241 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
dgelq
subroutine dgelq(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
DGELQ
Definition: dgelq.f:172
dgemlq
subroutine dgemlq(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
DGEMLQ
Definition: dgemlq.f:171
dgemqr
subroutine dgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
DGEMQR
Definition: dgemqr.f:172
dgeqr
subroutine dgeqr(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
DGEQR
Definition: dgeqr.f:174
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
Here is the call graph for this function:
Here is the caller graph for this function: