55 IMPLICIT NONE
56
57
58
59
60
61
62 CHARACTER*3 PATH
63 INTEGER NUNIT
64
65
66
67
68
69 INTEGER NMAX
70 parameter( nmax = 2 )
71
72
73 INTEGER I, INFO, J
74
75
76 COMPLEX*16 A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77 $ C( NMAX, NMAX )
78
79
82
83
84 LOGICAL LERR, OK
85 CHARACTER*32 SRNAMT
86 INTEGER INFOT, NOUT
87
88
89 COMMON / infoc / infot, nout, ok, lerr
90 COMMON / srnamc / srnamt
91
92
93 INTRINSIC dble, dcmplx
94
95
96
97 nout = nunit
98 WRITE( nout, fmt = * )
99
100
101
102 DO j = 1, nmax
103 DO i = 1, nmax
104 a( i, j ) = 1.d0 / dcmplx( dble( i+j ), 0.d0 )
105 c( i, j ) = 1.d0 / dcmplx( dble( i+j ), 0.d0 )
106 t( i, j ) = 1.d0 / dcmplx( dble( i+j ), 0.d0 )
107 END DO
108 w( j ) = 0.d0
109 END DO
110 ok = .true.
111
112
113
114
115
116 srnamt = 'ZGELQT'
117 infot = 1
118 CALL zgelqt( -1, 0, 1, a, 1, t, 1, w, info )
119 CALL chkxer(
'ZGELQT', infot, nout, lerr, ok )
120 infot = 2
121 CALL zgelqt( 0, -1, 1, a, 1, t, 1, w, info )
122 CALL chkxer(
'ZGELQT', infot, nout, lerr, ok )
123 infot = 3
124 CALL zgelqt( 0, 0, 0, a, 1, t, 1, w, info )
125 CALL chkxer(
'ZGELQT', infot, nout, lerr, ok )
126 infot = 5
127 CALL zgelqt( 2, 1, 1, a, 1, t, 1, w, info )
128 CALL chkxer(
'ZGELQT', infot, nout, lerr, ok )
129 infot = 7
130 CALL zgelqt( 2, 2, 2, a, 2, t, 1, w, info )
131 CALL chkxer(
'ZGELQT', infot, nout, lerr, ok )
132
133
134
135 srnamt = 'ZGELQT3'
136 infot = 1
137 CALL zgelqt3( -1, 0, a, 1, t, 1, info )
138 CALL chkxer(
'ZGELQT3', infot, nout, lerr, ok )
139 infot = 2
140 CALL zgelqt3( 0, -1, a, 1, t, 1, info )
141 CALL chkxer(
'ZGELQT3', infot, nout, lerr, ok )
142 infot = 4
143 CALL zgelqt3( 2, 2, a, 1, t, 1, info )
144 CALL chkxer(
'ZGELQT3', infot, nout, lerr, ok )
145 infot = 6
146 CALL zgelqt3( 2, 2, a, 2, t, 1, info )
147 CALL chkxer(
'ZGELQT3', infot, nout, lerr, ok )
148
149
150
151 srnamt = 'ZGEMLQT'
152 infot = 1
153 CALL zgemlqt(
'/',
'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
154 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
155 infot = 2
156 CALL zgemlqt(
'L',
'/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
157 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
158 infot = 3
159 CALL zgemlqt(
'L',
'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
160 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
161 infot = 4
162 CALL zgemlqt(
'L',
'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
163 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
164 infot = 5
165 CALL zgemlqt(
'L',
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
166 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
167 infot = 5
168 CALL zgemlqt(
'R',
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
169 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
170 infot = 6
171 CALL zgemlqt(
'L',
'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
172 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
173 infot = 8
174 CALL zgemlqt(
'R',
'N', 2, 2, 2, 1, a, 1, t, 1, c, 1, w, info )
175 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
176 infot = 8
177 CALL zgemlqt(
'L',
'N', 2, 2, 2, 1, a, 1, t, 1, c, 1, w, info )
178 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
179 infot = 10
180 CALL zgemlqt(
'R',
'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
181 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
182 infot = 12
183 CALL zgemlqt(
'L',
'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
184 CALL chkxer(
'ZGEMLQT', infot, nout, lerr, ok )
185
186
187
188 CALL alaesm( path, ok, nout )
189
190 RETURN
191
192
193
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
recursive subroutine zgelqt3(m, n, a, lda, t, ldt, info)
ZGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact...
subroutine zgelqt(m, n, mb, a, lda, t, ldt, work, info)
ZGELQT
subroutine zgemlqt(side, trans, m, n, k, mb, v, ldv, t, ldt, c, ldc, work, info)
ZGEMLQT