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

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dbndac.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:
 
1
*DECK DBNDAC
 
2
      SUBROUTINE DBNDAC (G, MDG, NB, IP, IR, MT, JT)
 
3
C***BEGIN PROLOGUE  DBNDAC
 
4
C***PURPOSE  Compute the LU factorization of a  banded matrices using
 
5
C            sequential accumulation of rows of the data matrix.
 
6
C            Exactly one right-hand side vector is permitted.
 
7
C***LIBRARY   SLATEC
 
8
C***CATEGORY  D9
 
9
C***TYPE      DOUBLE PRECISION (BNDACC-S, DBNDAC-D)
 
10
C***KEYWORDS  BANDED MATRIX, CURVE FITTING, LEAST SQUARES
 
11
C***AUTHOR  Lawson, C. L., (JPL)
 
12
C           Hanson, R. J., (SNLA)
 
13
C***DESCRIPTION
 
14
C
 
15
C     These subroutines solve the least squares problem Ax = b for
 
16
C     banded matrices A using sequential accumulation of rows of the
 
17
C     data matrix.  Exactly one right-hand side vector is permitted.
 
18
C
 
19
C     These subroutines are intended for the type of least squares
 
20
C     systems that arise in applications such as curve or surface
 
21
C     fitting of data.  The least squares equations are accumulated and
 
22
C     processed using only part of the data.  This requires a certain
 
23
C     user interaction during the solution of Ax = b.
 
24
C
 
25
C     Specifically, suppose the data matrix (A B) is row partitioned
 
26
C     into Q submatrices.  Let (E F) be the T-th one of these
 
27
C     submatrices where E = (0 C 0).  Here the dimension of E is MT by N
 
28
C     and the dimension of C is MT by NB.  The value of NB is the
 
29
C     bandwidth of A.  The dimensions of the leading block of zeros in E
 
30
C     are MT by JT-1.
 
31
C
 
32
C     The user of the subroutine DBNDAC provides MT,JT,C and F for
 
33
C     T=1,...,Q.  Not all of this data must be supplied at once.
 
34
C
 
35
C     Following the processing of the various blocks (E F), the matrix
 
36
C     (A B) has been transformed to the form (R D) where R is upper
 
37
C     triangular and banded with bandwidth NB.  The least squares
 
38
C     system Rx = d is then easily solved using back substitution by
 
39
C     executing the statement CALL DBNDSL(1,...). The sequence of
 
40
C     values for JT must be nondecreasing.  This may require some
 
41
C     preliminary interchanges of rows and columns of the matrix A.
 
42
C
 
43
C     The primary reason for these subroutines is that the total
 
44
C     processing can take place in a working array of dimension MU by
 
45
C     NB+1.  An acceptable value for MU is
 
46
C
 
47
C                       MU = MAX(MT + N + 1),
 
48
C
 
49
C     where N is the number of unknowns.
 
50
C
 
51
C     Here the maximum is taken over all values of MT for T=1,...,Q.
 
52
C     Notice that MT can be taken to be a small as one, showing that
 
53
C     MU can be as small as N+2.  The subprogram DBNDAC processes the
 
54
C     rows more efficiently if MU is large enough so that each new
 
55
C     block (C F) has a distinct value of JT.
 
56
C
 
57
C     The four principle parts of these algorithms are obtained by the
 
58
C     following call statements
 
59
C
 
60
C     CALL DBNDAC(...)  Introduce new blocks of data.
 
61
C
 
62
C     CALL DBNDSL(1,...)Compute solution vector and length of
 
63
C                       residual vector.
 
64
C
 
65
C     CALL DBNDSL(2,...)Given any row vector H solve YR = H for the
 
66
C                       row vector Y.
 
67
C
 
68
C     CALL DBNDSL(3,...)Given any column vector W solve RZ = W for
 
69
C                       the column vector Z.
 
70
C
 
71
C     The dots in the above call statements indicate additional
 
72
C     arguments that will be specified in the following paragraphs.
 
73
C
 
74
C     The user must dimension the array appearing in the call list..
 
75
C     G(MDG,NB+1)
 
76
C
 
77
C     Description of calling sequence for DBNDAC..
 
78
C
 
79
C     The entire set of parameters for DBNDAC are
 
80
C
 
81
C     Input.. All Type REAL variables are DOUBLE PRECISION
 
82
C
 
83
C     G(*,*)            The working array into which the user will
 
84
C                       place the MT by NB+1 block (C F) in rows IR
 
85
C                       through IR+MT-1, columns 1 through NB+1.
 
86
C                       See descriptions of IR and MT below.
 
87
C
 
88
C     MDG               The number of rows in the working array
 
89
C                       G(*,*).  The value of MDG should be .GE. MU.
 
90
C                       The value of MU is defined in the abstract
 
91
C                       of these subprograms.
 
92
C
 
93
C     NB                The bandwidth of the data matrix A.
 
94
C
 
95
C     IP                Set by the user to the value 1 before the
 
96
C                       first call to DBNDAC.  Its subsequent value
 
97
C                       is controlled by DBNDAC to set up for the
 
98
C                       next call to DBNDAC.
 
99
C
 
100
C     IR                Index of the row of G(*,*) where the user is
 
101
C                       to place the new block of data (C F).  Set by
 
102
C                       the user to the value 1 before the first call
 
103
C                       to DBNDAC.  Its subsequent value is controlled
 
104
C                       by DBNDAC. A value of IR .GT. MDG is considered
 
105
C                       an error.
 
106
C
 
107
C     MT,JT             Set by the user to indicate respectively the
 
108
C                       number of new rows of data in the block and
 
109
C                       the index of the first nonzero column in that
 
110
C                       set of rows (E F) = (0 C 0 F) being processed.
 
111
C
 
112
C     Output.. All Type REAL variables are DOUBLE PRECISION
 
113
C
 
114
C     G(*,*)            The working array which will contain the
 
115
C                       processed rows of that part of the data
 
116
C                       matrix which has been passed to DBNDAC.
 
117
C
 
118
C     IP,IR             The values of these arguments are advanced by
 
119
C                       DBNDAC to be ready for storing and processing
 
120
C                       a new block of data in G(*,*).
 
121
C
 
122
C     Description of calling sequence for DBNDSL..
 
123
C
 
124
C     The user must dimension the arrays appearing in the call list..
 
125
C
 
126
C     G(MDG,NB+1), X(N)
 
127
C
 
128
C     The entire set of parameters for DBNDSL are
 
129
C
 
130
C     Input.. All Type REAL variables are DOUBLE PRECISION
 
131
C
 
132
C     MODE              Set by the user to one of the values 1, 2, or
 
133
C                       3.  These values respectively indicate that
 
134
C                       the solution of AX = B, YR = H or RZ = W is
 
135
C                       required.
 
136
C
 
137
C     G(*,*),MDG,       These arguments all have the same meaning and
 
138
C      NB,IP,IR         contents as following the last call to DBNDAC.
 
139
C
 
140
C     X(*)              With mode=2 or 3 this array contains,
 
141
C                       respectively, the right-side vectors H or W of
 
142
C                       the systems YR = H or RZ = W.
 
143
C
 
144
C     N                 The number of variables in the solution
 
145
C                       vector.  If any of the N diagonal terms are
 
146
C                       zero the subroutine DBNDSL prints an
 
147
C                       appropriate message.  This condition is
 
148
C                       considered an error.
 
149
C
 
150
C     Output.. All Type REAL variables are DOUBLE PRECISION
 
151
C
 
152
C     X(*)              This array contains the solution vectors X,
 
153
C                       Y or Z of the systems AX = B, YR = H or
 
154
C                       RZ = W depending on the value of MODE=1,
 
155
C                       2 or 3.
 
156
C
 
157
C     RNORM             If MODE=1 RNORM is the Euclidean length of the
 
158
C                       residual vector AX-B.  When MODE=2 or 3 RNORM
 
159
C                       is set to zero.
 
160
C
 
161
C     Remarks..
 
162
C
 
163
C     To obtain the upper triangular matrix and transformed right-hand
 
164
C     side vector D so that the super diagonals of R form the columns
 
165
C     of G(*,*), execute the following Fortran statements.
 
166
C
 
167
C     NBP1=NB+1
 
168
C
 
169
C     DO 10 J=1, NBP1
 
170
C
 
171
C  10 G(IR,J) = 0.E0
 
172
C
 
173
C     MT=1
 
174
C
 
175
C     JT=N+1
 
176
C
 
177
C     CALL DBNDAC(G,MDG,NB,IP,IR,MT,JT)
 
178
C
 
