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 = 'ZGEQRT'
117 infot = 1
118 CALL zgeqrt( -1, 0, 1, a, 1, t, 1, w, info )
119 CALL chkxer(
'ZGEQRT', infot, nout, lerr, ok )
120 infot = 2
121 CALL zgeqrt( 0, -1, 1, a, 1, t, 1, w, info )
122 CALL chkxer(
'ZGEQRT', infot, nout, lerr, ok )
123 infot = 3
124 CALL zgeqrt( 0, 0, 0, a, 1, t, 1, w, info )
125 CALL chkxer(
'ZGEQRT', infot, nout, lerr, ok )
126 infot = 5
127 CALL zgeqrt( 2, 1, 1, a, 1, t, 1, w, info )
128 CALL chkxer(
'ZGEQRT', infot, nout, lerr, ok )
129 infot = 7
130 CALL zgeqrt( 2, 2, 2, a, 2, t, 1, w, info )
131 CALL chkxer(
'ZGEQRT', infot, nout, lerr, ok )
132
133
134
135 srnamt = 'ZGEQRT2'
136 infot = 1
137 CALL zgeqrt2( -1, 0, a, 1, t, 1, info )
138 CALL chkxer(
'ZGEQRT2', infot, nout, lerr, ok )
139 infot = 2
140 CALL zgeqrt2( 0, -1, a, 1, t, 1, info )
141 CALL chkxer(
'ZGEQRT2', infot, nout, lerr, ok )
142 infot = 4
143 CALL zgeqrt2( 2, 1, a, 1, t, 1, info )
144 CALL chkxer(
'ZGEQRT2', infot, nout, lerr, ok )
145 infot = 6
146 CALL zgeqrt2( 2, 2, a, 2, t, 1, info )
147 CALL chkxer(
'ZGEQRT2', infot, nout, lerr, ok )
148
149
150
151 srnamt = 'ZGEQRT3'
152 infot = 1
153 CALL zgeqrt3( -1, 0, a, 1, t, 1, info )
154 CALL chkxer(
'ZGEQRT3', infot, nout, lerr, ok )
155 infot = 2
156 CALL zgeqrt3( 0, -1, a, 1, t, 1, info )
157 CALL chkxer(
'ZGEQRT3', infot, nout, lerr, ok )
158 infot = 4
159 CALL zgeqrt3( 2, 1, a, 1, t, 1, info )
160 CALL chkxer(
'ZGEQRT3', infot, nout, lerr, ok )
161 infot = 6
162 CALL zgeqrt3( 2, 2, a, 2, t, 1, info )
163 CALL chkxer(
'ZGEQRT3', infot, nout, lerr, ok )
164
165
166
167 srnamt = 'ZGEMQRT'
168 infot = 1
169 CALL zgemqrt(
'/',
'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
170 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
171 infot = 2
172 CALL zgemqrt(
'L',
'/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
173 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
174 infot = 3
175 CALL zgemqrt(
'L',
'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
176 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
177 infot = 4
178 CALL zgemqrt(
'L',
'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
179 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
180 infot = 5
181 CALL zgemqrt(
'L',
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
182 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
183 infot = 5
184 CALL zgemqrt(
'R',
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
185 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
186 infot = 6
187 CALL zgemqrt(
'L',
'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
188 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
189 infot = 8
190 CALL zgemqrt(
'R',
'N', 1, 2, 1, 1, a, 1, t, 1, c, 1, w, info )
191 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
192 infot = 8
193 CALL zgemqrt(
'L',
'N', 2, 1, 1, 1, a, 1, t, 1, c, 1, w, info )
194 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
195 infot = 10
196 CALL zgemqrt(
'R',
'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
197 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
198 infot = 12
199 CALL zgemqrt(
'L',
'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
200 CALL chkxer(
'ZGEMQRT', infot, nout, lerr, ok )
201
202
203
204 CALL alaesm( path, ok, nout )
205
206 RETURN
207
208
209
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
ZGEMQRT
subroutine zgeqrt(M, N, NB, A, LDA, T, LDT, WORK, INFO)
ZGEQRT
subroutine zgeqrt2(M, N, A, LDA, T, LDT, INFO)
ZGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY represen...
recursive subroutine zgeqrt3(M, N, A, LDA, T, LDT, INFO)
ZGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact...