001:       SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            LVL, MSUB, N, ND
010: *     ..
011: *     .. Array Arguments ..
012:       INTEGER            INODE( * ), NDIML( * ), NDIMR( * )
013: *     ..
014: *
015: *  Purpose
016: *  =======
017: *
018: *  DLASDT creates a tree of subproblems for bidiagonal divide and
019: *  conquer.
020: *
021: *  Arguments
022: *  =========
023: *
024: *   N      (input) INTEGER
025: *          On entry, the number of diagonal elements of the
026: *          bidiagonal matrix.
027: *
028: *   LVL    (output) INTEGER
029: *          On exit, the number of levels on the computation tree.
030: *
031: *   ND     (output) INTEGER
032: *          On exit, the number of nodes on the tree.
033: *
034: *   INODE  (output) INTEGER array, dimension ( N )
035: *          On exit, centers of subproblems.
036: *
037: *   NDIML  (output) INTEGER array, dimension ( N )
038: *          On exit, row dimensions of left children.
039: *
040: *   NDIMR  (output) INTEGER array, dimension ( N )
041: *          On exit, row dimensions of right children.
042: *
043: *   MSUB   (input) INTEGER.
044: *          On entry, the maximum row dimension each subproblem at the
045: *          bottom of the tree can be of.
046: *
047: *  Further Details
048: *  ===============
049: *
050: *  Based on contributions by
051: *     Ming Gu and Huan Ren, Computer Science Division, University of
052: *     California at Berkeley, USA
053: *
054: *  =====================================================================
055: *
056: *     .. Parameters ..
057:       DOUBLE PRECISION   TWO
058:       PARAMETER          ( TWO = 2.0D+0 )
059: *     ..
060: *     .. Local Scalars ..
061:       INTEGER            I, IL, IR, LLST, MAXN, NCRNT, NLVL
062:       DOUBLE PRECISION   TEMP
063: *     ..
064: *     .. Intrinsic Functions ..
065:       INTRINSIC          DBLE, INT, LOG, MAX
066: *     ..
067: *     .. Executable Statements ..
068: *
069: *     Find the number of levels on the tree.
070: *
071:       MAXN = MAX( 1, N )
072:       TEMP = LOG( DBLE( MAXN ) / DBLE( MSUB+1 ) ) / LOG( TWO )
073:       LVL = INT( TEMP ) + 1
074: *
075:       I = N / 2
076:       INODE( 1 ) = I + 1
077:       NDIML( 1 ) = I
078:       NDIMR( 1 ) = N - I - 1
079:       IL = 0
080:       IR = 1
081:       LLST = 1
082:       DO 20 NLVL = 1, LVL - 1
083: *
084: *        Constructing the tree at (NLVL+1)-st level. The number of
085: *        nodes created on this level is LLST * 2.
086: *
087:          DO 10 I = 0, LLST - 1
088:             IL = IL + 2
089:             IR = IR + 2
090:             NCRNT = LLST + I
091:             NDIML( IL ) = NDIML( NCRNT ) / 2
092:             NDIMR( IL ) = NDIML( NCRNT ) - NDIML( IL ) - 1
093:             INODE( IL ) = INODE( NCRNT ) - NDIMR( IL ) - 1
094:             NDIML( IR ) = NDIMR( NCRNT ) / 2
095:             NDIMR( IR ) = NDIMR( NCRNT ) - NDIML( IR ) - 1
096:             INODE( IR ) = INODE( NCRNT ) + NDIML( IR ) + 1
097:    10    CONTINUE
098:          LLST = LLST*2
099:    20 CONTINUE
100:       ND = LLST*2 - 1
101: *
102:       RETURN
103: *
104: *     End of DLASDT
105: *
106:       END
107: