NLSL: dchex.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

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