slatmr()

subroutine slatmr	(	integer	m,
		integer	n,
		character	dist,
		integer, dimension( 4 )	iseed,
		character	sym,
		real, dimension( * )	d,
		integer	mode,
		real	cond,
		real	dmax,
		character	rsign,
		character	grade,
		real, dimension( * )	dl,
		integer	model,
		real	condl,
		real, dimension( * )	dr,
		integer	moder,
		real	condr,
		character	pivtng,
		integer, dimension( * )	ipivot,
		integer	kl,
		integer	ku,
		real	sparse,
		real	anorm,
		character	pack,
		real, dimension( lda, * )	a,
		integer	lda,
		integer, dimension( * )	iwork,
		integer	info )

SLATMR

Purpose:

!>
!>    SLATMR generates random matrices of various types for testing
!>    LAPACK programs.
!>
!>    SLATMR operates by applying the following sequence of
!>    operations:
!>
!>      Generate a matrix A with random entries of distribution DIST
!>         which is symmetric if SYM='S', and nonsymmetric
!>         if SYM='N'.
!>
!>      Set the diagonal to D, where D may be input or
!>         computed according to MODE, COND, DMAX and RSIGN
!>         as described below.
!>
!>      Grade the matrix, if desired, from the left and/or right
!>         as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
!>         MODER and CONDR also determine the grading as described
!>         below.
!>
!>      Permute, if desired, the rows and/or columns as specified by
!>         PIVTNG and IPIVOT.
!>
!>      Set random entries to zero, if desired, to get a random sparse
!>         matrix as specified by SPARSE.
!>
!>      Make A a band matrix, if desired, by zeroing out the matrix
!>         outside a band of lower bandwidth KL and upper bandwidth KU.
!>
!>      Scale A, if desired, to have maximum entry ANORM.
!>
!>      Pack the matrix if desired. Options specified by PACK are:
!>         no packing
!>         zero out upper half (if symmetric)
!>         zero out lower half (if symmetric)
!>         store the upper half columnwise (if symmetric or
!>             square upper triangular)
!>         store the lower half columnwise (if symmetric or
!>             square lower triangular)
!>             same as upper half rowwise if symmetric
!>         store the lower triangle in banded format (if symmetric)
!>         store the upper triangle in banded format (if symmetric)
!>         store the entire matrix in banded format
!>
!>    Note: If two calls to SLATMR differ only in the PACK parameter,
!>          they will generate mathematically equivalent matrices.
!>
!>          If two calls to SLATMR both have full bandwidth (KL = M-1
!>          and KU = N-1), and differ only in the PIVTNG and PACK
!>          parameters, then the matrices generated will differ only
!>          in the order of the rows and/or columns, and otherwise
!>          contain the same data. This consistency cannot be and
!>          is not maintained with less than full bandwidth.
!> 

Parameters