179
C***REFERENCES  C. L. Lawson and R. J. Hanson, Solving Least Squares
 
180
C                 Problems, Prentice-Hall, Inc., 1974, Chapter 27.
 
181
C***ROUTINES CALLED  DH12, XERMSG
 
182
C***REVISION HISTORY  (YYMMDD)
 
183
C   790101  DATE WRITTEN
 
184
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
185
C   891006  Cosmetic changes to prologue.  (WRB)
 
186
C   891006  REVISION DATE from Version 3.2
 
187
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
188
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
 
189
C   920501  Reformatted the REFERENCES section.  (WRB)
 
190
C***END PROLOGUE  DBNDAC
 
191
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
 
192
      DIMENSION G(MDG,*)
 
193
C***FIRST EXECUTABLE STATEMENT  DBNDAC
 
194
      ZERO=0.D0
 
195
C
 
196
C              ALG. STEPS 1-4 ARE PERFORMED EXTERNAL TO THIS SUBROUTINE.
 
197
C
 
198
      NBP1=NB+1
 
199
      IF (MT.LE.0.OR.NB.LE.0) RETURN
 
200
C
 
201
      IF(.NOT.MDG.LT.IR) GO TO 5
 
202
      NERR=1
 
203
      IOPT=2
 
204
      CALL XERMSG ('SLATEC', 'DBNDAC', 'MDG.LT.IR, PROBABLE ERROR.',
 
205
     +   NERR, IOPT)
 
206
      RETURN
 
207
    5 CONTINUE
 
208
C
 
209
C                                             ALG. STEP 5
 
210
      IF (JT.EQ.IP) GO TO 70
 
211
C                                             ALG. STEPS 6-7
 
212
      IF (JT.LE.IR) GO TO 30
 
213
C                                             ALG. STEPS 8-9
 
214
      DO 10 I=1,MT
 
215
        IG1=JT+MT-I
 
216
        IG2=IR+MT-I
 
217
        DO 10 J=1,NBP1
 
218
        G(IG1,J)=G(IG2,J)
 
219
   10 CONTINUE
 
220
C                                             ALG. STEP 10
 
221
      IE=JT-IR
 
222
      DO 20 I=1,IE
 
223
        IG=IR+I-1
 
224
        DO 20 J=1,NBP1
 
225
        G(IG,J)=ZERO
 
226
   20 CONTINUE
 
227
C                                             ALG. STEP 11
 
228
      IR=JT
 
229
C                                             ALG. STEP 12
 
230
   30 MU=MIN(NB-1,IR-IP-1)
 
231
      IF (MU.EQ.0) GO TO 60
 
232
C                                             ALG. STEP 13
 
233
      DO 50 L=1,MU
 
234
C                                             ALG. STEP 14
 
235
        K=MIN(L,JT-IP)
 
236
C                                             ALG. STEP 15
 
237
        LP1=L+1
 
238
        IG=IP+L
 
239
        DO 40 I=LP1,NB
 
240
          JG=I-K
 
241
          G(IG,JG)=G(IG,I)
 
242
   40 CONTINUE
 
243
C                                             ALG. STEP 16
 
244
        DO 50 I=1,K
 
245
        JG=NBP1-I
 
246
        G(IG,JG)=ZERO
 
247
   50 CONTINUE
 
248
C                                             ALG. STEP 17
 
249
   60 IP=JT
 
250
C                                             ALG. STEPS 18-19
 
251
   70 MH=IR+MT-IP
 
252
      KH=MIN(NBP1,MH)
 
253
C                                             ALG. STEP 20
 
254
      DO 80 I=1,KH
 
255
        CALL DH12 (1,I,MAX(I+1,IR-IP+1),MH,G(IP,I),1,RHO,
 
256
     1            G(IP,I+1),1,MDG,NBP1-I)
 
257
   80 CONTINUE
 
258
C                                             ALG. STEP 21
 
259
      IR=IP+KH
 
260
C                                             ALG. STEP 22
 
261
      IF (KH.LT.NBP1) GO TO 100
 
262
C                                             ALG. STEP 23
 
263
      DO 90 I=1,NB
 
264
        G(IR-1,I)=ZERO
 
265
   90 CONTINUE
 
266
C                                             ALG. STEP 24
 
267
  100 CONTINUE
 
268
C                                             ALG. STEP 25
 
269
      RETURN
 
270
      END