dglss.f 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  1. *DECK DGLSS
  2. SUBROUTINE DGLSS (A, MDA, M, N, B, MDB, NB, RNORM, WORK, LW,
  3. + IWORK, LIW, INFO)
  4. C***BEGIN PROLOGUE DGLSS
  5. C***PURPOSE Solve a linear least squares problems by performing a QR
  6. C factorization of the input matrix using Householder
  7. C transformations. Emphasis is put on detecting possible
  8. C rank deficiency.
  9. C***LIBRARY SLATEC
  10. C***CATEGORY D9, D5
  11. C***TYPE DOUBLE PRECISION (SGLSS-S, DGLSS-D)
  12. C***KEYWORDS LINEAR LEAST SQUARES, LQ FACTORIZATION, QR FACTORIZATION,
  13. C UNDERDETERMINED LINEAR SYSTEMS
  14. C***AUTHOR Manteuffel, T. A., (LANL)
  15. C***DESCRIPTION
  16. C
  17. C DGLSS solves both underdetermined and overdetermined
  18. C LINEAR systems AX = B, where A is an M by N matrix
  19. C and B is an M by NB matrix of right hand sides. If
  20. C M.GE.N, the least squares solution is computed by
  21. C decomposing the matrix A into the product of an
  22. C orthogonal matrix Q and an upper triangular matrix
  23. C R (QR factorization). If M.LT.N, the minimal
  24. C length solution is computed by factoring the
  25. C matrix A into the product of a lower triangular
  26. C matrix L and an orthogonal matrix Q (LQ factor-
  27. C ization). If the matrix A is determined to be rank
  28. C deficient, that is the rank of A is less than
  29. C MIN(M,N), then the minimal length least squares
  30. C solution is computed.
  31. C
  32. C DGLSS assumes full machine precision in the data.
  33. C If more control over the uncertainty in the data
  34. C is desired, the codes DLLSIA and DULSIA are
  35. C recommended.
  36. C
  37. C DGLSS requires MDA*N + (MDB + 1)*NB + 5*MIN(M,N) dimensioned
  38. C real space and M+N dimensioned integer space.
  39. C
  40. C
  41. C ******************************************************************
  42. C * *
  43. C * WARNING - All input arrays are changed on exit. *
  44. C * *
  45. C ******************************************************************
  46. C SUBROUTINE DGLSS(A,MDA,M,N,B,MDB,NB,RNORM,WORK,LW,IWORK,LIW,INFO)
  47. C
  48. C Input..All TYPE REAL variables are DOUBLE PRECISION
  49. C
  50. C A(,) Linear coefficient matrix of AX=B, with MDA the
  51. C MDA,M,N actual first dimension of A in the calling program.
  52. C M is the row dimension (no. of EQUATIONS of the
  53. C problem) and N the col dimension (no. of UNKNOWNS).
  54. C
  55. C B(,) Right hand side(s), with MDB the actual first
  56. C MDB,NB dimension of B in the calling program. NB is the
  57. C number of M by 1 right hand sides. Must have
  58. C MDB.GE.MAX(M,N). If NB = 0, B is never accessed.
  59. C
  60. C
  61. C RNORM() Vector of length at least NB. On input the contents
  62. C of RNORM are unused.
  63. C
  64. C WORK() A real work array dimensioned 5*MIN(M,N).
  65. C
  66. C LW Actual dimension of WORK.
  67. C
  68. C IWORK() Integer work array dimensioned at least N+M.
  69. C
  70. C LIW Actual dimension of IWORK.
  71. C
  72. C
  73. C INFO A flag which provides for the efficient
  74. C solution of subsequent problems involving the
  75. C same A but different B.
  76. C If INFO = 0 original call
  77. C INFO = 1 subsequent calls
  78. C On subsequent calls, the user must supply A, INFO,
  79. C LW, IWORK, LIW, and the first 2*MIN(M,N) locations
  80. C of WORK as output by the original call to DGLSS.
  81. C
  82. C
  83. C Output..All TYPE REAL variables are DOUBLE PRECISION
  84. C
  85. C A(,) Contains the triangular part of the reduced matrix
  86. C and the transformation information. It together with
  87. C the first 2*MIN(M,N) elements of WORK (see below)
  88. C completely specify the factorization of A.
  89. C
  90. C B(,) Contains the N by NB solution matrix X.
  91. C
  92. C
  93. C RNORM() Contains the Euclidean length of the NB residual
  94. C vectors B(I)-AX(I), I=1,NB.
  95. C
  96. C WORK() The first 2*MIN(M,N) locations of WORK contain value
  97. C necessary to reproduce the factorization of A.
  98. C
  99. C IWORK() The first M+N locations contain the order in
  100. C which the rows and columns of A were used.
  101. C If M.GE.N columns then rows. If M.LT.N rows
  102. C then columns.
  103. C
  104. C INFO Flag to indicate status of computation on completion
  105. C -1 Parameter error(s)
  106. C 0 - Full rank
  107. C N.GT.0 - Reduced rank rank=MIN(M,N)-INFO
  108. C
  109. C***REFERENCES T. Manteuffel, An interval analysis approach to rank
  110. C determination in linear least squares problems,
  111. C Report SAND80-0655, Sandia Laboratories, June 1980.
  112. C***ROUTINES CALLED DLLSIA, DULSIA
  113. C***REVISION HISTORY (YYMMDD)
  114. C 810801 DATE WRITTEN
  115. C 890831 Modified array declarations. (WRB)
  116. C 891006 Cosmetic changes to prologue. (WRB)
  117. C 891006 REVISION DATE from Version 3.2
  118. C 891214 Prologue converted to Version 4.0 format. (BAB)
  119. C 920501 Reformatted the REFERENCES section. (WRB)
  120. C***END PROLOGUE DGLSS
  121. IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  122. DIMENSION A(MDA,*),B(MDB,*),RNORM(*),WORK(*)
  123. INTEGER IWORK(*)
  124. C
  125. C***FIRST EXECUTABLE STATEMENT DGLSS
  126. RE=0.D0
  127. AE=0.D0
  128. KEY=0
  129. MODE=2
  130. NP=0
  131. C
  132. C IF M.GE.N CALL DLLSIA
  133. C IF M.LT.N CALL DULSIA
  134. C
  135. IF(M.LT.N) GO TO 10
  136. CALL DLLSIA(A,MDA,M,N,B,MDB,NB,RE,AE,KEY,MODE,NP,
  137. 1 KRANK,KSURE,RNORM,WORK,LW,IWORK,LIW,INFO)
  138. IF(INFO.EQ.-1) RETURN
  139. INFO=N-KRANK
  140. RETURN
  141. 10 CALL DULSIA(A,MDA,M,N,B,MDB,NB,RE,AE,KEY,MODE,NP,
  142. 1 KRANK,KSURE,RNORM,WORK,LW,IWORK,LIW,INFO)
  143. IF(INFO.EQ.-1) RETURN
  144. INFO=M-KRANK
  145. RETURN
  146. END