dchud.f 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159
  1. *DECK DCHUD
  2. SUBROUTINE DCHUD (R, LDR, P, X, Z, LDZ, NZ, Y, RHO, C, S)
  3. C***BEGIN PROLOGUE DCHUD
  4. C***PURPOSE Update an augmented Cholesky decomposition of the
  5. C triangular part of an augmented QR decomposition.
  6. C***LIBRARY SLATEC (LINPACK)
  7. C***CATEGORY D7B
  8. C***TYPE DOUBLE PRECISION (SCHUD-S, DCHUD-D, CCHUD-C)
  9. C***KEYWORDS CHOLESKY DECOMPOSITION, LINEAR ALGEBRA, LINPACK, MATRIX,
  10. C UPDATE
  11. C***AUTHOR Stewart, G. W., (U. of Maryland)
  12. C***DESCRIPTION
  13. C
  14. C DCHUD updates an augmented Cholesky decomposition of the
  15. C triangular part of an augmented QR decomposition. Specifically,
  16. C given an upper triangular matrix R of order P, a row vector
  17. C X, a column vector Z, and a scalar Y, DCHUD determines a
  18. C unitary matrix U and a scalar ZETA such that
  19. C
  20. C
  21. C (R Z) (RR ZZ )
  22. C U * ( ) = ( ) ,
  23. C (X Y) ( 0 ZETA)
  24. C
  25. C where RR is upper triangular. If R and Z have been
  26. C obtained from the factorization of a least squares
  27. C problem, then RR and ZZ are the factors corresponding to
  28. C the problem with the observation (X,Y) appended. In this
  29. C case, if RHO is the norm of the residual vector, then the
  30. C norm of the residual vector of the updated problem is
  31. C SQRT(RHO**2 + ZETA**2). DCHUD will simultaneously update
  32. C several triplets (Z,Y,RHO).
  33. C For a less terse description of what DCHUD does and how
  34. C it may be applied, see the LINPACK guide.
  35. C
  36. C The matrix U is determined as the product U(P)*...*U(1),
  37. C where U(I) is a rotation in the (I,P+1) plane of the
  38. C form
  39. C
  40. C ( C(I) S(I) )
  41. C ( ) .
  42. C ( -S(I) C(I) )
  43. C
  44. C The rotations are chosen so that C(I) is double precision.
  45. C
  46. C On Entry
  47. C
  48. C R DOUBLE PRECISION(LDR,P), where LDR .GE. P.
  49. C R contains the upper triangular matrix
  50. C that is to be updated. The part of R
  51. C below the diagonal is not referenced.
  52. C
  53. C LDR INTEGER.
  54. C LDR is the leading dimension of the array R.
  55. C
  56. C P INTEGER.
  57. C P is the order of the matrix R.
  58. C
  59. C X DOUBLE PRECISION(P).
  60. C X contains the row to be added to R. X is
  61. C not altered by DCHUD.
  62. C
  63. C Z DOUBLE PRECISION(LDZ,N)Z), where LDZ .GE. P.
  64. C Z is an array containing NZ P-vectors to
  65. C be updated with R.
  66. C
  67. C LDZ INTEGER.
  68. C LDZ is the leading dimension of the array Z.
  69. C
  70. C NZ INTEGER.
  71. C NZ is the number of vectors to be updated
  72. C NZ may be zero, in which case Z, Y, and RHO
  73. C are not referenced.
  74. C
  75. C Y DOUBLE PRECISION(NZ).
  76. C Y contains the scalars for updating the vectors
  77. C Z. Y is not altered by DCHUD.
  78. C
  79. C RHO DOUBLE PRECISION(NZ).
  80. C RHO contains the norms of the residual
  81. C vectors that are to be updated. If RHO(J)
  82. C is negative, it is left unaltered.
  83. C
  84. C On Return
  85. C
  86. C RC
  87. C RHO contain the updated quantities.
  88. C Z
  89. C
  90. C C DOUBLE PRECISION(P).
  91. C C contains the cosines of the transforming
  92. C rotations.
  93. C
  94. C S DOUBLE PRECISION(P).
  95. C S contains the sines of the transforming
  96. C rotations.
  97. C
  98. C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
  99. C Stewart, LINPACK Users' Guide, SIAM, 1979.
  100. C***ROUTINES CALLED DROTG
  101. C***REVISION HISTORY (YYMMDD)
  102. C 780814 DATE WRITTEN
  103. C 890531 Changed all specific intrinsics to generic. (WRB)
  104. C 890831 Modified array declarations. (WRB)
  105. C 890831 REVISION DATE from Version 3.2
  106. C 891214 Prologue converted to Version 4.0 format. (BAB)
  107. C 900326 Removed duplicate information from DESCRIPTION section.
  108. C (WRB)
  109. C 920501 Reformatted the REFERENCES section. (WRB)
  110. C***END PROLOGUE DCHUD
  111. INTEGER LDR,P,LDZ,NZ
  112. DOUBLE PRECISION RHO(*),C(*)
  113. DOUBLE PRECISION R(LDR,*),X(*),Z(LDZ,*),Y(*),S(*)
  114. C
  115. INTEGER I,J,JM1
  116. DOUBLE PRECISION AZETA,SCALE
  117. DOUBLE PRECISION T,XJ,ZETA
  118. C
  119. C UPDATE R.
  120. C
  121. C***FIRST EXECUTABLE STATEMENT DCHUD
  122. DO 30 J = 1, P
  123. XJ = X(J)
  124. C
  125. C APPLY THE PREVIOUS ROTATIONS.
  126. C
  127. JM1 = J - 1
  128. IF (JM1 .LT. 1) GO TO 20
  129. DO 10 I = 1, JM1
  130. T = C(I)*R(I,J) + S(I)*XJ
  131. XJ = C(I)*XJ - S(I)*R(I,J)
  132. R(I,J) = T
  133. 10 CONTINUE
  134. 20 CONTINUE
  135. C
  136. C COMPUTE THE NEXT ROTATION.
  137. C
  138. CALL DROTG(R(J,J),XJ,C(J),S(J))
  139. 30 CONTINUE
  140. C
  141. C IF REQUIRED, UPDATE Z AND RHO.
  142. C
  143. IF (NZ .LT. 1) GO TO 70
  144. DO 60 J = 1, NZ
  145. ZETA = Y(J)
  146. DO 40 I = 1, P
  147. T = C(I)*Z(I,J) + S(I)*ZETA
  148. ZETA = C(I)*ZETA - S(I)*Z(I,J)
  149. Z(I,J) = T
  150. 40 CONTINUE
  151. AZETA = ABS(ZETA)
  152. IF (AZETA .EQ. 0.0D0 .OR. RHO(J) .LT. 0.0D0) GO TO 50
  153. SCALE = AZETA + RHO(J)
  154. RHO(J) = SCALE*SQRT((AZETA/SCALE)**2+(RHO(J)/SCALE)**2)
  155. 50 CONTINUE
  156. 60 CONTINUE
  157. 70 CONTINUE
  158. RETURN
  159. END