Free cookie consent management tool by TermsFeed Policy Generator

source: branches/2789_MathNetNumerics-Exploration/HeuristicLab.Algorithms.DataAnalysis.Experimental/sbart/spbsl.f @ 16189

Last change on this file since 16189 was 15457, checked in by gkronber, 7 years ago

#2789 added Finbarr O'Sullivan smoothing spline code

File size: 2.0 KB
Line 
1      subroutine spbsl(abd,lda,n,m,b)
2      integer lda,n,m
3      real abd(lda,1),b(1)
4c
5c     spbsl solves the real symmetric positive definite band
6c     system  a*x = b
7c     using the factors computed by spbco or spbfa.
8c
9c     on entry
10c
11c        abd     real(lda, n)
12c                the output from spbco or spbfa.
13c
14c        lda     integer
15c                the leading dimension of the array  abd .
16c
17c        n       integer
18c                the order of the matrix  a .
19c
20c        m       integer
21c                the number of diagonals above the main diagonal.
22c
23c        b       real(n)
24c                the right hand side vector.
25c
26c     on return
27c
28c        b       the solution vector  x .
29c
30c     error condition
31c
32c        a division by zero will occur if the input factor contains
33c        a zero on the diagonal.  technically this indicates
34c        singularity but it is usually caused by improper subroutine
35c        arguments.  it will not occur if the subroutines are called
36c        correctly and  info .eq. 0 .
37c
38c     to compute  inverse(a) * c  where  c  is a matrix
39c     with  p  columns
40c           call spbco(abd,lda,n,rcond,z,info)
41c           if (rcond is too small .or. info .ne. 0) go to ...
42c           do 10 j = 1, p
43c              call spbsl(abd,lda,n,c(1,j))
44c        10 continue
45c
46c     linpack.  this version dated 08/14/78 .
47c     cleve moler, university of new mexico, argonne national lab.
48c
49c     subroutines and functions
50c
51c     blas saxpy,sdot
52c     fortran min0
53c
54c     internal variables
55c
56      real sdot,t
57      integer k,kb,la,lb,lm
58c
59c     solve trans(r)*y = b
60c
61      do 10 k = 1, n
62         lm = min0(k-1,m)
63         la = m + 1 - lm
64         lb = k - lm
65         t = sdot(lm,abd(la,k),1,b(lb),1)
66         b(k) = (b(k) - t)/abd(m+1,k)
67   10 continue
68c
69c     solve r*x = y
70c
71      do 20 kb = 1, n
72         k = n + 1 - kb
73         lm = min0(k-1,m)
74         la = m + 1 - lm
75         lb = k - lm
76         b(k) = b(k)/abd(m+1,k)
77         t = -b(k)
78         call saxpy(lm,t,abd(la,k),1,b(lb),1)
79   20 continue
80      return
81      end
Note: See TracBrowser for help on using the repository browser.