Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Changes for "Test 5" needed in xeigtst* #1043

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Changes for "Test 5" needed in xeigtst* #1043

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
50 changes: 48 additions & 2 deletions TESTING/EIG/cdrgev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -428,14 +428,18 @@ SUBROUTINE CDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
PARAMETER ( MAXTYP = 26 )
* ..
* .. Local Scalars ..
LOGICAL BADNN
LOGICAL BADNN, EVAL_5
INTEGER I, IADD, IERR, IN, J, JC, JR, JSIZE, JTYPE,
$ MAXWRK, MINWRK, MTYPES, N, N1, NB, NERRS,
$ NMATS, NMAX, NTESTT
REAL SAFMAX, SAFMIN, ULP, ULPINV
COMPLEX CTEMP

real wtol, atst, btst, rtst

* ..
* .. Local Arrays ..
complex EVAL(LDA), EVAL1(LDA)
LOGICAL LASIGN( MAXTYP ), LBSIGN( MAXTYP )
INTEGER IOLDSD( 4 ), KADD( 6 ), KAMAGN( MAXTYP ),
$ KATYPE( MAXTYP ), KAZERO( MAXTYP ),
Expand Down Expand Up @@ -484,6 +488,7 @@ SUBROUTINE CDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
* ..
* .. Executable Statements ..
*

* Check for errors
*
INFO = 0
Expand Down Expand Up @@ -778,10 +783,51 @@ SUBROUTINE CDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
GO TO 190
END IF
*
EVAL_5 = .FALSE.
DO 120 J = 1, N
* eigenvalues+eigenvectors may take different path through code
* than eigenvalues only.
IF( ALPHA( J ).NE.ALPHA1( J ) .OR. BETA( J ).NE.
$ BETA1( J ) )RESULT( 5 ) = ULPINV
$ BETA1( J ) ) THEN
EVAL_5 = .TRUE.
ENDIF
120 CONTINUE
* If alpha,alpaha1 or beta,beta1 were not identical, examine
* differences more closely and compare to a tolerance.
IF( EVAL_5 ) THEN
WTOL = THRESH*ULP
DO 121 J = 1, N
* Compute eigenvalues to extent possible
IF (BETA(J).NE.CZERO) THEN
EVAL(J) = ALPHA(J)/BETA(J)
ELSE
EVAL(J) = CMPLX(SAFMAX)
ENDIF
IF (BETA1(J).NE.CZERO) THEN
EVAL1(J) = ALPHA1(J)/BETA1(J)
ELSE
EVAL1(J) = CMPLX(SAFMAX)
ENDIF
121 CONTINUE

DO 122 J = 1, N
* Compare eigenvalues.
RTST = CABS( EVAL(J)-EVAL1(J) )/
$ ( ONE + CABS(EVAL(J)) )
IF ( RTST .GT. WTOL) THEN
* Compare alphas and betas directly. Don't record an error
* if relative alpha/beta diffs are both small.
ATST = CABS(ALPHA(J)-ALPHA1(J))/
$ (ONE + CABS(ALPHA(J)) )
BTST = CABS(BETA(J)-BETA1(J))/
$ (ONE + CABS(BETA(J)) )
IF(ATST.GT.WTOL .OR. BTST.GT.WTOL) THEN
* If error detected, set RESULT(5) as original code did
RESULT( 5 ) = ULPINV
ENDIF
ENDIF
122 CONTINUE
ENDIF
*
* Do test (6): Compute eigenvalues and left eigenvectors,
* and test them
Expand Down
49 changes: 47 additions & 2 deletions TESTING/EIG/cdrgev3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -428,14 +428,17 @@ SUBROUTINE CDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
PARAMETER ( MAXTYP = 26 )
* ..
* .. Local Scalars ..
LOGICAL BADNN
LOGICAL BADNN, EVAL_5
INTEGER I, IADD, IERR, IN, J, JC, JR, JSIZE, JTYPE,
$ MAXWRK, MINWRK, MTYPES, N, N1, NB, NERRS,
$ NMATS, NMAX, NTESTT
REAL SAFMAX, SAFMIN, ULP, ULPINV
COMPLEX CTEMP

