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
|
subroutine nnsc
* (n, r, c, il, jl, ijl, l, d, iu, ju, iju, u, z, b, tmp)
clll. optimize
c*** subroutine nnsc
c*** numerical solution of sparse nonsymmetric system of linear
c equations given ldu-factorization (compressed pointer storage)
c
c
c input variables.. n, r, c, il, jl, ijl, l, d, iu, ju, iju, u, b
c output variables.. z
c
c parameters used internally..
c fia - tmp - temporary vector which gets result of solving ly = b.
c - size = n.
c
c internal variables..
c jmin, jmax - indices of the first and last positions in a row of
c u or l to be used.
c
integer r(1), c(1), il(1), jl(1), ijl(1), iu(1), ju(1), iju(1)
double precision l(1), d(1), u(1), b(1), z(1), tmp(1), tmpk,sum
c
c ****** set tmp to reordered b *************************************
do 1 k=1,n
1 tmp(k) = b(r(k))
c ****** solve ly = b by forward substitution *********************
do 3 k=1,n
jmin = il(k)
jmax = il(k+1) - 1
tmpk = -d(k) * tmp(k)
tmp(k) = -tmpk
if (jmin .gt. jmax) go to 3
ml = ijl(k) - jmin
do 2 j=jmin,jmax
2 tmp(jl(ml+j)) = tmp(jl(ml+j)) + tmpk * l(j)
3 continue
c ****** solve ux = y by back substitution ************************
k = n
do 6 i=1,n
sum = -tmp(k)
jmin = iu(k)
jmax = iu(k+1) - 1
if (jmin .gt. jmax) go to 5
mu = iju(k) - jmin
do 4 j=jmin,jmax
4 sum = sum + u(j) * tmp(ju(mu+j))
5 tmp(k) = -sum
z(c(k)) = -sum
k = k - 1
6 continue
return
end
|