Mercurial > hg > octave-nkf

annotate libcruft/lapack/dlasdt.f @ 9607:1be3c73ed7b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
reuse temporary arrays in nested expressions
author Jaroslav Hajek <highegg@gmail.com>
date Thu, 03 Sep 2009 08:48:51 +0200
parents b48d486f641d
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
7072
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
1 SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
2 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
3 * -- LAPACK auxiliary routine (version 3.1) --
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
5 * November 2006
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
6 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
7 * .. Scalar Arguments ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
8 INTEGER LVL, MSUB, N, ND
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
9 * ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
10 * .. Array Arguments ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
11 INTEGER INODE( * ), NDIML( * ), NDIMR( * )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
12 * ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
13 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
14 * Purpose
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
15 * =======
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
16 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
17 * DLASDT creates a tree of subproblems for bidiagonal divide and
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
18 * conquer.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
19 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
20 * Arguments
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
21 * =========
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
22 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
23 * N (input) INTEGER
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
24 * On entry, the number of diagonal elements of the
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
25 * bidiagonal matrix.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
26 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
27 * LVL (output) INTEGER
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
28 * On exit, the number of levels on the computation tree.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
29 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
30 * ND (output) INTEGER
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
31 * On exit, the number of nodes on the tree.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
32 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
33 * INODE (output) INTEGER array, dimension ( N )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
34 * On exit, centers of subproblems.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
35 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
36 * NDIML (output) INTEGER array, dimension ( N )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
37 * On exit, row dimensions of left children.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
38 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
39 * NDIMR (output) INTEGER array, dimension ( N )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
40 * On exit, row dimensions of right children.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
41 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
42 * MSUB (input) INTEGER.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
43 * On entry, the maximum row dimension each subproblem at the
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
44 * bottom of the tree can be of.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
45 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
46 * Further Details
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
47 * ===============
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
48 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
49 * Based on contributions by
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
50 * Ming Gu and Huan Ren, Computer Science Division, University of
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
51 * California at Berkeley, USA
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
52 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
53 * =====================================================================
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
54 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
55 * .. Parameters ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
56 DOUBLE PRECISION TWO
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
57 PARAMETER ( TWO = 2.0D+0 )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
58 * ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
59 * .. Local Scalars ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
60 INTEGER I, IL, IR, LLST, MAXN, NCRNT, NLVL
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
61 DOUBLE PRECISION TEMP
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
62 * ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
63 * .. Intrinsic Functions ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
64 INTRINSIC DBLE, INT, LOG, MAX
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
65 * ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
66 * .. Executable Statements ..
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
67 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
68 * Find the number of levels on the tree.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
69 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
70 MAXN = MAX( 1, N )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
71 TEMP = LOG( DBLE( MAXN ) / DBLE( MSUB+1 ) ) / LOG( TWO )
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
72 LVL = INT( TEMP ) + 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
73 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
74 I = N / 2
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
75 INODE( 1 ) = I + 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
76 NDIML( 1 ) = I
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
77 NDIMR( 1 ) = N - I - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
78 IL = 0
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
79 IR = 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
80 LLST = 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
81 DO 20 NLVL = 1, LVL - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
82 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
83 * Constructing the tree at (NLVL+1)-st level. The number of
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
84 * nodes created on this level is LLST * 2.
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
85 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
86 DO 10 I = 0, LLST - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
87 IL = IL + 2
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
88 IR = IR + 2
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
89 NCRNT = LLST + I
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
90 NDIML( IL ) = NDIML( NCRNT ) / 2
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
91 NDIMR( IL ) = NDIML( NCRNT ) - NDIML( IL ) - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
92 INODE( IL ) = INODE( NCRNT ) - NDIMR( IL ) - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
93 NDIML( IR ) = NDIMR( NCRNT ) / 2
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
94 NDIMR( IR ) = NDIMR( NCRNT ) - NDIML( IR ) - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
95 INODE( IR ) = INODE( NCRNT ) + NDIML( IR ) + 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
96 10 CONTINUE
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
97 LLST = LLST*2
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
98 20 CONTINUE
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
99 ND = LLST*2 - 1
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
100 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
101 RETURN
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
102 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
103 * End of DLASDT
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
104 *
b48d486f641d [project @ 2007-10-26 15:52:57 by jwe]
jwe
parents:
diff changeset
105 END