real wtol, atst, btst, rtst
* ..
* .. Local Arrays ..
complex EVAL(LDA), EVAL1(LDA)
LOGICAL LASIGN( MAXTYP ), LBSIGN( MAXTYP )
INTEGER IOLDSD( 4 ), KADD( 6 ), KAMAGN( MAXTYP ),
$ KATYPE( MAXTYP ), KAZERO( MAXTYP ),
Expand Down Expand Up @@ -484,6 +487,7 @@ SUBROUTINE CDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
* ..
* .. Executable Statements ..
*

* Check for errors
*
INFO = 0
Expand Down Expand Up @@ -786,10 +790,51 @@ SUBROUTINE CDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
GO TO 190
END IF
*
EVAL_5 = .FALSE.
DO 120 J = 1, N
* eigenvalues+eigenvectors may take a different path through code
* than eigenvalues only.
IF( ALPHA( J ).NE.ALPHA1( J ) .OR. BETA( J ).NE.
$ BETA1( J ) ) RESULT( 5 ) = ULPINV
$ BETA1( J ) ) THEN
EVAL_5 = .TRUE.
ENDIF
120 CONTINUE
* If alpha,alpaha1 or beta,beta1 were not identical, examine
* differences more closely and compare to a tolerance.
IF( EVAL_5 ) THEN
WTOL = THRESH*ULP
DO 121 J = 1, N
* Compute eigenvalues to extent possible
IF (BETA(J).NE.CZERO) THEN
EVAL(J) = ALPHA(J)/BETA(J)
ELSE
EVAL(J) = CMPLX(SAFMAX,SAFMAX)
ENDIF
IF (BETA1(J).NE.CZERO) THEN
EVAL1(J) = ALPHA1(J)/BETA1(J)
ELSE
EVAL1(J) = CMPLX(SAFMAX,SAFMAX)
ENDIF
121 CONTINUE

DO 122 J = 1, N
* Compare eigenvalues
RTST = CABS( EVAL(J)-EVAL1(J) )/
$ ( ONE + CABS(EVAL(J)) )
IF ( RTST .GT. WTOL) THEN
* Compare alphas and betas directly. Don't record
* an error if relative alpha/beta diffs are both small.
ATST = CABS(ALPHA(J)-ALPHA1(J))/
$ (ONE + CABS(ALPHA(J)) )
BTST = CABS(BETA(J)-BETA1(J))/
$ (ONE + CABS(BETA(J)) )
* If error detected, set RESULT(5) as original code did.
IF(ATST.GT.WTOL .OR. BTST.GT.WTOL) THEN
RESULT( 5 ) = ULPINV
ENDIF
ENDIF
122 CONTINUE
ENDIF
*
* Do the test (6): Compute eigenvalues and left eigenvectors,
* and test them
Expand Down
18 changes: 16 additions & 2 deletions TESTING/EIG/cdrvev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -422,13 +422,14 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
PARAMETER ( MAXTYP = 21 )
* ..
* .. Local Scalars ..
LOGICAL BADNN
LOGICAL BADNN,EVAL_5
CHARACTER*3 PATH
INTEGER IINFO, IMODE, ITYPE, IWK, J, JCOL, JJ, JSIZE,
$ JTYPE, MTYPES, N, NERRS, NFAIL, NMAX,
$ NNWORK, NTEST, NTESTF, NTESTT
REAL ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM,
$ ULP, ULPINV, UNFL, VMX, VRMX, VTST
REAL TEMP, TEMPR, TEMPI, WTOL
* ..
* .. Local Arrays ..
INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
Expand Down Expand Up @@ -798,10 +799,23 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
*
* Do Test (5)
*
EVAL_5 = .FALSE.
DO 150 J = 1, N
IF( W( J ).NE.W1( J ) )
$ RESULT( 5 ) = ULPINV
$ EVAL_5 = .TRUE.
150 CONTINUE
IF (EVAL_5) THEN
WTOL = THRESH*ULP
DO 300 J = 1, N
TEMP = (CABS(W(J)-W1(J))) / (1+CABS(W1(J)))
TEMPR = (ABS(REAL(W(J))-REAL(W1(J))))/(1+CABS(W1(J)))
TEMPI = (ABS(AIMAG(W(J))-AIMAG(W1(J))))/(1+CABS(W1(J)))
IF ( (TEMP.GT.WTOL).OR.(TEMPR.GT.WTOL).OR.
$ (TEMPI.GT.WTOL) ) THEN
RESULT( 5 ) = ULPINV
ENDIF
300 CONTINUE
ENDIF
*
* Compute eigenvalues and right eigenvectors, and test them
*
Expand Down
53 changes: 50 additions & 3 deletions TESTING/EIG/ddrgev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -434,13 +434,18 @@ SUBROUTINE DDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
PARAMETER ( MAXTYP = 26 )
* ..
* .. Local Scalars ..
LOGICAL BADNN
LOGICAL BADNN, EVAL_5
INTEGER I, IADD, IERR, IN, J, JC, JR, JSIZE, JTYPE,
$ MAXWRK, MINWRK, MTYPES, N, N1, NERRS, NMATS,
$ NMAX, NTESTT
DOUBLE PRECISION SAFMAX, SAFMIN, ULP, ULPINV

