← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/cpbsl.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/cpbsl.f
 
1
*DECK CPBSL
 
2
      SUBROUTINE CPBSL (ABD, LDA, N, M, B)
 
3
C***BEGIN PROLOGUE  CPBSL
 
4
C***PURPOSE  Solve the complex Hermitian positive definite band system
 
5
C            using the factors computed by CPBCO or CPBFA.
 
6
C***LIBRARY   SLATEC (LINPACK)
 
7
C***CATEGORY  D2D2
 
8
C***TYPE      COMPLEX (SPBSL-S, DPBSL-D, CPBSL-C)
 
9
C***KEYWORDS  BANDED, LINEAR ALGEBRA, LINPACK, MATRIX,
 
10
C             POSITIVE DEFINITE, SOLVE
 
11
C***AUTHOR  Moler, C. B., (U. of New Mexico)
 
12
C***DESCRIPTION
 
13
C
 
14
C     CPBSL solves the complex Hermitian positive definite band
 
15
C     system  A*X = B
 
16
C     using the factors computed by CPBCO or CPBFA.
 
17
C
 
18
C     On Entry
 
19
C
 
20
C        ABD     COMPLEX(LDA, N)
 
21
C                the output from CPBCO or CPBFA.
 
22
C
 
23
C        LDA     INTEGER
 
24
C                the leading dimension of the array  ABD .
 
25
C
 
26
C        N       INTEGER
 
27
C                the order of the matrix  A .
 
28
C
 
29
C        M       INTEGER
 
30
C                the number of diagonals above the main diagonal.
 
31
C
 
32
C        B       COMPLEX(N)
 
33
C                the right hand side vector.
 
34
C
 
35
C     On Return
 
36
C
 
37
C        B       the solution vector  X .
 
38
C
 
39
C     Error Condition
 
40
C
 
41
C        A division by zero will occur if the input factor contains
 
42
C        a zero on the diagonal.  Technically this indicates
 
43
C        singularity but it is usually caused by improper subroutine
 
44
C        arguments.  It will not occur if the subroutines are called
 
45
C        correctly and  INFO .EQ. 0 .
 
46
C
 
47
C     To compute  INVERSE(A) * C  where  C  is a matrix
 
48
C     with  P  columns
 
49
C           CALL CPBCO(ABD,LDA,N,RCOND,Z,INFO)
 
50
C           IF (RCOND is too small .OR. INFO .NE. 0) GO TO ...
 
51
C           DO 10 J = 1, P
 
52
C              CALL CPBSL(ABD,LDA,N,C(1,J))
 
53
C        10 CONTINUE
 
54
C
 
55
C***REFERENCES  J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
 
56
C                 Stewart, LINPACK Users' Guide, SIAM, 1979.
 
57
C***ROUTINES CALLED  CAXPY, CDOTC
 
58
C***REVISION HISTORY  (YYMMDD)
 
59
C   780814  DATE WRITTEN
 
60
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
61
C   890831  Modified array declarations.  (WRB)
 
62
C   890831  REVISION DATE from Version 3.2
 
63
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
64
C   900326  Removed duplicate information from DESCRIPTION section.
 
65
C           (WRB)
 
66
C   920501  Reformatted the REFERENCES section.  (WRB)
 
67
C***END PROLOGUE  CPBSL
 
68
      INTEGER LDA,N,M
 
69
      COMPLEX ABD(LDA,*),B(*)
 
70
C
 
71
      COMPLEX CDOTC,T
 
72
      INTEGER K,KB,LA,LB,LM
 
73
C
 
74
C     SOLVE CTRANS(R)*Y = B
 
75
C
 
76
C***FIRST EXECUTABLE STATEMENT  CPBSL
 
77
      DO 10 K = 1, N
 
78
         LM = MIN(K-1,M)
 
79
         LA = M + 1 - LM
 
80
         LB = K - LM
 
81
         T = CDOTC(LM,ABD(LA,K),1,B(LB),1)
 
82
         B(K) = (B(K) - T)/ABD(M+1,K)
 
83
   10 CONTINUE
 
84
C
 
85
C     SOLVE R*X = Y
 
86
C
 
87
      DO 20 KB = 1, N
 
88
         K = N + 1 - KB
 
89
         LM = MIN(K-1,M)
 
90
         LA = M + 1 - LM
 
91
         LB = K - LM
 
92
         B(K) = B(K)/ABD(M+1,K)
 
93
         T = -B(K)
 
94
         CALL CAXPY(LM,T,ABD(LA,K),1,B(LB),1)
 
95
   20 CONTINUE
 
96
      RETURN
 
97
      END