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 DOUBLE PRECISION 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
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 / 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
113
114
115
116 srnamt = 'DGEQRT'
117 infot = 1
118 CALL dgeqrt( -1, 0, 1, a, 1, t, 1, w, info )
119 CALL chkxer(
'DGEQRT', infot, nout, lerr, ok )
120 infot = 2
121 CALL dgeqrt( 0, -1, 1, a, 1, t, 1, w, info )
122 CALL chkxer(
'DGEQRT', infot, nout, lerr, ok )
123 infot = 3
124 CALL dgeqrt( 0, 0, 0, a, 1, t, 1, w, info )
125 CALL chkxer(
'DGEQRT', infot, nout, lerr, ok )
126 infot = 5
127 CALL dgeqrt( 2, 1, 1, a, 1, t, 1, w, info )
128 CALL chkxer(
'DGEQRT', infot, nout, lerr, ok )
129 infot = 7
130 CALL dgeqrt( 2, 2, 2, a, 2, t, 1, w, info )
131 CALL chkxer(
'DGEQRT', infot, nout, lerr, ok )
132
133
134
135 srnamt = 'DGEQRT2'
136 infot = 1
137 CALL dgeqrt2( -1, 0, a, 1, t, 1, info )
138 CALL chkxer(
'DGEQRT2', infot, nout, lerr, ok )
139 infot = 2
140 CALL dgeqrt2( 0, -1, a, 1, t, 1, info )
141 CALL chkxer(
'DGEQRT2', infot, nout, lerr, ok )
142 infot = 4
143 CALL dgeqrt2( 2, 1, a, 1, t, 1, info )
144 CALL chkxer(
'DGEQRT2', infot, nout, lerr, ok )
145 infot = 6
146 CALL dgeqrt2( 2, 2, a, 2, t, 1, info )
147 CALL chkxer(
'DGEQRT2', infot, nout, lerr, ok )
148
149
150
151 srnamt = 'DGEQRT3'
152 infot = 1
153 CALL dgeqrt3( -1, 0, a, 1, t, 1, info )
154 CALL chkxer(
'DGEQRT3', infot, nout, lerr, ok )
155 infot = 2
156 CALL dgeqrt3( 0, -1, a, 1, t, 1, info )
157 CALL chkxer(
'DGEQRT3', infot, nout, lerr, ok )
158 infot = 4
159 CALL dgeqrt3( 2, 1, a, 1, t, 1, info )
160 CALL chkxer(
'DGEQRT3', infot, nout, lerr, ok )
161 infot = 6
162 CALL dgeqrt3( 2, 2, a, 2, t, 1, info )
163 CALL chkxer(
'DGEQRT3', infot, nout, lerr, ok )
164
165
166
167 srnamt = 'DGEMQRT'
168 infot = 1
169 CALL dgemqrt(
'/',
'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
170 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
171 infot = 2
172 CALL dgemqrt(
'L',
'/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
173 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
174 infot = 3
175 CALL dgemqrt(
'L',
'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
176 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
177 infot = 4
178 CALL dgemqrt(
'L',
'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
179 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
180 infot = 5
181 CALL dgemqrt(
'L',
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
182 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
183 infot = 5
184 CALL dgemqrt(
'R',
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
185 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
186 infot = 6
187 CALL dgemqrt(
'L',
'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
188 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
189 infot = 8
190 CALL dgemqrt(
'R',
'N', 1, 2, 1, 1, a, 1, t, 1, c, 1, w, info )
191 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
192 infot = 8
193 CALL dgemqrt(
'L',
'N', 2, 1, 1, 1, a, 1, t, 1, c, 1, w, info )
194 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
195 infot = 10
196 CALL dgemqrt(
'R',
'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
197 CALL chkxer(
'DGEMQRT', infot, nout, lerr, ok )
198 infot = 12
199 CALL dgemqrt(
'L',
'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
200 CALL chkxer(
'DGEMQRT', 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
recursive subroutine dgeqrt3(M, N, A, LDA, T, LDT, INFO)
DGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact...
subroutine dgeqrt(M, N, NB, A, LDA, T, LDT, WORK, INFO)
DGEQRT
subroutine dgeqrt2(M, N, A, LDA, T, LDT, INFO)
DGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY represen...
subroutine dgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
DGEMQRT