double precision wtol, atst, btst, rtst

* ..
* .. Local Arrays ..
complex*16 CALPHA(LDA), CALPH1(LDA)
complex*16 EVAL(LDA), EVAL1(LDA)
INTEGER IASIGN( MAXTYP ), IBSIGN( MAXTYP ),
$ IOLDSD( 4 ), KADD( 6 ), KAMAGN( MAXTYP ),
$ KATYPE( MAXTYP ), KAZERO( MAXTYP ),
Expand Down Expand Up @@ -776,11 +781,53 @@ SUBROUTINE DDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
GO TO 190
END IF
*
EVAL_5 = .FALSE.
DO 120 J = 1, N
* eigenvalues+eigenvectors may take different path through
* code than eigenvalues only.
IF( ALPHAR( J ).NE.ALPHR1( J ) .OR. ALPHAI( J ).NE.
$ ALPHI1( J ) .OR. BETA( J ).NE.BETA1( J ) )RESULT( 5 )
$ = ULPINV
$ ALPHI1( J ) .OR. BETA( J ).NE.BETA1( J ) ) THEN
EVAL_5 = .TRUE.
ENDIF
120 CONTINUE
* If alpha,alpaha1 or beta,beta1 were not identical,
* examine differences more closely and compare to a tolerance.
IF( EVAL_5 ) THEN
WTOL = THRESH*ULP
DO 121 J = 1, N
CALPHA(J) = DCMPLX( ALPHAR(J), ALPHAI(J) )
CALPH1(J) = DCMPLX( ALPHR1(J), ALPHI1(J) )
* Compute eigenvalues to extent possible
IF (BETA(J).NE.ZERO) THEN
EVAL(J) = CALPHA(J)/BETA(J)
ELSE
EVAL(J) = DCMPLX(SAFMAX,SAFMAX)
ENDIF
IF (BETA1(J).NE.ZERO) THEN
EVAL1(J) = CALPH1(J)/BETA1(J)
ELSE
EVAL1(J) = DCMPLX(SAFMAX,SAFMAX)
ENDIF
121 CONTINUE
*
DO 122 J = 1,N
* Compare eigenvalues
RTST = CDABS( EVAL(J)-EVAL1(J) )/
$ ( ONE+CDABS(EVAL(J)) )
IF ( RTST .GT. WTOL) THEN
* Compare alphas and betas directly. Don't record an error
* if relative alpha and beta diffs are both small.
ATST = CDABS(CALPHA(J)-CALPH1(J))/
$ (ONE + CDABS(CALPHA(J)) )
BTST = DABS(BETA(J)-BETA1(J))/
$ (ONE + DABS(BETA(J)) )
* If error detected, set RESULT(5) as original code did
IF(ATST.GT.WTOL .OR. BTST.GT.WTOL) THEN
RESULT( 5 ) = ULPINV
ENDIF
ENDIF
122 CONTINUE
ENDIF
*
* Do the test (6): Compute eigenvalues and left eigenvectors,
* and test them
Expand Down
55 changes: 51 additions & 4 deletions TESTING/EIG/ddrgev3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -434,13 +434,17 @@ SUBROUTINE DDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
PARAMETER ( MAXTYP = 27 )
* ..
* .. Local Scalars ..
LOGICAL BADNN
LOGICAL BADNN, EVAL_5
INTEGER I, IADD, IERR, IN, J, JC, JR, JSIZE, JTYPE,
$ MAXWRK, MINWRK, MTYPES, N, N1, NERRS, NMATS,
$ NMAX, NTESTT
DOUBLE PRECISION SAFMAX, SAFMIN, ULP, ULPINV

