home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / minpack / qform.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  96 lines
  1.       SUBROUTINE QFORM(M,N,Q,LDQ,WA)
  2.       INTEGER M,N,LDQ
  3.       DOUBLE PRECISION Q(LDQ,M),WA(M)
  4. C     **********
  5. C
  6. C     SUBROUTINE QFORM
  7. C
  8. C     THIS SUBROUTINE PROCEEDS FROM THE COMPUTED QR FACTORIZATION OF
  9. C     AN M BY N MATRIX A TO ACCUMULATE THE M BY M ORTHOGONAL MATRIX
  10. C     Q FROM ITS FACTORED FORM.
  11. C
  12. C     THE SUBROUTINE STATEMENT IS
  13. C
  14. C       SUBROUTINE QFORM(M,N,Q,LDQ,WA)
  15. C
  16. C     WHERE
  17. C
  18. C       M IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER
  19. C         OF ROWS OF A AND THE ORDER OF Q.
  20. C
  21. C       N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER
  22. C         OF COLUMNS OF A.
  23. C
  24. C       Q IS AN M BY M ARRAY. ON INPUT THE FULL LOWER TRAPEZOID IN
  25. C         THE FIRST MIN(M,N) COLUMNS OF Q CONTAINS THE FACTORED FORM.
  26. C         ON OUTPUT Q HAS BEEN ACCUMULATED INTO A SQUARE MATRIX.
  27. C
  28. C       LDQ IS A POSITIVE INTEGER INPUT VARIABLE NOT LESS THAN M
  29. C         WHICH SPECIFIES THE LEADING DIMENSION OF THE ARRAY Q.
  30. C
  31. C       WA IS A WORK ARRAY OF LENGTH M.
  32. C
  33. C     SUBPROGRAMS CALLED
  34. C
  35. C       FORTRAN-SUPPLIED ... MIN0
  36. C
  37. C     MINPACK. VERSION OF JANUARY 1979.
  38. C     BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
  39. C
  40. C     **********
  41.       INTEGER I,J,JM1,K,L,MINMN,NP1
  42.       DOUBLE PRECISION ONE,SUM,TEMP,ZERO
  43.       DATA ONE,ZERO /1.0D0,0.0D0/
  44. C
  45. C     ZERO OUT UPPER TRIANGLE OF Q IN THE FIRST MIN(M,N) COLUMNS.
  46. C
  47.       MINMN = MIN0(M,N)
  48.       IF (MINMN .LT. 2) GO TO 30
  49.       DO 20 J = 2, MINMN
  50.          JM1 = J - 1
  51.          DO 10 I = 1, JM1
  52.             Q(I,J) = ZERO
  53.    10       CONTINUE
  54.    20    CONTINUE
  55.    30 CONTINUE
  56. C
  57. C     INITIALIZE REMAINING COLUMNS TO THOSE OF THE IDENTITY MATRIX.
  58. C
  59.       NP1 = N + 1
  60.       IF (M .LT. NP1) GO TO 60
  61.       DO 50 J = NP1, M
  62.          DO 40 I = 1, M
  63.             Q(I,J) = ZERO
  64.    40       CONTINUE
  65.          Q(J,J) = ONE
  66.    50    CONTINUE
  67.    60 CONTINUE
  68. C
  69. C     ACCUMULATE Q FROM ITS FACTORED FORM.
  70. C
  71.       DO 120 L = 1, MINMN
  72.          K = MINMN - L + 1
  73.          DO 70 I = K, M
  74.             WA(I) = Q(I,K)
  75.             Q(I,K) = ZERO
  76.    70       CONTINUE
  77.          Q(K,K) = ONE
  78.          IF (WA(K) .EQ. ZERO) GO TO 110
  79.          DO 100 J = K, M
  80.             SUM = ZERO
  81.             DO 80 I = K, M
  82.                SUM = SUM + Q(I,J)*WA(I)
  83.    80          CONTINUE
  84.             TEMP = SUM/WA(K)
  85.             DO 90 I = K, M
  86.                Q(I,J) = Q(I,J) - TEMP*WA(I)
  87.    90          CONTINUE
  88.   100       CONTINUE
  89.   110    CONTINUE
  90.   120    CONTINUE
  91.       RETURN
  92. C
  93. C     LAST CARD OF SUBROUTINE QFORM.
  94. C
  95.       END
  96.