66 DOUBLE PRECISION ALPHA, BETA
70 COMPLEX*16 A( 1, 1), B( 1, 1)
86 COMMON / infoc / infot, nout, ok, lerr
87 COMMON / srnamc / srnamt
93 a( 1, 1 ) = dcmplx( 1.0d0 , 1.0d0 )
94 b( 1, 1 ) = dcmplx( 1.0d0 , 1.0d0 )
96 calpha = dcmplx( 1.0d0 , 1.0d0 )
101 CALL zpftrf(
'/',
'U', 0, a, info )
102 CALL chkxer(
'ZPFTRF', infot, nout, lerr, ok )
104 CALL zpftrf(
'N',
'/', 0, a, info )
105 CALL chkxer(
'ZPFTRF', infot, nout, lerr, ok )
107 CALL zpftrf(
'N',
'U', -1, a, info )
108 CALL chkxer(
'ZPFTRF', infot, nout, lerr, ok )
112 CALL zpftrs(
'/',
'U', 0, 0, a, b, 1, info )
113 CALL chkxer(
'ZPFTRS', infot, nout, lerr, ok )
115 CALL zpftrs(
'N',
'/', 0, 0, a, b, 1, info )
116 CALL chkxer(
'ZPFTRS', infot, nout, lerr, ok )
118 CALL zpftrs(
'N',
'U', -1, 0, a, b, 1, info )
119 CALL chkxer(
'ZPFTRS', infot, nout, lerr, ok )
121 CALL zpftrs(
'N',
'U', 0, -1, a, b, 1, info )
122 CALL chkxer(
'ZPFTRS', infot, nout, lerr, ok )
124 CALL zpftrs(
'N',
'U', 0, 0, a, b, 0, info )
125 CALL chkxer(
'ZPFTRS', infot, nout, lerr, ok )
129 CALL ZPFTRI( '/
', 'u
', 0, A, INFO )
130 CALL CHKXER( 'zpftri', INFOT, NOUT, LERR, OK )
132 CALL ZPFTRI( 'n
', '/
', 0, A, INFO )
133 CALL CHKXER( 'zpftri', INFOT, NOUT, LERR, OK )
135 CALL ZPFTRI( 'n
', 'u
', -1, A, INFO )
136 CALL CHKXER( 'zpftri', INFOT, NOUT, LERR, OK )
140 CALL ZTFSM( '/
', 'l
', 'u
', 'c
', 'u
', 0, 0, CALPHA, A, B, 1 )
141 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
143 CALL ZTFSM( 'n
', '/
', 'u
', 'c
', 'u
', 0, 0, CALPHA, A, B, 1 )
144 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
146 CALL ZTFSM( 'n
', 'l
', '/
', 'c
', 'u
', 0, 0, CALPHA, A, B, 1 )
147 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
149 CALL ZTFSM( 'n
', 'l
', 'u
', '/
', 'u
', 0, 0, CALPHA, A, B, 1 )
150 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
152 CALL ZTFSM( 'n
', 'l
', 'u
', 'c
', '/
', 0, 0, CALPHA, A, B, 1 )
153 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
155 CALL ZTFSM( 'n
', 'l
', 'u
', 'c
', 'u
', -1, 0, CALPHA, A, B, 1 )
156 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
158 CALL ZTFSM( 'n
', 'l
', 'u
', 'c
', 'u
', 0, -1, CALPHA, A, B, 1 )
159 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
161 CALL ZTFSM( 'n
', 'l
', 'u
', 'c
', 'u
', 0, 0, CALPHA, A, B, 0 )
162 CALL CHKXER( 'ztfsm ', INFOT, NOUT, LERR, OK )
166 CALL ZTFTRI( '/
', 'l
', 'n
', 0, A, INFO )
167 CALL CHKXER( 'ztftri', INFOT, NOUT, LERR, OK )
169 CALL ZTFTRI( 'n
', '/
', 'n
', 0, A, INFO )
170 CALL CHKXER( 'ztftri', INFOT, NOUT, LERR, OK )
172 CALL ZTFTRI( 'n
', 'l
', '/', 0, a, info )
173 CALL chkxer(
'ZTFTRI', infot, nout, lerr, ok )
175 CALL ztftri( 'n
', 'l
', 'n
', -1, A, INFO )
176 CALL CHKXER( 'ztftri', INFOT, NOUT, LERR, OK )
180 CALL ZTFTTR( '/
', 'u
', 0, A, B, 1, INFO )
181 CALL CHKXER( 'ztfttr', INFOT, NOUT, LERR, OK )
183 CALL ZTFTTR( 'n
', '/
', 0, A, B, 1, INFO )
184 CALL CHKXER( 'ztfttr', INFOT, NOUT, LERR, OK )
186 CALL ZTFTTR( 'n
', 'u
', -1, A, B, 1, INFO )
187 CALL CHKXER( 'ztfttr', INFOT, NOUT, LERR, OK )
189 CALL ZTFTTR( 'n
', 'u
', 0, A, B, 0, INFO )
190 CALL CHKXER( 'ztfttr', INFOT, NOUT, LERR, OK )
194 CALL ZTRTTF( '/
', 'u
', 0, A, 1, B, INFO )
195 CALL CHKXER( 'ztrttf', INFOT, NOUT, LERR, OK )
197 CALL ZTRTTF( 'n
', '/
', 0, A, 1, B, INFO )
198 CALL CHKXER( 'ztrttf', INFOT, NOUT, LERR, OK )
200 CALL ZTRTTF( 'n
', 'u
', -1, A, 1, B, INFO )
201 CALL CHKXER( 'ztrttf', INFOT, NOUT, LERR, OK )
203 CALL ZTRTTF( 'n
', 'u
', 0, A, 0, B, INFO )
204 CALL CHKXER( 'ztrttf', INFOT, NOUT, LERR, OK )
208 CALL ZTFTTP( '/
', 'u
', 0, A, B, INFO )
209 CALL CHKXER( 'ztfttp', INFOT, NOUT, LERR, OK )
211 CALL ZTFTTP( 'n
', '/
', 0, A, B, INFO )
212 CALL CHKXER( 'ztfttp', INFOT, NOUT, LERR, OK )
214 CALL ZTFTTP( 'n
', 'u
', -1, A, B, INFO )
215 CALL CHKXER( 'ztfttp', infot, nout, lerr, ok )
219 CALL ztpttf(
'/',
'U', 0, a, b, info )
220 CALL chkxer(
'ZTPTTF', infot, nout, lerr, ok )
222 CALL ztpttf(
'N',
'/', 0, a, b, info )
223 CALL chkxer(
'ZTPTTF', infot, nout, lerr, ok )
225 CALL ztpttf( 'n
', 'u
', -1, A, B, INFO )
226 CALL CHKXER( 'ztpttf', INFOT, NOUT, LERR, OK )
230 CALL ZTRTTP( '/
', 0, A, 1, B, INFO )
231 CALL CHKXER( 'ztrttp', INFOT, NOUT, LERR, OK )
233 CALL ZTRTTP( 'u
', -1, A, 1, B, INFO )
234 CALL CHKXER( 'ztrttp', INFOT, NOUT, LERR, OK )
236 CALL ZTRTTP( 'u
', 0, A, 0, B, INFO )
237 CALL CHKXER( 'ztrttp', INFOT, NOUT, LERR, OK )
241 CALL ZTPTTR( '/
', 0, A, B, 1, INFO )
242 CALL CHKXER( 'ztpttr', INFOT, NOUT, LERR, OK )
244 CALL ZTPTTR( 'u
', -1, A, B, 1, INFO )
245 CALL CHKXER( 'ztpttr', INFOT, NOUT, LERR, OK )
247 CALL ZTPTTR( 'u
', 0, A, B, 0, INFO )
248 CALL CHKXER( 'ztpttr', INFOT, NOUT, LERR, OK )
252 CALL ZHFRK( '/
', 'u
', 'n
', 0, 0, ALPHA, A, 1, BETA, B )
253 CALL CHKXER( 'zhfrk ', INFOT, NOUT, LERR, OK )
255 CALL ZHFRK( 'n
', '/
', 'n
', 0, 0, ALPHA, A, 1, BETA, B )
256 CALL CHKXER( 'zhfrk ', infot, nout, lerr, ok )
258 CALL zhfrk(
'N',
'U',
'/', 0, 0, alpha, a, 1, beta, b )
259 CALL chkxer(
'ZHFRK ', infot, nout, lerr, ok )
261 CALL zhfrk(
'N',
'U',
'N', -1, 0, alpha, a, 1, beta, b )
262 CALL chkxer(
'ZHFRK ', infot, nout, lerr, ok )
264 CALL zhfrk(
'N',
'U',
'N', 0, -1, alpha, a, 1, beta, b )
265 CALL chkxer(
'ZHFRK ', infot, nout, lerr, ok )
267 CALL zhfrk(
'N',
'U',
'N', 0, 0, alpha, a, 0, beta, b )
268 CALL chkxer(
'ZHFRK ', infot, nout, lerr, ok )
273 WRITE( nout, fmt = 9999 )
275 WRITE( nout, fmt = 9998 )
278 9999
FORMAT( 1x,
'COMPLEX*16 RFP routines passed the tests of the ',
280 9998
FORMAT(
' *** RFP routines failed the tests of the error ',
subroutine ztfsm(transr, side, uplo, trans, diag, m, n, alpha, a, b, ldb)
ZTFSM solves a matrix equation (one operand is a triangular matrix in RFP format).
subroutine zhfrk(transr, uplo, trans, n, k, alpha, a, lda, beta, c)
ZHFRK performs a Hermitian rank-k operation for matrix in RFP format.