double precision wtol, atst, btst, rtst
* ..
* .. Local Arrays ..
complex*16 CALPHA(LDA), CALPH1(LDA)
complex*16 EVAL(LDA), EVAL1(LDA)
INTEGER IASIGN( MAXTYP ), IBSIGN( MAXTYP ),
$ IOLDSD( 4 ), KADD( 6 ), KAMAGN( MAXTYP ),
$ KATYPE( MAXTYP ), KAZERO( MAXTYP ),
Expand All @@ -455,7 +459,7 @@ SUBROUTINE DDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
EXTERNAL ILAENV, DLAMCH, DLARND
* ..
* .. External Subroutines ..
EXTERNAL ALASVM, DGET52, DGGEV3, DLACPY, DLARFG, DLASET,
EXTERNAL ALASVM, DGET52, DGGEV3, DLACPY, DLARFG, DLASET
$ DLATM4, DORM2R, XERBLA
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -484,6 +488,7 @@ SUBROUTINE DDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
DATA IBSIGN / 7*0, 2, 2*0, 2*2, 2*0, 2, 0, 2, 10*0 /
* ..
* .. Executable Statements ..

*
* Check for errors
*
Expand Down Expand Up @@ -811,11 +816,53 @@ SUBROUTINE DDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
GO TO 190
END IF
*
EVAL_5 = .FALSE.
DO 120 J = 1, N
* eigenvalues+eigenvectors may take a different path through
* code than eigenvalues only
IF( ALPHAR( J ).NE.ALPHR1( J ) .OR. ALPHAI( J ).NE.
$ ALPHI1( J ) .OR. BETA( J ).NE.BETA1( J ) )RESULT( 5 )
$ = ULPINV
$ ALPHI1( J ) .OR. BETA( J ).NE.BETA1( J ) ) THEN
EVAL_5 = .TRUE.
ENDIF
120 CONTINUE
* If alpha,alpaha1 or beta,beta1 were not identical
* examine differences more closely and compare to a tolerance.
IF ( EVAL_5 ) THEN
WTOL = THRESH*ULP
DO 121 J = 1, N
CALPHA(J) = DCMPLX( ALPHAR(J), ALPHAI(J) )
CALPH1(J) = DCMPLX( ALPHR1(J), ALPHI1(J) )
* Compute eigenvalues to extent possible
IF (BETA(J).NE.ZERO) THEN
EVAL(J) = CALPHA(J)/BETA(J)
ELSE
EVAL(J) = DCMPLX(SAFMAX,SAFMAX)
ENDIF
IF (BETA1(J).NE.ZERO) THEN
EVAL1(J) = CALPH1(J)/BETA1(J)
ELSE
EVAL1(J) = DCMPLX(SAFMAX,SAFMAX)
ENDIF
121 CONTINUE

DO 122 J = 1, N
* Compare eigenvalues
RTST = CDABS( EVAL(J)-EVAL1(J) )/
$ ( ONE + CDABS(EVAL(J)) )
IF ( RTST .GT. WTOL) THEN
C compare alphas and betas directly.
C Don't record an error if relative alpha/beta diffs are both small.
ATST = CDABS(CALPHA(J)-CALPH1(J))/
$ ( ONE + CDABS(CALPHA(J)) )
BTST = DABS(BETA(J)-BETA1(J))/
$ ( ONE + DABS(BETA(J)) )
* If error, set RESULT(5) as original code did.
IF(ATST.GT.WTOL .OR. BTST.GT.WTOL) THEN
RESULT( 5 ) = ULPINV
ENDIF
ENDIF
122 CONTINUE
ENDIF
*
* Do the test (6): Compute eigenvalues and left eigenvectors,
* and test them
Expand Down
Loading