NLSL
dchex.f90
Go to the documentation of this file.
1  subroutine dchex(r,ldr,p,k,l,z,ldz,nz,c,s,job)
2  integer ldr,p,k,l,ldz,nz,job
3  double precision r(ldr,1),z(ldz,1),s(1)
4  double precision c(1)
5 c
6 c dchex updates the cholesky factorization
7 c
8 c a = trans(r)*r
9 c
10 c of a positive definite matrix a of order p under diagonal
11 c permutations of the form
12 c
13 c trans(e)*a*e
14 c
15 c where e is a permutation matrix. specifically, given
16 c an upper triangular matrix r and a permutation matrix
17 c e (which is specified by k, l, and job), dchex determines
18 c a orthogonal matrix u such that
19 c
20 c u*r*e = rr,
21 c
22 c where rr is upper triangular. at the users option, the
23 c transformation u will be multiplied into the array z.
24 c if a = trans(x)*x, so that r is the triangular part of the
25 c qr factorization of x, then rr is the triangular part of the
26 c qr factorization of x*e, i.e. x with its columns permuted.
27 c for a less terse description of what dchex does and how
28 c it may be applied, see the linpack guide.
29 c
30 c the matrix q is determined as the product u(l-k)*...*u(1)
31 c of plane rotations of the form
32 c
33 c ( c(i) s(i) )
34 c ( ) ,
35 c ( -s(i) c(i) )
36 c
37 c where c(i) is double precision, the rows these rotations operate
38 c on are described below.
39 c
40 c there are two types of permutations, which are determined
41 c by the value of job.
42 c
43 c 1. right circular shift (job = 1).
44 c
45 c the columns are rearranged in the following order.
46 c
47 c 1,...,k-1,l,k,k+1,...,l-1,l+1,...,p.
48 c
49 c u is the product of l-k rotations u(i), where u(i)
50 c acts in the (l-i,l-i+1)-plane.
51 c
52 c 2. left circular shift (job = 2).
53 c the columns are rearranged in the following order
54 c
55 c 1,...,k-1,k+1,k+2,...,l,k,l+1,...,p.
56 c
57 c u is the product of l-k rotations u(i), where u(i)
58 c acts in the (k+i-1,k+i)-plane.
59 c
60 c on entry
61 c
62 c r double precision(ldr,p), where ldr.ge.p.
63 c r contains the upper triangular factor
64 c that is to be updated. elements of r
65 c below the diagonal are not referenced.
66 c
67 c ldr integer.
68 c ldr is the leading dimension of the array r.
69 c
70 c p integer.
71 c p is the order of the matrix r.
72 c
73 c k integer.
74 c k is the first column to be permuted.
75 c
76 c l integer.
77 c l is the last column to be permuted.
78 c l must be strictly greater than k.
79 c
80 c z double precision(ldz,nz), where ldz.ge.p.
81 c z is an array of nz p-vectors into which the
82 c transformation u is multiplied. z is
83 c not referenced if nz = 0.
84 c
85 c ldz integer.
86 c ldz is the leading dimension of the array z.
87 c
88 c nz integer.
89 c nz is the number of columns of the matrix z.
90 c
91 c job integer.
92 c job determines the type of permutation.
93 c job = 1 right circular shift.
94 c job = 2 left circular shift.
95 c
96 c on return
97 c
98 c r contains the updated factor.
99 c
100 c z contains the updated matrix z.
101 c
102 c c double precision(p).
103 c c contains the cosines of the transforming rotations.
104 c
105 c s double precision(p).
106 c s contains the sines of the transforming rotations.
107 c
108 c linpack. this version dated 08/14/78 .
109 c g.w. stewart, university of maryland, argonne national lab.
110 c
111 c dchex uses the following functions and subroutines.
112 c
113 c blas drotg
114 c fortran min0
115 c
116  integer i,ii,il,iu,j,jj,km1,kp1,lmk,lm1
117  double precision rjp1j,t
118 c
119 c initialize
120 c
121  km1 = k - 1
122  kp1 = k + 1
123  lmk = l - k
124  lm1 = l - 1
125 c
126 c perform the appropriate task.
127 c
128  go to (10,130), job
129 c
130 c right circular shift.
131 c
132  10 continue
133 c
134 c reorder the columns.
135 c
136  do 20 i = 1, l
137  ii = l - i + 1
138  s(i) = r(ii,l)
139  20 continue
140  do 40 jj = k, lm1
141  j = lm1 - jj + k
142  do 30 i = 1, j
143  r(i,j+1) = r(i,j)
144  30 continue
145  r(j+1,j+1) = 0.0d0
146  40 continue
147  if (k .eq. 1) go to 60
148  do 50 i = 1, km1
149  ii = l - i + 1
150  r(i,k) = s(ii)
151  50 continue
152  60 continue
153 c
154 c calculate the rotations.
155 c
156  t = s(1)
157  do 70 i = 1, lmk
158  call drotg(s(i+1),t,c(i),s(i))
159  t = s(i+1)
160  70 continue
161  r(k,k) = t
162  do 90 j = kp1, p
163  il = max0(1,l-j+1)
164  do 80 ii = il, lmk
165  i = l - ii
166  t = c(ii)*r(i,j) + s(ii)*r(i+1,j)
167  r(i+1,j) = c(ii)*r(i+1,j) - s(ii)*r(i,j)
168  r(i,j) = t
169  80 continue
170  90 continue
171 c
172 c if required, apply the transformations to z.
173 c
174  if (nz .lt. 1) go to 120
175  do 110 j = 1, nz
176  do 100 ii = 1, lmk
177  i = l - ii
178  t = c(ii)*z(i,j) + s(ii)*z(i+1,j)
179  z(i+1,j) = c(ii)*z(i+1,j) - s(ii)*z(i,j)
180  z(i,j) = t
181  100 continue
182  110 continue
183  120 continue
184  go to 260
185 c
186 c left circular shift
187 c
188  130 continue
189 c
190 c reorder the columns
191 c
192  do 140 i = 1, k
193  ii = lmk + i
194  s(ii) = r(i,k)
195  140 continue
196  do 160 j = k, lm1
197  do 150 i = 1, j
198  r(i,j) = r(i,j+1)
199  150 continue
200  jj = j - km1
201  s(jj) = r(j+1,j+1)
202  160 continue
203  do 170 i = 1, k
204  ii = lmk + i
205  r(i,l) = s(ii)
206  170 continue
207  do 180 i = kp1, l
208  r(i,l) = 0.0d0
209  180 continue
210 c
211 c reduction loop.
212 c
213  do 220 j = k, p
214  if (j .eq. k) go to 200
215 c
216 c apply the rotations.
217 c
218  iu = min0(j-1,l-1)
219  do 190 i = k, iu
220  ii = i - k + 1
221  t = c(ii)*r(i,j) + s(ii)*r(i+1,j)
222  r(i+1,j) = c(ii)*r(i+1,j) - s(ii)*r(i,j)
223  r(i,j) = t
224  190 continue
225  200 continue
226  if (j .ge. l) go to 210
227  jj = j - k + 1
228  t = s(jj)
229  call drotg(r(j,j),t,c(jj),s(jj))
230  210 continue
231  220 continue
232 c
233 c apply the rotations to z.
234 c
235  if (nz .lt. 1) go to 250
236  do 240 j = 1, nz
237  do 230 i = k, lm1
238  ii = i - km1
239  t = c(ii)*z(i,j) + s(ii)*z(i+1,j)
240  z(i+1,j) = c(ii)*z(i+1,j) - s(ii)*z(i,j)
241  z(i,j) = t
242  230 continue
243  240 continue
244  250 continue
245  260 continue
246  return
247  end
dchex
subroutine dchex(r, ldr, p, k, l, z, ldz, nz, c, s, job)
Definition: dchex.f90:2
drotg
subroutine drotg(da, db, c, s)
Definition: drotg.f90:2