[in]	M	!> M is INTEGER !> Number of rows of A. Not modified. !>
[in]	N	!> N is INTEGER !> Number of columns of A. Not modified. !>
[in]	DIST	!> DIST is CHARACTER*1 !> On entry, DIST specifies the type of distribution to be used !> to generate a random matrix . !> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) !> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) !> 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) !> Not modified. !>
[in,out]	ISEED	!> ISEED is INTEGER array, dimension (4) !> On entry ISEED specifies the seed of the random number !> generator. They should lie between 0 and 4095 inclusive, !> and ISEED(4) should be odd. The random number generator !> uses a linear congruential sequence limited to small !> integers, and so should produce machine independent !> random numbers. The values of ISEED are changed on !> exit, and can be used in the next call to SLATMR !> to continue the same random number sequence. !> Changed on exit. !>
[in]	SYM	!> SYM is CHARACTER*1 !> If SYM='S' or 'H', generated matrix is symmetric. !> If SYM='N', generated matrix is nonsymmetric. !> Not modified. !>
[in]	D	!> D is REAL array, dimension (min(M,N)) !> On entry this array specifies the diagonal entries !> of the diagonal of A. D may either be specified !> on entry, or set according to MODE and COND as described !> below. May be changed on exit if MODE is nonzero. !>
[in]	MODE	!> MODE is INTEGER !> On entry describes how D is to be used: !> MODE = 0 means use D as input !> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND !> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND !> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) !> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) !> MODE = 5 sets D to random numbers in the range !> ( 1/COND , 1 ) such that their logarithms !> are uniformly distributed. !> MODE = 6 set D to random numbers from same distribution !> as the rest of the matrix. !> MODE < 0 has the same meaning as ABS(MODE), except that !> the order of the elements of D is reversed. !> Thus if MODE is positive, D has entries ranging from !> 1 to 1/COND, if negative, from 1/COND to 1, !> Not modified. !>
[in]	COND	!> COND is REAL !> On entry, used as described under MODE above. !> If used, it must be >= 1. Not modified. !>
[in]	DMAX	!> DMAX is REAL !> If MODE neither -6, 0 nor 6, the diagonal is scaled by !> DMAX / max(abs(D(i))), so that maximum absolute entry !> of diagonal is abs(DMAX). If DMAX is negative (or zero), !> diagonal will be scaled by a negative number (or zero). !>
[in]	RSIGN	!> RSIGN is CHARACTER*1 !> If MODE neither -6, 0 nor 6, specifies sign of diagonal !> as follows: !> 'T' => diagonal entries are multiplied by 1 or -1 !> with probability .5 !> 'F' => diagonal unchanged !> Not modified. !>
[in]	GRADE	!> GRADE is CHARACTER*1 !> Specifies grading of matrix as follows: !> 'N' => no grading !> 'L' => matrix premultiplied by diag( DL ) !> (only if matrix nonsymmetric) !> 'R' => matrix postmultiplied by diag( DR ) !> (only if matrix nonsymmetric) !> 'B' => matrix premultiplied by diag( DL ) and !> postmultiplied by diag( DR ) !> (only if matrix nonsymmetric) !> 'S' or 'H' => matrix premultiplied by diag( DL ) and !> postmultiplied by diag( DL ) !> ('S' for symmetric, or 'H' for Hermitian) !> 'E' => matrix premultiplied by diag( DL ) and !> postmultiplied by inv( diag( DL ) ) !> ( 'E' for eigenvalue invariance) !> (only if matrix nonsymmetric) !> Note: if GRADE='E', then M must equal N. !> Not modified. !>
[in,out]	DL	!> DL is REAL array, dimension (M) !> If MODEL=0, then on entry this array specifies the diagonal !> entries of a diagonal matrix used as described under GRADE !> above. If MODEL is not zero, then DL will be set according !> to MODEL and CONDL, analogous to the way D is set according !> to MODE and COND (except there is no DMAX parameter for DL). !> If GRADE='E', then DL cannot have zero entries. !> Not referenced if GRADE = 'N' or 'R'. Changed on exit. !>
[in]	MODEL	!> MODEL is INTEGER !> This specifies how the diagonal array DL is to be computed, !> just as MODE specifies how D is to be computed. !> Not modified. !>
[in]	CONDL	!> CONDL is REAL !> When MODEL is not zero, this specifies the condition number !> of the computed DL. Not modified. !>
[in,out]	DR	!> DR is REAL array, dimension (N) !> If MODER=0, then on entry this array specifies the diagonal !> entries of a diagonal matrix used as described under GRADE !> above. If MODER is not zero, then DR will be set according !> to MODER and CONDR, analogous to the way D is set according !> to MODE and COND (except there is no DMAX parameter for DR). !> Not referenced if GRADE = 'N', 'L', 'H', 'S' or 'E'. !> Changed on exit. !>
[in]	MODER	!> MODER is INTEGER !> This specifies how the diagonal array DR is to be computed, !> just as MODE specifies how D is to be computed. !> Not modified. !>
[in]	CONDR	!> CONDR is REAL !> When MODER is not zero, this specifies the condition number !> of the computed DR. Not modified. !>
[in]	PIVTNG	!> PIVTNG is CHARACTER*1 !> On entry specifies pivoting permutations as follows: !> 'N' or ' ' => none. !> 'L' => left or row pivoting (matrix must be nonsymmetric). !> 'R' => right or column pivoting (matrix must be !> nonsymmetric). !> 'B' or 'F' => both or full pivoting, i.e., on both sides. !> In this case, M must equal N !> !> If two calls to SLATMR both have full bandwidth (KL = M-1 !> and KU = N-1), and differ only in the PIVTNG and PACK !> parameters, then the matrices generated will differ only !> in the order of the rows and/or columns, and otherwise !> contain the same data. This consistency cannot be !> maintained with less than full bandwidth. !>
[in]	IPIVOT	!> IPIVOT is INTEGER array, dimension (N or M) !> This array specifies the permutation used. After the !> basic matrix is generated, the rows, columns, or both !> are permuted. If, say, row pivoting is selected, SLATMR !> starts with the *last* row and interchanges the M-th and !> IPIVOT(M)-th rows, then moves to the next-to-last row, !> interchanging the (M-1)-th and the IPIVOT(M-1)-th rows, !> and so on. In terms of , the permutation is !> (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M)) !> where the rightmost cycle is applied first. This is the !> *inverse* of the effect of pivoting in LINPACK. The idea !> is that factoring (with pivoting) an identity matrix !> which has been inverse-pivoted in this way should !> result in a pivot vector identical to IPIVOT. !> Not referenced if PIVTNG = 'N'. Not modified. !>
[in]	KL	!> KL is INTEGER !> On entry specifies the lower bandwidth of the matrix. For !> example, KL=0 implies upper triangular, KL=1 implies upper !> Hessenberg, and KL at least M-1 implies the matrix is not !> banded. Must equal KU if matrix is symmetric. !> Not modified. !>
[in]	KU	!> KU is INTEGER !> On entry specifies the upper bandwidth of the matrix. For !> example, KU=0 implies lower triangular, KU=1 implies lower !> Hessenberg, and KU at least N-1 implies the matrix is not !> banded. Must equal KL if matrix is symmetric. !> Not modified. !>
[in]	SPARSE	!> SPARSE is REAL !> On entry specifies the sparsity of the matrix if a sparse !> matrix is to be generated. SPARSE should lie between !> 0 and 1. To generate a sparse matrix, for each matrix entry !> a uniform ( 0, 1 ) random number x is generated and !> compared to SPARSE; if x is larger the matrix entry !> is unchanged and if x is smaller the entry is set !> to zero. Thus on the average a fraction SPARSE of the !> entries will be set to zero. !> Not modified. !>
[in]	ANORM	!> ANORM is REAL !> On entry specifies maximum entry of output matrix !> (output matrix will by multiplied by a constant so that !> its largest absolute entry equal ANORM) !> if ANORM is nonnegative. If ANORM is negative no scaling !> is done. Not modified. !>
[in]	PACK	!> PACK is CHARACTER*1 !> On entry specifies packing of matrix as follows: !> 'N' => no packing !> 'U' => zero out all subdiagonal entries (if symmetric) !> 'L' => zero out all superdiagonal entries (if symmetric) !> 'C' => store the upper triangle columnwise !> (only if matrix symmetric or square upper triangular) !> 'R' => store the lower triangle columnwise !> (only if matrix symmetric or square lower triangular) !> (same as upper half rowwise if symmetric) !> 'B' => store the lower triangle in band storage scheme !> (only if matrix symmetric) !> 'Q' => store the upper triangle in band storage scheme !> (only if matrix symmetric) !> 'Z' => store the entire matrix in band storage scheme !> (pivoting can be provided for by using this !> option to store A in the trailing rows of !> the allocated storage) !> !> Using these options, the various LAPACK packed and banded !> storage schemes can be obtained: !> GB - use 'Z' !> PB, SB or TB - use 'B' or 'Q' !> PP, SP or TP - use 'C' or 'R' !> !> If two calls to SLATMR differ only in the PACK parameter, !> they will generate mathematically equivalent matrices. !> Not modified. !>
[in,out]	A	!> A is REAL array, dimension (LDA,N) !> On exit A is the desired test matrix. Only those !> entries of A which are significant on output !> will be referenced (even if A is in packed or band !> storage format). The 'unoccupied corners' of A in !> band format will be zeroed out. !>
[in]	LDA	!> LDA is INTEGER !> on entry LDA specifies the first dimension of A as !> declared in the calling program. !> If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ). !> If PACK='C' or 'R', LDA must be at least 1. !> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N ) !> If PACK='Z', LDA must be at least KUU+KLL+1, where !> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, M-1 ) !> Not modified. !>
[out]	IWORK	!> IWORK is INTEGER array, dimension ( N or M) !> Workspace. Not referenced if PIVTNG = 'N'. Changed on exit. !>
[out]	INFO	!> INFO is INTEGER !> Error parameter on exit: !> 0 => normal return !> -1 => M negative or unequal to N and SYM='S' or 'H' !> -2 => N negative !> -3 => DIST illegal string !> -5 => SYM illegal string !> -7 => MODE not in range -6 to 6 !> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 !> -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string !> -11 => GRADE illegal string, or GRADE='E' and !> M not equal to N, or GRADE='L', 'R', 'B' or 'E' and !> SYM = 'S' or 'H' !> -12 => GRADE = 'E' and DL contains zero !> -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H', !> 'S' or 'E' !> -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E', !> and MODEL neither -6, 0 nor 6 !> -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B' !> -17 => CONDR less than 1.0, GRADE='R' or 'B', and !> MODER neither -6, 0 nor 6 !> -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and !> M not equal to N, or PIVTNG='L' or 'R' and SYM='S' !> or 'H' !> -19 => IPIVOT contains out of range number and !> PIVTNG not equal to 'N' !> -20 => KL negative !> -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL !> -22 => SPARSE not in range 0. to 1. !> -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q' !> and SYM='N', or PACK='C' and SYM='N' and either KL !> not equal to 0 or N not equal to M, or PACK='R' and !> SYM='N', and either KU not equal to 0 or N not equal !> to M !> -26 => LDA too small !> 1 => Error return from SLATM1 (computing D) !> 2 => Cannot scale diagonal to DMAX (max. entry is 0) !> 3 => Error return from SLATM1 (computing DL) !> 4 => Error return from SLATM1 (computing DR) !> 5 => ANORM is positive, but matrix constructed prior to !> attempting to scale it to have norm ANORM, is zero !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 467 of file slatmr.f.

