| 1663 |
! Apply the plane-rotations to the remaining elements in columns |
! Apply the plane-rotations to the remaining elements in columns |
| 1664 |
! j and mnew of Q |
! j and mnew of Q |
| 1665 |
|
|
| 1666 |
IF ( PRESENT( Q ) ) & |
! NB: ROT replaced by do loop to prevent mkl bug ... sigh |
| 1667 |
CALL ROT( mnew, Q( : mnew, j ), 1, Q( : mnew, mnew ), 1, c, s ) |
! IF ( PRESENT( Q ) ) & |
| 1668 |
|
! CALL ROT( mnew, Q( : mnew, j ), 1, Q( : mnew, mnew ), 1, c, s ) |
| 1669 |
|
IF ( PRESENT( Q ) ) THEN |
| 1670 |
|
DO k = 1, mnew |
| 1671 |
|
y = c * Q( k, j ) + s * Q( k, mnew ) |
| 1672 |
|
Q( k, mnew ) = c * Q( k, mnew ) - s * Q( k, j ) |
| 1673 |
|
Q( k, j ) = y |
| 1674 |
|
END DO |
| 1675 |
|
END IF |
| 1676 |
END DO |
END DO |
|
|
|
| 1677 |
END IF |
END IF |
| 1678 |
|
|
| 1679 |
! Check that the new diagonal entry of R is non-zero |
! Check that the new diagonal entry of R is non-zero |
| 1680 |
|
|
| 1681 |
R( mnew * ( mnew + 1 ) / 2 ) = SPIKE( mnew ) |
R( mnew * ( mnew + 1 ) / 2 ) = SPIKE( mnew ) |
| 1682 |
! write(6,*) ' new diag = ', abs( SPIKE( mnew ) ) |
! write(6,*) ' new diag = ', abs( SPIKE( mnew ) ) |
| 1683 |
IF ( abs( SPIKE( mnew ) ) > epsmch ) THEN |
IF ( ABS( SPIKE( mnew ) ) > epsmch ) THEN |
| 1684 |
status = 0 |
status = 0 |
| 1685 |
ELSE |
ELSE |
| 1686 |
status = - 9 |
status = - 9 |
Parent Directory
| 
Revision Log
| 
Patch
