share/odepack/fortran/nntc.f

   1       subroutine nntc
   2      *     (n, r, c, il, jl, ijl, l, d, iu, ju, iju, u, z, b, tmp)
   3 c*** subroutine nntc
   4 c*** numeric solution of the transpose of a sparse nonsymmetric system
   5 c      of linear equations given lu-factorization (compressed pointer
   6 c      storage)
   7 c
   8 c
   9 c       input variables..  n, r, c, il, jl, ijl, l, d, iu, ju, iju, u, b
  10 c       output variables.. z
  11 c
  12 c       parameters used internally..
  13 c fia   - tmp   - temporary vector which gets result of solving ut y = b
  14 c       -           size = n.
  15 c
  16 c  internal variables..
  17 c    jmin, jmax - indices of the first and last positions in a row of
  18 c      u or l  to be used.
  19 c
  20       integer r(*), c(*), il(*), jl(*), ijl(*), iu(*), ju(*), iju(*)
  21 c     real l(*), d(*), u(*), b(*), z(*), tmp(*), tmpk,sum
  22       double precision l(*), d(*), u(*), b(*), z(*), tmp(*), tmpk,sum
  23 c
  24 c  ******  set tmp to reordered b  *************************************
  25       do 1 k=1,n
  26    1    tmp(k) = b(c(k))
  27 c  ******  solve  ut y = b  by forward substitution  *******************
  28       do 3 k=1,n
  29         jmin = iu(k)
  30         jmax = iu(k+1) - 1
  31         tmpk = -tmp(k)
  32         if (jmin .gt. jmax) go to 3
  33         mu = iju(k) - jmin
  34         do 2 j=jmin,jmax
  35    2      tmp(ju(mu+j)) = tmp(ju(mu+j)) + tmpk * u(j)
  36    3    continue
  37 c  ******  solve  lt x = y  by back substitution  **********************
  38       k = n
  39       do 6 i=1,n
  40         sum = -tmp(k)
  41         jmin = il(k)
  42         jmax = il(k+1) - 1
  43         if (jmin .gt. jmax) go to 5
  44         ml = ijl(k) - jmin
  45         do 4 j=jmin,jmax
  46    4      sum = sum + l(j) * tmp(jl(ml+j))
  47    5    tmp(k) = -sum * d(k)
  48         z(r(k)) = tmp(k)
  49         k = k - 1
  50    6    continue
  51       return
  52       end