*
*  -- LAPACK computational routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
      INTEGER            INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
      REAL               ANORM, COND, CONDL, CONDR, DMAX, SPARSE
*     ..
*     .. Array Arguments ..
      INTEGER            IPIVOT( * ), ISEED( 4 ), IWORK( * )
      REAL               A( LDA, * ), D( * ), DL( * ), DR( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO
      parameter( zero = 0.0e0 )
      REAL               ONE
      parameter( one = 1.0e0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            BADPVT, DZERO, FULBND
      INTEGER            I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
     $                   ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
     $                   MNSUB, MXSUB, NPVTS
      REAL               ALPHA, ONORM, TEMP
*     ..
*     .. Local Arrays ..
      REAL               TEMPA( 1 )
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      REAL               SLANGB, SLANGE, SLANSB,
     $                   SLANSP, SLANSY, SLATM2,
     $                   SLATM3
      EXTERNAL           lsame, slangb, slange,
     $                   slansb, slansp, slansy,
     $                   slatm2, slatm3
*     ..
*     .. External Subroutines ..
      EXTERNAL           slatm1, sscal, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max, min, mod
*     ..
*     .. Executable Statements ..
*
*     1)      Decode and Test the input parameters.
*             Initialize flags & seed.
*
      info = 0
*
*     Quick return if possible
*
      IF( m.EQ.0 .OR. n.EQ.0 )
     $   RETURN
*
*     Decode DIST
*
      IF( lsame( dist, 'U' ) ) THEN
         idist = 1
      ELSE IF( lsame( dist, 'S' ) ) THEN
         idist = 2
      ELSE IF( lsame( dist, 'N' ) ) THEN
         idist = 3
      ELSE
         idist = -1
      END IF
*
*     Decode SYM
*
      IF( lsame( sym, 'S' ) ) THEN
         isym = 0
      ELSE IF( lsame( sym, 'N' ) ) THEN
         isym = 1
      ELSE IF( lsame( sym, 'H' ) ) THEN
         isym = 0
      ELSE
         isym = -1
      END IF
*
*     Decode RSIGN
*
      IF( lsame( rsign, 'F' ) ) THEN
         irsign = 0
      ELSE IF( lsame( rsign, 'T' ) ) THEN
         irsign = 1
      ELSE
         irsign = -1
      END IF
*
*     Decode PIVTNG
*
      IF( lsame( pivtng, 'N' ) ) THEN
         ipvtng = 0
      ELSE IF( lsame( pivtng, ' ' ) ) THEN
         ipvtng = 0
      ELSE IF( lsame( pivtng, 'L' ) ) THEN
         ipvtng = 1
         npvts = m
      ELSE IF( lsame( pivtng, 'R' ) ) THEN
         ipvtng = 2
         npvts = n
      ELSE IF( lsame( pivtng, 'B' ) ) THEN
         ipvtng = 3
         npvts = min( n, m )
      ELSE IF( lsame( pivtng, 'F' ) ) THEN
         ipvtng = 3
         npvts = min( n, m )
      ELSE
         ipvtng = -1
      END IF
*
*     Decode GRADE
*
      IF( lsame( grade, 'N' ) ) THEN
         igrade = 0
      ELSE IF( lsame( grade, 'L' ) ) THEN
         igrade = 1
      ELSE IF( lsame( grade, 'R' ) ) THEN
         igrade = 2
      ELSE IF( lsame( grade, 'B' ) ) THEN
         igrade = 3
      ELSE IF( lsame( grade, 'E' ) ) THEN
         igrade = 4
      ELSE IF( lsame( grade, 'H' ) .OR. lsame( grade, 'S' ) ) THEN
         igrade = 5
      ELSE
         igrade = -1
      END IF
*
*     Decode PACK
*
      IF( lsame( pack, 'N' ) ) THEN
         ipack = 0
      ELSE IF( lsame( pack, 'U' ) ) THEN
         ipack = 1
      ELSE IF( lsame( pack, 'L' ) ) THEN
         ipack = 2
      ELSE IF( lsame( pack, 'C' ) ) THEN
         ipack = 3
      ELSE IF( lsame( pack, 'R' ) ) THEN
         ipack = 4
      ELSE IF( lsame( pack, 'B' ) ) THEN
         ipack = 5
      ELSE IF( lsame( pack, 'Q' ) ) THEN
         ipack = 6
      ELSE IF( lsame( pack, 'Z' ) ) THEN
         ipack = 7
      ELSE
         ipack = -1
      END IF
*
*     Set certain internal parameters
*
      mnmin = min( m, n )
      kll = min( kl, m-1 )
      kuu = min( ku, n-1 )
*
*     If inv(DL) is used, check to see if DL has a zero entry.
*
      dzero = .false.
      IF( igrade.EQ.4 .AND. model.EQ.0 ) THEN
         DO 10 i = 1, m
            IF( dl( i ).EQ.zero )
     $         dzero = .true.
   10    CONTINUE
      END IF
*
*     Check values in IPIVOT
*
      badpvt = .false.
      IF( ipvtng.GT.0 ) THEN
         DO 20 j = 1, npvts
            IF( ipivot( j ).LE.0 .OR. ipivot( j ).GT.npvts )
     $         badpvt = .true.
   20    CONTINUE
      END IF
*
*     Set INFO if an error
*
      IF( m.LT.0 ) THEN
         info = -1
      ELSE IF( m.NE.n .AND. isym.EQ.0 ) THEN
         info = -1
      ELSE IF( n.LT.0 ) THEN
         info = -2
      ELSE IF( idist.EQ.-1 ) THEN
         info = -3
      ELSE IF( isym.EQ.-1 ) THEN
         info = -5
      ELSE IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
         info = -7
      ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
     $         cond.LT.one ) THEN
         info = -8
      ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
     $         irsign.EQ.-1 ) THEN
         info = -10
      ELSE IF( igrade.EQ.-1 .OR. ( igrade.EQ.4 .AND. m.NE.n ) .OR.
     $         ( ( igrade.GE.1 .AND. igrade.LE.4 ) .AND. isym.EQ.0 ) )
     $          THEN
         info = -11
      ELSE IF( igrade.EQ.4 .AND. dzero ) THEN
         info = -12
      ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
     $         igrade.EQ.5 ) .AND. ( model.LT.-6 .OR. model.GT.6 ) )
     $          THEN
         info = -13
      ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
     $         igrade.EQ.5 ) .AND. ( model.NE.-6 .AND. model.NE.0 .AND.
     $         model.NE.6 ) .AND. condl.LT.one ) THEN
         info = -14
      ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
     $         ( moder.LT.-6 .OR. moder.GT.6 ) ) THEN
         info = -16
      ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
     $         ( moder.NE.-6 .AND. moder.NE.0 .AND. moder.NE.6 ) .AND.
     $         condr.LT.one ) THEN
         info = -17
      ELSE IF( ipvtng.EQ.-1 .OR. ( ipvtng.EQ.3 .AND. m.NE.n ) .OR.
     $         ( ( ipvtng.EQ.1 .OR. ipvtng.EQ.2 ) .AND. isym.EQ.0 ) )
     $          THEN
         info = -18
      ELSE IF( ipvtng.NE.0 .AND. badpvt ) THEN
         info = -19
      ELSE IF( kl.LT.0 ) THEN
         info = -20
      ELSE IF( ku.LT.0 .OR. ( isym.EQ.0 .AND. kl.NE.ku ) ) THEN
         info = -21
      ELSE IF( sparse.LT.zero .OR. sparse.GT.one ) THEN
         info = -22
      ELSE IF( ipack.EQ.-1 .OR. ( ( ipack.EQ.1 .OR. ipack.EQ.2 .OR.
     $         ipack.EQ.5 .OR. ipack.EQ.6 ) .AND. isym.EQ.1 ) .OR.
     $         ( ipack.EQ.3 .AND. isym.EQ.1 .AND. ( kl.NE.0 .OR. m.NE.
     $         n ) ) .OR. ( ipack.EQ.4 .AND. isym.EQ.1 .AND. ( ku.NE.
     $         0 .OR. m.NE.n ) ) ) THEN
         info = -24
      ELSE IF( ( ( ipack.EQ.0 .OR. ipack.EQ.1 .OR. ipack.EQ.2 ) .AND.
     $         lda.LT.max( 1, m ) ) .OR. ( ( ipack.EQ.3 .OR. ipack.EQ.
     $         4 ) .AND. lda.LT.1 ) .OR. ( ( ipack.EQ.5 .OR. ipack.EQ.
     $         6 ) .AND. lda.LT.kuu+1 ) .OR.
     $         ( ipack.EQ.7 .AND. lda.LT.kll+kuu+1 ) ) THEN
         info = -26
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SLATMR', -info )
         RETURN
      END IF
