@@ -409,12 +409,13 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
409
409
LOGICAL INITQ, INITU, INITV, UPPER, WANTQ, WANTU, WANTV
410
410
INTEGER I, J, KCYCLE
411
411
REAL A1, A3, B1, B3, CSQ, CSU, CSV, ERROR, GAMMA,
412
- $ RWK, SSMIN
412
+ $ RWK, SSMIN, SFMIN
413
413
COMPLEX A2, B2, SNQ, SNU, SNV
414
414
* ..
415
415
* .. External Functions ..
416
416
LOGICAL LSAME
417
- EXTERNAL LSAME
417
+ REAL SLAMCH
418
+ EXTERNAL LSAME, SLAMCH
418
419
* ..
419
420
* .. External Subroutines ..
420
421
EXTERNAL CCOPY, CLAGS2, CLAPLL, CLASET, CROT, CSSCAL,
@@ -465,6 +466,10 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
465
466
RETURN
466
467
END IF
467
468
*
469
+ * Safe minimum
470
+ *
471
+ SFMIN = SLAMCH( ' Safe minimum' )
472
+ *
468
473
* Initialize U, V and Q, if necessary
469
474
*
470
475
IF ( INITU )
@@ -608,7 +613,7 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
608
613
A1 = REAL ( A( K+ I, N- L+ I ) )
609
614
B1 = REAL ( B( I, N- L+ I ) )
610
615
*
611
- IF ( A1 .NE. ZERO ) THEN
616
+ IF ( ABS (A1) .GE. SFMIN ) THEN
612
617
GAMMA = B1 / A1
613
618
*
614
619
IF ( GAMMA.LT. ZERO ) THEN
0 commit comments