← Back to branch summary

~mmach/netext73/lapack

« back to all changes in this revision

Viewing changes to TESTING/EIG/dget40.f

  • Committer: mmach
  • Date: 2022-11-27 19:43:35 UTC
  • Revision ID: netbit73@gmail.com-20221127194335-pkgcqw16me0jf80s
3.11.0-2

Show diffs side-by-side

added added

removed removed

Lines of Context:
TESTING/EIG/dget40.f
15
15
*      DOUBLE PRECISION   RMAX
16
16
*      ..
17
17
*       .. Array Arguments ..
18
 
*      INTEGER            NINFO( 3 )
 
18
*      INTEGER            NINFO( 2 )
19
19
*
20
20
*
21
21
*> \par Purpose:
53
53
*>
54
54
*> \param[out] NINFO
55
55
*> \verbatim
56
 
*>          NINFO is INTEGER(3)
57
 
*>          Number of examples where INFO is nonzero.
 
56
*>          NINFO is INTEGER array, dimension (2)
 
57
*>          NINFO( 1 ) = DTGEXC without accumulation returned INFO nonzero
 
58
*>          NINFO( 2 ) = DTGEXC with accumulation returned INFO nonzero
58
59
*> \endverbatim
59
60
*>
60
61
*> \param[out] KNT
63
64
*>          Total number of examples tested.
64
65
*> \endverbatim
65
66
*>
66
 
*> \param[out] NIN
 
67
*> \param[in] NIN
67
68
*> \verbatim
68
 
*>          NINFO is INTEGER
 
69
*>          NIN is INTEGER
 
70
*>          Input logical unit number.
69
71
*> \endverbatim
70
72
*
71
73
*  Authors:
90
92
      DOUBLE PRECISION   RMAX
91
93
*     ..
92
94
*     .. Array Arguments ..
93
 
      INTEGER            NINFO( 3 )
 
95
      INTEGER            NINFO( 2 )
94
96
*     ..
95
97
*
96
98
*  =====================================================================
103
105
*     ..
104
106
*     .. Local Scalars ..
105
107
      INTEGER            I, IFST, IFST1, IFST2, IFSTSV, ILST, ILST1,
106
 
     $                   ILST2, ILSTSV, INFO1, INFO2, J, LOC, N
 
108
     $                   ILST2, ILSTSV, J, LOC, N
107
109
      DOUBLE PRECISION   EPS, RES
108
110
*     ..
109
111
*     .. Local Arrays ..
130
132
      KNT = 0
131
133
      NINFO( 1 ) = 0
132
134
      NINFO( 2 ) = 0
133
 
      NINFO( 3 ) = 0
134
135
*
135
136
*     Read input data until N=0
136
137
*
164
165
      CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
165
166
      CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
166
167
      CALL DTGEXC( .FALSE., .FALSE., N, T1, LDT, S1, LDT, Q, LDT,
167
 
     $             Z, LDT, IFST1, ILST1, WORK, LWORK, INFO1 )
 
168
     $             Z, LDT, IFST1, ILST1, WORK, LWORK, NINFO ( 1 ) )
168
169
      DO 40 I = 1, N
169
170
         DO 30 J = 1, N
170
171
            IF( I.EQ.J .AND. Q( I, J ).NE.ONE )
183
184
      CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
184
185
      CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
185
186
      CALL DTGEXC( .TRUE., .TRUE., N, T2, LDT, S2, LDT, Q, LDT,
186
 
     $             Z, LDT, IFST2, ILST2, WORK, LWORK, INFO2 )
 
187
     $             Z, LDT, IFST2, ILST2, WORK, LWORK, NINFO ( 2 ) )
187
188
*
188
189
*     Compare T1 with T2 and S1 with S2
189
190
*
199
200
     $   RES = RES + ONE / EPS
200
201
      IF( ILST1.NE.ILST2 )
201
202
     $   RES = RES + ONE / EPS
202
 
      IF( INFO1.NE.INFO2 )
 
203
      IF( NINFO( 1 ).NE.NINFO( 2 ) )
203
204
     $   RES = RES + ONE / EPS
204
205
*
205
206
*     Test orthogonality of Q and Z and backward error on T2 and S2