*
*     Decide if we can pivot consistently
*
      fulbnd = .false.
      IF( kuu.EQ.n-1 .AND. kll.EQ.m-1 )
     $   fulbnd = .true.
*
*     Initialize random number generator
*
      DO 30 i = 1, 4
         iseed( i ) = mod( abs( iseed( i ) ), 4096 )
   30 CONTINUE
*
      iseed( 4 ) = 2*( iseed( 4 ) / 2 ) + 1
*
*     2)      Set up D, DL, and DR, if indicated.
*
*             Compute D according to COND and MODE
*
      CALL slatm1( mode, cond, irsign, idist, iseed, d, mnmin, info )
      IF( info.NE.0 ) THEN
         info = 1
         RETURN
      END IF
      IF( mode.NE.0 .AND. mode.NE.-6 .AND. mode.NE.6 ) THEN
*
*        Scale by DMAX
*
         temp = abs( d( 1 ) )
         DO 40 i = 2, mnmin
            temp = max( temp, abs( d( i ) ) )
   40    CONTINUE
         IF( temp.EQ.zero .AND. dmax.NE.zero ) THEN
            info = 2
            RETURN
         END IF
         IF( temp.NE.zero ) THEN
            alpha = dmax / temp
         ELSE
            alpha = one
         END IF
         DO 50 i = 1, mnmin
            d( i ) = alpha*d( i )
   50    CONTINUE
