-
Notifications
You must be signed in to change notification settings - Fork 315
/
dqrutl.f
71 lines (66 loc) · 1.87 KB
/
dqrutl.f
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
c dqr Utilities: Interface to the different "switches" of dqrsl().
c
subroutine dqrqty(x, n, k, qraux, y, ny, qty)
implicit none
integer n, k, ny
double precision x(n,k), qraux(k), y(n,ny), qty(n,ny)
integer info, j
double precision dummy
do 10 j = 1,ny
call dqrsl(x, n, n, k, qraux, y(1,j), dummy, qty(1,j),
& dummy, dummy, dummy, 1000, info)
10 continue
return
end
c
subroutine dqrqy(x, n, k, qraux, y, ny, qy)
implicit none
integer n, k, ny
double precision x(n,k), qraux(k), y(n,ny), qy(n,ny)
integer info, j
double precision dummy
do 10 j = 1,ny
call dqrsl(x, n, n, k, qraux, y(1,j), qy(1,j),
& dummy, dummy, dummy, dummy, 10000, info)
10 continue
return
end
c
subroutine dqrcf(x, n, k, qraux, y, ny, b, info)
implicit none
integer n, k, ny, info
double precision x(n,k), qraux(k), y(n,ny), b(k,ny)
integer j
double precision dummy
do 10 j = 1,ny
call dqrsl(x, n, n, k, qraux, y(1,j), dummy,
& y(1,j), b(1,j), dummy, dummy, 100, info)
10 continue
return
end
c
subroutine dqrrsd(x, n, k, qraux, y, ny, rsd)
implicit none
integer n, k, ny
double precision x(n,k), qraux(k), y(n,ny), rsd(n,ny)
integer info, j
double precision dummy
do 10 j = 1,ny
call dqrsl(x, n, n, k, qraux, y(1,j), dummy,
& y(1,j), dummy, rsd(1,j), dummy, 10, info)
10 continue
return
end
c
subroutine dqrxb(x, n, k, qraux, y, ny, xb)
implicit none
integer n, k, ny
double precision x(n,k), qraux(k), y(n,k), xb(n,ny)
integer info, j
double precision dummy
do 10 j = 1,ny
call dqrsl(x, n, n, k, qraux, y(1,j), dummy,
& y(1,j), dummy, dummy, xb(1,j), 1, info)
10 continue
return
end