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