*
      END IF
*
*     Compute DL if grading set
*
      IF( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR. igrade.EQ.
     $    5 ) THEN
         CALL slatm1( model, condl, 0, idist, iseed, dl, m, info )
         IF( info.NE.0 ) THEN
            info = 3
            RETURN
         END IF
      END IF
*
*     Compute DR if grading set
*
      IF( igrade.EQ.2 .OR. igrade.EQ.3 ) THEN
         CALL slatm1( moder, condr, 0, idist, iseed, dr, n, info )
         IF( info.NE.0 ) THEN
            info = 4
            RETURN
         END IF
      END IF
*
*     3)     Generate IWORK if pivoting
*
      IF( ipvtng.GT.0 ) THEN
         DO 60 i = 1, npvts
            iwork( i ) = i
   60    CONTINUE
         IF( fulbnd ) THEN
            DO 70 i = 1, npvts
               k = ipivot( i )
               j = iwork( i )
               iwork( i ) = iwork( k )
               iwork( k ) = j
   70       CONTINUE
         ELSE
            DO 80 i = npvts, 1, -1
               k = ipivot( i )
               j = iwork( i )
               iwork( i ) = iwork( k )
               iwork( k ) = j
   80       CONTINUE
         END IF
      END IF
*
*     4)      Generate matrices for each kind of PACKing
*             Always sweep matrix columnwise (if symmetric, upper
*             half only) so that matrix generated does not depend
*             on PACK
*
      IF( fulbnd ) THEN
