LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dchkec()

subroutine dchkec ( double precision  THRESH,
logical  TSTERR,
integer  NIN,
integer  NOUT 
)

DCHKEC

Purpose:
 DCHKEC tests eigen- condition estimation routines
        DLALN2, DLASY2, DLANV2, DLAQTR, DLAEXC,
        DTRSYL, DTREXC, DTRSNA, DTRSEN, DTGEXC

 In all cases, the routine runs through a fixed set of numerical
 examples, subjects them to various tests, and compares the test
 results to a threshold THRESH. In addition, DTREXC, DTRSNA and DTRSEN
 are tested by reading in precomputed examples from a file (on input
 unit NIN).  Output is written to output unit NOUT.
Parameters
[in]THRESH
          THRESH is DOUBLE PRECISION
          Threshold for residual tests.  A computed test ratio passes
          the threshold if it is less than THRESH.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NIN
          NIN is INTEGER
          The logical unit number for input.
[in]NOUT
          NOUT is INTEGER
          The logical unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 75 of file dchkec.f.

76 *
77 * -- LAPACK test routine --
78 * -- LAPACK is a software package provided by Univ. of Tennessee, --
79 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
80 *
81 * .. Scalar Arguments ..
82  LOGICAL TSTERR
83  INTEGER NIN, NOUT
84  DOUBLE PRECISION THRESH
85 * ..
86 *
87 * =====================================================================
88 *
89 * .. Local Scalars ..
90  LOGICAL OK
91  CHARACTER*3 PATH
92  INTEGER KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
93  $ KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
94  $ LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
95  $ NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
96  DOUBLE PRECISION EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
97  $ RTREXC, RTRSYL, SFMIN, RTGEXC
98 * ..
99 * .. Local Arrays ..
100  INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
101  $ NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
102  $ NTRSNA( 3 )
103  DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 )
104 * ..
105 * .. External Subroutines ..
106  EXTERNAL derrec, dget31, dget32, dget33, dget34, dget35,
107  $ dget36, dget37, dget38, dget39, dget40
108 * ..
109 * .. External Functions ..
110  DOUBLE PRECISION DLAMCH
111  EXTERNAL dlamch
112 * ..
113 * .. Executable Statements ..
114 *
115  path( 1: 1 ) = 'Double precision'
116  path( 2: 3 ) = 'EC'
117  eps = dlamch( 'P' )
118  sfmin = dlamch( 'S' )
119 *
120 * Print header information
121 *
122  WRITE( nout, fmt = 9989 )
123  WRITE( nout, fmt = 9988 )eps, sfmin
124  WRITE( nout, fmt = 9987 )thresh
125 *
126 * Test error exits if TSTERR is .TRUE.
127 *
128  IF( tsterr )
129  $ CALL derrec( path, nout )
130 *
131  ok = .true.
132  CALL dget31( rlaln2, llaln2, nlaln2, klaln2 )
133  IF( rlaln2.GT.thresh .OR. nlaln2( 1 ).NE.0 ) THEN
134  ok = .false.
135  WRITE( nout, fmt = 9999 )rlaln2, llaln2, nlaln2, klaln2
136  END IF
137 *
138  CALL dget32( rlasy2, llasy2, nlasy2, klasy2 )
139  IF( rlasy2.GT.thresh ) THEN
140  ok = .false.
141  WRITE( nout, fmt = 9998 )rlasy2, llasy2, nlasy2, klasy2
142  END IF
143 *
144  CALL dget33( rlanv2, llanv2, nlanv2, klanv2 )
145  IF( rlanv2.GT.thresh .OR. nlanv2.NE.0 ) THEN
146  ok = .false.
147  WRITE( nout, fmt = 9997 )rlanv2, llanv2, nlanv2, klanv2
148  END IF
149 *
150  CALL dget34( rlaexc, llaexc, nlaexc, klaexc )
151  IF( rlaexc.GT.thresh .OR. nlaexc( 2 ).NE.0 ) THEN
152  ok = .false.
153  WRITE( nout, fmt = 9996 )rlaexc, llaexc, nlaexc, klaexc
154  END IF
155 *
156  CALL dget35( rtrsyl, ltrsyl, ntrsyl, ktrsyl )
157  IF( rtrsyl.GT.thresh ) THEN
158  ok = .false.
159  WRITE( nout, fmt = 9995 )rtrsyl, ltrsyl, ntrsyl, ktrsyl
160  END IF
161 *
162  CALL dget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
163  IF( rtrexc.GT.thresh .OR. ntrexc( 3 ).GT.0 ) THEN
164  ok = .false.
165  WRITE( nout, fmt = 9994 )rtrexc, ltrexc, ntrexc, ktrexc
166  END IF
167 *
168  CALL dget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
169  IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
170  $ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
171  $ THEN
172  ok = .false.
173  WRITE( nout, fmt = 9993 )rtrsna, ltrsna, ntrsna, ktrsna
174  END IF
175 *
176  CALL dget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
177  IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
178  $ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
179  $ THEN
180  ok = .false.
181  WRITE( nout, fmt = 9992 )rtrsen, ltrsen, ntrsen, ktrsen
182  END IF
183 *
184  CALL dget39( rlaqtr, llaqtr, nlaqtr, klaqtr )
185  IF( rlaqtr.GT.thresh ) THEN
186  ok = .false.
187  WRITE( nout, fmt = 9991 )rlaqtr, llaqtr, nlaqtr, klaqtr
188  END IF
189 *
190  CALL dget40( rtgexc, ltgexc, ntgexc, ktgexc, nin )
191  IF( rtgexc.GT.thresh ) THEN
192  ok = .false.
193  WRITE( nout, fmt = 9986 )rtgexc, ltgexc, ntgexc, ktgexc
194  END IF
195 *
196  ntests = klaln2 + klasy2 + klanv2 + klaexc + ktrsyl + ktrexc +
197  $ ktrsna + ktrsen + klaqtr + ktgexc
198  IF( ok )
199  $ WRITE( nout, fmt = 9990 )path, ntests
200 *
201  RETURN
202  9999 FORMAT( ' Error in DLALN2: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
203  $ 'INFO=', 2i8, ' KNT=', i8 )
204  9998 FORMAT( ' Error in DLASY2: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
205  $ 'INFO=', i8, ' KNT=', i8 )
206  9997 FORMAT( ' Error in DLANV2: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
207  $ 'INFO=', i8, ' KNT=', i8 )
208  9996 FORMAT( ' Error in DLAEXC: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
209  $ 'INFO=', 2i8, ' KNT=', i8 )
210  9995 FORMAT( ' Error in DTRSYL: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
211  $ 'INFO=', i8, ' KNT=', i8 )
212  9994 FORMAT( ' Error in DTREXC: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
213  $ 'INFO=', 3i8, ' KNT=', i8 )
214  9993 FORMAT( ' Error in DTRSNA: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
215  $ ' NINFO=', 3i8, ' KNT=', i8 )
216  9992 FORMAT( ' Error in DTRSEN: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
217  $ ' NINFO=', 3i8, ' KNT=', i8 )
218  9991 FORMAT( ' Error in DLAQTR: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
219  $ 'INFO=', i8, ' KNT=', i8 )
220  9990 FORMAT( / 1x, 'All tests for ', a3, ' routines passed the thresh',
221  $ 'old ( ', i6, ' tests run)' )
222  9989 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition estim',
223  $ 'ation routines', / ' DLALN2, DLASY2, DLANV2, DLAEXC, DTRS',
224  $ 'YL, DTREXC, DTRSNA, DTRSEN, DLAQTR, DTGEXC', / )
225  9988 FORMAT( ' Relative machine precision (EPS) = ', d16.6, / ' Safe ',
226  $ 'minimum (SFMIN) = ', d16.6, / )
227  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
228  $ 's than', f8.2, / / )
229  9986 FORMAT( ' Error in DTGEXC: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
230  $ 'INFO=', i8, ' KNT=', i8 )
231 *
232 * End of DCHKEC
233 *
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
dget33
subroutine dget33(RMAX, LMAX, NINFO, KNT)
DGET33
Definition: dget33.f:76
derrec
subroutine derrec(PATH, NUNIT)
DERREC
Definition: derrec.f:56
dget39
subroutine dget39(RMAX, LMAX, NINFO, KNT)
DGET39
Definition: dget39.f:103
dget32
subroutine dget32(RMAX, LMAX, NINFO, KNT)
DGET32
Definition: dget32.f:82
dget37
subroutine dget37(RMAX, LMAX, NINFO, KNT, NIN)
DGET37
Definition: dget37.f:90
dget34
subroutine dget34(RMAX, LMAX, NINFO, KNT)
DGET34
Definition: dget34.f:82
dget36
subroutine dget36(RMAX, LMAX, NINFO, KNT, NIN)
DGET36
Definition: dget36.f:88
dget35
subroutine dget35(RMAX, LMAX, NINFO, KNT)
DGET35
Definition: dget35.f:78
dget38
subroutine dget38(RMAX, LMAX, NINFO, KNT, NIN)
DGET38
Definition: dget38.f:91
dget31
subroutine dget31(RMAX, LMAX, NINFO, KNT)
DGET31
Definition: dget31.f:91
dget40
subroutine dget40(RMAX, LMAX, NINFO, KNT, NIN)
DGET40
Definition: dget40.f:83
Here is the call graph for this function:
Here is the caller graph for this function: