75
76
77
78
79
80
81 LOGICAL TSTERR
82 INTEGER NIN, NOUT
83 DOUBLE PRECISION THRESH
84
85
86
87
88
89 LOGICAL OK
90 CHARACTER*3 PATH
91 INTEGER KTREXC, KTRSEN, KTRSNA, KTRSYL, KTRSYL3,
92 $ LTREXC, LTRSYL, NTESTS, NTREXC, NTRSYL
93 DOUBLE PRECISION EPS, RTREXC, SFMIN
94
95
96 INTEGER FTRSYL( 3 ), ITRSYL( 2 ), LTRSEN( 3 ),
97 $ LTRSNA( 3 ), NTRSEN( 3 ), NTRSNA( 3 )
98 DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 ), RTRSYL( 2 )
99
100
102
103
104 DOUBLE PRECISION DLAMCH
106
107
108
109 path( 1: 1 ) = 'Zomplex precision'
110 path( 2: 3 ) = 'EC'
113 WRITE( nout, fmt = 9994 )
114 WRITE( nout, fmt = 9993 )eps, sfmin
115 WRITE( nout, fmt = 9992 )thresh
116
117
118
119 IF( tsterr )
120 $
CALL zerrec( path, nout )
121
122 ok = .true.
123 CALL zget35( rtrsyl( 1 ), ltrsyl, ntrsyl, ktrsyl, nin )
124 IF( rtrsyl( 1 ).GT.thresh ) THEN
125 ok = .false.
126 WRITE( nout, fmt = 9999 )rtrsyl( 1 ), ltrsyl, ntrsyl, ktrsyl
127 END IF
128
129 CALL zsyl01( thresh, ftrsyl, rtrsyl, itrsyl, ktrsyl3 )
130 IF( ftrsyl( 1 ).GT.0 ) THEN
131 ok = .false.
132 WRITE( nout, fmt = 9970 )ftrsyl( 1 ), rtrsyl( 1 ), thresh
133 END IF
134 IF( ftrsyl( 2 ).GT.0 ) THEN
135 ok = .false.
136 WRITE( nout, fmt = 9971 )ftrsyl( 2 ), rtrsyl( 2 ), thresh
137 END IF
138 IF( ftrsyl( 3 ).GT.0 ) THEN
139 ok = .false.
140 WRITE( nout, fmt = 9972 )ftrsyl( 3 )
141 END IF
142
143 CALL zget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
144 IF( rtrexc.GT.thresh .OR. ntrexc.GT.0 ) THEN
145 ok = .false.
146 WRITE( nout, fmt = 9998 )rtrexc, ltrexc, ntrexc, ktrexc
147 END IF
148
149 CALL zget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
150 IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
151 $ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
152 $ THEN
153 ok = .false.
154 WRITE( nout, fmt = 9997 )rtrsna, ltrsna, ntrsna, ktrsna
155 END IF
156
157 CALL zget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
158 IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
159 $ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
160 $ THEN
161 ok = .false.
162 WRITE( nout, fmt = 9996 )rtrsen, ltrsen, ntrsen, ktrsen
163 END IF
164
165 ntests = ktrsyl + ktrsyl3 + ktrexc + ktrsna + ktrsen
166 IF( ok )
167 $ WRITE( nout, fmt = 9995 )path, ntests
168
169 9999 FORMAT( ' Error in ZTRSYL: RMAX =', d12.3, / ' LMAX = ', i8,
170 $ ' NINFO=', i8, ' KNT=', i8 )
171 9998 FORMAT( ' Error in ZTREXC: RMAX =', d12.3, / ' LMAX = ', i8,
172 $ ' NINFO=', i8, ' KNT=', i8 )
173 9997 FORMAT( ' Error in ZTRSNA: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
174 $ ' NINFO=', 3i8, ' KNT=', i8 )
175 9996 FORMAT( ' Error in ZTRSEN: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
176 $ ' NINFO=', 3i8, ' KNT=', i8 )
177 9995 FORMAT( / 1x, 'All tests for ', a3,
178 $ ' routines passed the threshold ( ', i6, ' tests run)' )
179 9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
180 $ ' estimation routines', / ' ZTRSYL, ZTREXC, ZTRSNA, ZTRSEN',
181 $ / )
182 9993 FORMAT( ' Relative machine precision (EPS) = ', d16.6,
183 $ / ' Safe minimum (SFMIN) = ', d16.6, / )
184 9992 FORMAT( ' Routines pass computational tests if test ratio is ',
185 $ 'less than', f8.2, / / )
186 9970 FORMAT( 'Error in ZTRSYL: ', i8, ' tests fail the threshold.', /
187 $ 'Maximum test ratio =', d12.3, ' threshold =', d12.3 )
188 9971 FORMAT( 'Error in ZTRSYL3: ', i8, ' tests fail the threshold.', /
189 $ 'Maximum test ratio =', d12.3, ' threshold =', d12.3 )
190 9972 FORMAT( 'ZTRSYL and ZTRSYL3 compute an inconsistent scale ',
191 $ 'factor in ', i8, ' tests.')
192 RETURN
193
194
195
double precision function dlamch(cmach)
DLAMCH
subroutine zerrec(path, nunit)
ZERREC
subroutine zget35(rmax, lmax, ninfo, knt, nin)
ZGET35
subroutine zget36(rmax, lmax, ninfo, knt, nin)
ZGET36
subroutine zget37(rmax, lmax, ninfo, knt, nin)
ZGET37
subroutine zget38(rmax, lmax, ninfo, knt, nin)
ZGET38
subroutine zsyl01(thresh, nfail, rmax, ninfo, knt)
ZSYL01