*
*        Use SLATM3 so matrices generated with differing PIVOTing only
*        differ only in the order of their rows and/or columns.
*
         IF( ipack.EQ.0 ) THEN
            IF( isym.EQ.0 ) THEN
               DO 100 j = 1, n
                  DO 90 i = 1, j
                     temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                      idist, iseed, d, igrade, dl, dr, ipvtng,
     $                      iwork, sparse )
                     a( isub, jsub ) = temp
                     a( jsub, isub ) = temp
   90             CONTINUE
  100          CONTINUE
            ELSE IF( isym.EQ.1 ) THEN
               DO 120 j = 1, n
                  DO 110 i = 1, m
                     temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                      idist, iseed, d, igrade, dl, dr, ipvtng,
     $                      iwork, sparse )
                     a( isub, jsub ) = temp
  110             CONTINUE
  120          CONTINUE
            END IF
*
         ELSE IF( ipack.EQ.1 ) THEN
*
            DO 140 j = 1, n
               DO 130 i = 1, j
                  temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                   idist,
     $                   iseed, d, igrade, dl, dr, ipvtng, iwork,
     $                   sparse )
                  mnsub = min( isub, jsub )
                  mxsub = max( isub, jsub )
                  a( mnsub, mxsub ) = temp
                  IF( mnsub.NE.mxsub )
     $               a( mxsub, mnsub ) = zero
  130          CONTINUE
  140       CONTINUE
*
         ELSE IF( ipack.EQ.2 ) THEN
*
            DO 160 j = 1, n
               DO 150 i = 1, j
                  temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                   idist,
     $                   iseed, d, igrade, dl, dr, ipvtng, iwork,
     $                   sparse )
                  mnsub = min( isub, jsub )
                  mxsub = max( isub, jsub )
                  a( mxsub, mnsub ) = temp
                  IF( mnsub.NE.mxsub )
     $               a( mnsub, mxsub ) = zero
  150          CONTINUE
  160       CONTINUE
*
         ELSE IF( ipack.EQ.3 ) THEN
*
            DO 180 j = 1, n
               DO 170 i = 1, j
                  temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                   idist,
     $                   iseed, d, igrade, dl, dr, ipvtng, iwork,
     $                   sparse )
*
*                 Compute K = location of (ISUB,JSUB) entry in packed
*                 array
*
                  mnsub = min( isub, jsub )
                  mxsub = max( isub, jsub )
                  k = mxsub*( mxsub-1 ) / 2 + mnsub
*
*                 Convert K to (IISUB,JJSUB) location
*
                  jjsub = ( k-1 ) / lda + 1
                  iisub = k - lda*( jjsub-1 )
*
                  a( iisub, jjsub ) = temp
  170          CONTINUE
  180       CONTINUE
*
         ELSE IF( ipack.EQ.4 ) THEN
*
            DO 200 j = 1, n
               DO 190 i = 1, j
                  temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                   idist,
     $                   iseed, d, igrade, dl, dr, ipvtng, iwork,
     $                   sparse )
*
*                 Compute K = location of (I,J) entry in packed array
*
                  mnsub = min( isub, jsub )
                  mxsub = max( isub, jsub )
                  IF( mnsub.EQ.1 ) THEN
                     k = mxsub
                  ELSE
                     k = n*( n+1 ) / 2 - ( n-mnsub+1 )*( n-mnsub+2 ) /
     $                   2 + mxsub - mnsub + 1
                  END IF
*
*                 Convert K to (IISUB,JJSUB) location
*
                  jjsub = ( k-1 ) / lda + 1
                  iisub = k - lda*( jjsub-1 )
*
                  a( iisub, jjsub ) = temp
  190          CONTINUE
  200       CONTINUE
*
         ELSE IF( ipack.EQ.5 ) THEN
*
            DO 220 j = 1, n
               DO 210 i = j - kuu, j
                  IF( i.LT.1 ) THEN
                     a( j-i+1, i+n ) = zero
                  ELSE
                     temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                      idist, iseed, d, igrade, dl, dr, ipvtng,
     $                      iwork, sparse )
                     mnsub = min( isub, jsub )
                     mxsub = max( isub, jsub )
                     a( mxsub-mnsub+1, mnsub ) = temp
                  END IF
  210          CONTINUE
  220       CONTINUE
*
         ELSE IF( ipack.EQ.6 ) THEN
*
            DO 240 j = 1, n
               DO 230 i = j - kuu, j
                  temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                   idist,
     $                   iseed, d, igrade, dl, dr, ipvtng, iwork,
     $                   sparse )
                  mnsub = min( isub, jsub )
                  mxsub = max( isub, jsub )
                  a( mnsub-mxsub+kuu+1, mxsub ) = temp
  230          CONTINUE
  240       CONTINUE
