| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152 |
- *DECK OHTROR
- SUBROUTINE OHTROR (Q, N, NRDA, DIAG, IRANK, DIV, TD)
- C***BEGIN PROLOGUE OHTROR
- C***SUBSIDIARY
- C***PURPOSE Subsidiary to BVSUP
- C***LIBRARY SLATEC
- C***TYPE SINGLE PRECISION (OHTROR-S)
- C***AUTHOR Watts, H. A., (SNLA)
- C***DESCRIPTION
- C
- C For a rank deficient problem, additional orthogonal
- C HOUSEHOLDER transformations are applied to the right side
- C of Q to further reduce the triangular form.
- C Thus, after application of the routines ORTHOL and OHTROR
- C to the original matrix, the result is a nonsingular
- C triangular matrix while the remainder of the matrix
- C has been zeroed out.
- C
- C***SEE ALSO BVSUP
- C***ROUTINES CALLED SDOT
- C***REVISION HISTORY (YYMMDD)
- C 750601 DATE WRITTEN
- C 890831 Modified array declarations. (WRB)
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900402 Added TYPE section. (WRB)
- C 910722 Updated AUTHOR section. (ALS)
- C***END PROLOGUE OHTROR
- DIMENSION Q(NRDA,*),DIAG(*),DIV(*),TD(*)
- C***FIRST EXECUTABLE STATEMENT OHTROR
- NMIR=N-IRANK
- IRP=IRANK+1
- DO 30 K=1,IRANK
- KIR=IRP-K
- DIAGK=DIAG(KIR)
- SIG=(DIAGK*DIAGK)+SDOT(NMIR,Q(KIR,IRP),NRDA,Q(KIR,IRP),NRDA)
- DD=SIGN(SQRT(SIG),-DIAGK)
- DIV(KIR)=DD
- TDV=DIAGK-DD
- TD(KIR)=TDV
- IF (K .EQ. IRANK) GO TO 30
- KIRM=KIR-1
- SQD=DD*DIAGK-SIG
- DO 20 J=1,KIRM
- QS=((TDV*Q(J,KIR))+SDOT(NMIR,Q(J,IRP),NRDA,Q(KIR,IRP),NRDA))
- 1 /SQD
- Q(J,KIR)=Q(J,KIR)+QS*TDV
- DO 10 L=IRP,N
- 10 Q(J,L)=Q(J,L)+QS*Q(KIR,L)
- 20 CONTINUE
- 30 CONTINUE
- RETURN
- END
|