*
         ELSE IF( ipack.EQ.7 ) THEN
*
            IF( isym.EQ.0 ) THEN
               DO 260 j = 1, n
                  DO 250 i = j - kuu, j
                     temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                      idist, iseed, d, igrade, dl, dr, ipvtng,
     $                      iwork, sparse )
                     mnsub = min( isub, jsub )
                     mxsub = max( isub, jsub )
                     a( mnsub-mxsub+kuu+1, mxsub ) = temp
                     IF( i.LT.1 )
     $                  a( j-i+1+kuu, i+n ) = zero
                     IF( i.GE.1 .AND. mnsub.NE.mxsub )
     $                  a( mxsub-mnsub+1+kuu, mnsub ) = temp
  250             CONTINUE
  260          CONTINUE
            ELSE IF( isym.EQ.1 ) THEN
               DO 280 j = 1, n
                  DO 270 i = j - kuu, j + kll
                     temp = slatm3( m, n, i, j, isub, jsub, kl, ku,
     $                      idist, iseed, d, igrade, dl, dr, ipvtng,
     $                      iwork, sparse )
                     a( isub-jsub+kuu+1, jsub ) = temp
  270             CONTINUE
  280          CONTINUE
            END IF
*
         END IF
*
      ELSE
*
*        Use SLATM2
*
         IF( ipack.EQ.0 ) THEN
            IF( isym.EQ.0 ) THEN
               DO 300 j = 1, n
                  DO 290 i = 1, j
                     a( i, j ) = slatm2( m, n, i, j, kl, ku, idist,
     $                           iseed, d, igrade, dl, dr, ipvtng,
     $                           iwork, sparse )
                     a( j, i ) = a( i, j )
  290             CONTINUE
  300          CONTINUE
            ELSE IF( isym.EQ.1 ) THEN
               DO 320 j = 1, n
                  DO 310 i = 1, m
                     a( i, j ) = slatm2( m, n, i, j, kl, ku, idist,
     $                           iseed, d, igrade, dl, dr, ipvtng,
     $                           iwork, sparse )
  310             CONTINUE
  320          CONTINUE
            END IF
*
         ELSE IF( ipack.EQ.1 ) THEN
*
            DO 340 j = 1, n
               DO 330 i = 1, j
                  a( i, j ) = slatm2( m, n, i, j, kl, ku, idist,
     $                        iseed,
     $                        d, igrade, dl, dr, ipvtng, iwork, sparse )
                  IF( i.NE.j )
     $               a( j, i ) = zero
  330          CONTINUE
  340       CONTINUE
*
         ELSE IF( ipack.EQ.2 ) THEN
*
            DO 360 j = 1, n
               DO 350 i = 1, j
                  a( j, i ) = slatm2( m, n, i, j, kl, ku, idist,
     $                        iseed,
     $                        d, igrade, dl, dr, ipvtng, iwork, sparse )
                  IF( i.NE.j )
     $               a( i, j ) = zero
  350          CONTINUE
  360       CONTINUE
*
         ELSE IF( ipack.EQ.3 ) THEN
*
            isub = 0
            jsub = 1
            DO 380 j = 1, n
               DO 370 i = 1, j
                  isub = isub + 1
                  IF( isub.GT.lda ) THEN
                     isub = 1
                     jsub = jsub + 1
                  END IF
                  a( isub, jsub ) = slatm2( m, n, i, j, kl, ku,
     $                              idist,
     $                              iseed, d, igrade, dl, dr, ipvtng,
     $                              iwork, sparse )
  370          CONTINUE
  380       CONTINUE
*
         ELSE IF( ipack.EQ.4 ) THEN
*
            IF( isym.EQ.0 ) THEN
               DO 400 j = 1, n
                  DO 390 i = 1, j
*
*                    Compute K = location of (I,J) entry in packed array
*
                     IF( i.EQ.1 ) THEN
                        k = j
                     ELSE
                        k = n*( n+1 ) / 2 - ( n-i+1 )*( n-i+2 ) / 2 +
     $                      j - i + 1
                     END IF
*
*                    Convert K to (ISUB,JSUB) location
*
                     jsub = ( k-1 ) / lda + 1
                     isub = k - lda*( jsub-1 )
*
                     a( isub, jsub ) = slatm2( m, n, i, j, kl, ku,
     $                                 idist, iseed, d, igrade, dl, dr,
     $                                 ipvtng, iwork, sparse )
  390             CONTINUE
  400          CONTINUE
            ELSE
               isub = 0
               jsub = 1
               DO 420 j = 1, n
                  DO 410 i = j, m
                     isub = isub + 1
                     IF( isub.GT.lda ) THEN
                        isub = 1
                        jsub = jsub + 1
                     END IF
                     a( isub, jsub ) = slatm2( m, n, i, j, kl, ku,
     $                                 idist, iseed, d, igrade, dl, dr,
     $                                 ipvtng, iwork, sparse )
  410             CONTINUE
  420          CONTINUE
            END IF
*
         ELSE IF( ipack.EQ.5 ) THEN
*
            DO 440 j = 1, n
               DO 430 i = j - kuu, j
                  IF( i.LT.1 ) THEN
                     a( j-i+1, i+n ) = zero
                  ELSE
                     a( j-i+1, i ) = slatm2( m, n, i, j, kl, ku,
     $                               idist,
     $                               iseed, d, igrade, dl, dr, ipvtng,
     $                               iwork, sparse )
                  END IF
  430          CONTINUE
  440       CONTINUE
*
         ELSE IF( ipack.EQ.6 ) THEN
*
            DO 460 j = 1, n
               DO 450 i = j - kuu, j
                  a( i-j+kuu+1, j ) = slatm2( m, n, i, j, kl, ku,
     $                                idist,
     $                                iseed, d, igrade, dl, dr, ipvtng,
     $                                iwork, sparse )
  450          CONTINUE
  460       CONTINUE
*
         ELSE IF( ipack.EQ.7 ) THEN
*
            IF( isym.EQ.0 ) THEN
               DO 480 j = 1, n
                  DO 470 i = j - kuu, j
                     a( i-j+kuu+1, j ) = slatm2( m, n, i, j, kl, ku,
     $                                   idist, iseed, d, igrade, dl,
     $                                   dr, ipvtng, iwork, sparse )
                     IF( i.LT.1 )
     $                  a( j-i+1+kuu, i+n ) = zero
                     IF( i.GE.1 .AND. i.NE.j )
     $                  a( j-i+1+kuu, i ) = a( i-j+kuu+1, j )
  470             CONTINUE
  480          CONTINUE
            ELSE IF( isym.EQ.1 ) THEN
               DO 500 j = 1, n
                  DO 490 i = j - kuu, j + kll
                     a( i-j+kuu+1, j ) = slatm2( m, n, i, j, kl, ku,
     $                                   idist, iseed, d, igrade, dl,
     $                                   dr, ipvtng, iwork, sparse )
  490             CONTINUE
  500          CONTINUE
            END IF
*
         END IF
*
      END IF
*
*     5)      Scaling the norm
*
      IF( ipack.EQ.0 ) THEN
         onorm = slange( 'M', m, n, a, lda, tempa )
      ELSE IF( ipack.EQ.1 ) THEN
         onorm = slansy( 'M', 'U', n, a, lda, tempa )
      ELSE IF( ipack.EQ.2 ) THEN
         onorm = slansy( 'M', 'L', n, a, lda, tempa )
      ELSE IF( ipack.EQ.3 ) THEN
         onorm = slansp( 'M', 'U', n, a, tempa )
      ELSE IF( ipack.EQ.4 ) THEN
         onorm = slansp( 'M', 'L', n, a, tempa )
      ELSE IF( ipack.EQ.5 ) THEN
         onorm = slansb( 'M', 'L', n, kll, a, lda, tempa )
      ELSE IF( ipack.EQ.6 ) THEN
         onorm = slansb( 'M', 'U', n, kuu, a, lda, tempa )
      ELSE IF( ipack.EQ.7 ) THEN
         onorm = slangb( 'M', n, kll, kuu, a, lda, tempa )
      END IF
*
      IF( anorm.GE.zero ) THEN
*
         IF( anorm.GT.zero .AND. onorm.EQ.zero ) THEN
*
*           Desired scaling impossible
*
            info = 5
            RETURN
*
         ELSE IF( ( anorm.GT.one .AND. onorm.LT.one ) .OR.
     $            ( anorm.LT.one .AND. onorm.GT.one ) ) THEN
*
*           Scale carefully to avoid over / underflow
*
            IF( ipack.LE.2 ) THEN
               DO 510 j = 1, n
                  CALL sscal( m, one / onorm, a( 1, j ), 1 )
                  CALL sscal( m, anorm, a( 1, j ), 1 )
  510          CONTINUE
*
            ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 ) THEN
*
               CALL sscal( n*( n+1 ) / 2, one / onorm, a, 1 )
               CALL sscal( n*( n+1 ) / 2, anorm, a, 1 )
*
            ELSE IF( ipack.GE.5 ) THEN
*
               DO 520 j = 1, n
                  CALL sscal( kll+kuu+1, one / onorm, a( 1, j ), 1 )
                  CALL sscal( kll+kuu+1, anorm, a( 1, j ), 1 )
  520          CONTINUE
*
            END IF
*
         ELSE
*
*           Scale straightforwardly
*
            IF( ipack.LE.2 ) THEN
               DO 530 j = 1, n
                  CALL sscal( m, anorm / onorm, a( 1, j ), 1 )
  530          CONTINUE
*
            ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 ) THEN
*
               CALL sscal( n*( n+1 ) / 2, anorm / onorm, a, 1 )
*
            ELSE IF( ipack.GE.5 ) THEN
*
               DO 540 j = 1, n
                  CALL sscal( kll+kuu+1, anorm / onorm, a( 1, j ), 1 )
  540          CONTINUE
            END IF
*
         END IF
*
      END IF
*
*     End of SLATMR
*

Here is the call graph for this function:

Here is the caller graph for this function: