LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zlatmr ( integer  M,
integer  N,
character  DIST,
integer, dimension( 4 )  ISEED,
character  SYM,
complex*16, dimension( * )  D,
integer  MODE,
double precision  COND,
complex*16  DMAX,
character  RSIGN,
character  GRADE,
complex*16, dimension( * )  DL,
integer  MODEL,
double precision  CONDL,
complex*16, dimension( * )  DR,
integer  MODER,
double precision  CONDR,
character  PIVTNG,
integer, dimension( * )  IPIVOT,
integer  KL,
integer  KU,
double precision  SPARSE,
double precision  ANORM,
character  PACK,
complex*16, dimension( lda, * )  A,
integer  LDA,
integer, dimension( * )  IWORK,
integer  INFO 
)

ZLATMR

Purpose:
    ZLATMR generates random matrices of various types for testing
    LAPACK programs.

    ZLATMR operates by applying the following sequence of
    operations:

      Generate a matrix A with random entries of distribution DIST
         which is symmetric if SYM='S', Hermitian if SYM='H', 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 or Hermitian)
         zero out lower half (if symmetric or Hermitian)
         store the upper half columnwise (if symmetric or Hermitian
             or square upper triangular)
         store the lower half columnwise (if symmetric or Hermitian
             or square lower triangular)
             same as upper half rowwise if symmetric
             same as conjugate upper half rowwise if Hermitian
         store the lower triangle in banded format
             (if symmetric or Hermitian)
         store the upper triangle in banded format
             (if symmetric or Hermitian)
         store the entire matrix in banded format

    Note: If two calls to ZLATMR differ only in the PACK parameter,
          they will generate mathematically equivalent matrices.

          If two calls to ZLATMR 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' => real and imaginary parts are independent
                  UNIFORM( 0, 1 )  ( 'U' for uniform )
           'S' => real and imaginary parts are independent
                  UNIFORM( -1, 1 ) ( 'S' for symmetric )
           'N' => real and imaginary parts are independent
                  NORMAL( 0, 1 )   ( 'N' for normal )
           'D' => uniform on interior of unit disk ( 'D' for disk )
           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 ZLATMR
           to continue the same random number sequence.
           Changed on exit.
[in]SYM
          SYM is CHARACTER*1
           If SYM='S', generated matrix is symmetric.
           If SYM='H', generated matrix is Hermitian.
           If SYM='N', generated matrix is nonsymmetric.
           Not modified.
[in,out]D
          D is COMPLEX*16 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. If the matrix is Hermitian, the real part of D
           will be taken. 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 DOUBLE PRECISION
           On entry, used as described under MODE above.
           If used, it must be >= 1. Not modified.
[in]DMAX
          DMAX is COMPLEX*16
           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 complex (or zero),
           diagonal will be scaled by a complex 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 a random complex
                  number uniformly distributed with absolute value 1
           '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)
           'H'  => matrix premultiplied by diag( DL ) and
                         postmultiplied by diag( CONJG(DL) )
                   (only if matrix Hermitian or nonsymmetric)
           'S'  => matrix premultiplied by diag( DL ) and
                         postmultiplied by diag( DL )
                   (only if matrix symmetric or nonsymmetric)
           'E'  => matrix premultiplied by diag( DL ) and
                         postmultiplied by inv( diag( DL ) )
                         ( 'S' for similarity )
                   (only if matrix nonsymmetric)
                   Note: if GRADE='S', then M must equal N.
           Not modified.
[in,out]DL
          DL is COMPLEX*16 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 DOUBLE PRECISION
           When MODEL is not zero, this specifies the condition number
           of the computed DL.  Not modified.
[in,out]DR
          DR is COMPLEX*16 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' or 'S'.
           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 DOUBLE PRECISION
           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 ZLATMR 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, ZLATMR
           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 "2-cycles", 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]SPARSE
          SPARSE is DOUBLE PRECISION
           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]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 or Hermitian.
           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 or Hermitian.
           Not modified.
[in]ANORM
          ANORM is DOUBLE PRECISION
           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 or Hermitian)
           'L' => zero out all superdiagonal entries
                  (if symmetric or Hermitian)
           'C' => store the upper triangle columnwise
                  (only if matrix symmetric or Hermitian or
                   square upper triangular)
           'R' => store the lower triangle columnwise
                  (only if matrix symmetric or Hermitian or
                   square lower triangular)
                  (same as upper half rowwise if symmetric)
                  (same as conjugate upper half rowwise if Hermitian)
           'B' => store the lower triangle in band storage scheme
                  (only if matrix symmetric or Hermitian)
           'Q' => store the upper triangle in band storage scheme
                  (only if matrix symmetric or Hermitian)
           '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, HB or TB     - use 'B' or 'Q'
           PP, HP or TP     - use 'C' or 'R'

           If two calls to ZLATMR differ only in the PACK parameter,
           they will generate mathematically equivalent matrices.
           Not modified.
[in,out]A
          A is COMPLEX*16 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, N-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', 'S' or 'E'
                  and SYM = 'H', or GRADE='L', 'R', 'B', 'H' or 'E'
                  and SYM = 'S'
           -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 ZLATM1 (computing D)
             2 => Cannot scale diagonal to DMAX (max. entry is 0)
             3 => Error return from ZLATM1 (computing DL)
             4 => Error return from ZLATM1 (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.
Date
November 2011

Definition at line 492 of file zlatmr.f.

492 *
493 * -- LAPACK computational routine (version 3.4.0) --
494 * -- LAPACK is a software package provided by Univ. of Tennessee, --
495 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
496 * November 2011
497 *
498 * .. Scalar Arguments ..
499  CHARACTER dist, grade, pack, pivtng, rsign, sym
500  INTEGER info, kl, ku, lda, m, mode, model, moder, n
501  DOUBLE PRECISION anorm, cond, condl, condr, sparse
502  COMPLEX*16 dmax
503 * ..
504 * .. Array Arguments ..
505  INTEGER ipivot( * ), iseed( 4 ), iwork( * )
506  COMPLEX*16 a( lda, * ), d( * ), dl( * ), dr( * )
507 * ..
508 *
509 * =====================================================================
510 *
511 * .. Parameters ..
512  DOUBLE PRECISION zero
513  parameter ( zero = 0.0d0 )
514  DOUBLE PRECISION one
515  parameter ( one = 1.0d0 )
516  COMPLEX*16 cone
517  parameter ( cone = ( 1.0d0, 0.0d0 ) )
518  COMPLEX*16 czero
519  parameter ( czero = ( 0.0d0, 0.0d0 ) )
520 * ..
521 * .. Local Scalars ..
522  LOGICAL badpvt, dzero, fulbnd
523  INTEGER i, idist, igrade, iisub, ipack, ipvtng, irsign,
524  $ isub, isym, j, jjsub, jsub, k, kll, kuu, mnmin,
525  $ mnsub, mxsub, npvts
526  DOUBLE PRECISION onorm, temp
527  COMPLEX*16 calpha, ctemp
528 * ..
529 * .. Local Arrays ..
530  DOUBLE PRECISION tempa( 1 )
531 * ..
532 * .. External Functions ..
533  LOGICAL lsame
534  DOUBLE PRECISION zlangb, zlange, zlansb, zlansp, zlansy
535  COMPLEX*16 zlatm2, zlatm3
536  EXTERNAL lsame, zlangb, zlange, zlansb, zlansp, zlansy,
537  $ zlatm2, zlatm3
538 * ..
539 * .. External Subroutines ..
540  EXTERNAL xerbla, zdscal, zlatm1
541 * ..
542 * .. Intrinsic Functions ..
543  INTRINSIC abs, dble, dconjg, max, min, mod
544 * ..
545 * .. Executable Statements ..
546 *
547 * 1) Decode and Test the input parameters.
548 * Initialize flags & seed.
549 *
550  info = 0
551 *
552 * Quick return if possible
553 *
554  IF( m.EQ.0 .OR. n.EQ.0 )
555  $ RETURN
556 *
557 * Decode DIST
558 *
559  IF( lsame( dist, 'U' ) ) THEN
560  idist = 1
561  ELSE IF( lsame( dist, 'S' ) ) THEN
562  idist = 2
563  ELSE IF( lsame( dist, 'N' ) ) THEN
564  idist = 3
565  ELSE IF( lsame( dist, 'D' ) ) THEN
566  idist = 4
567  ELSE
568  idist = -1
569  END IF
570 *
571 * Decode SYM
572 *
573  IF( lsame( sym, 'H' ) ) THEN
574  isym = 0
575  ELSE IF( lsame( sym, 'N' ) ) THEN
576  isym = 1
577  ELSE IF( lsame( sym, 'S' ) ) THEN
578  isym = 2
579  ELSE
580  isym = -1
581  END IF
582 *
583 * Decode RSIGN
584 *
585  IF( lsame( rsign, 'F' ) ) THEN
586  irsign = 0
587  ELSE IF( lsame( rsign, 'T' ) ) THEN
588  irsign = 1
589  ELSE
590  irsign = -1
591  END IF
592 *
593 * Decode PIVTNG
594 *
595  IF( lsame( pivtng, 'N' ) ) THEN
596  ipvtng = 0
597  ELSE IF( lsame( pivtng, ' ' ) ) THEN
598  ipvtng = 0
599  ELSE IF( lsame( pivtng, 'L' ) ) THEN
600  ipvtng = 1
601  npvts = m
602  ELSE IF( lsame( pivtng, 'R' ) ) THEN
603  ipvtng = 2
604  npvts = n
605  ELSE IF( lsame( pivtng, 'B' ) ) THEN
606  ipvtng = 3
607  npvts = min( n, m )
608  ELSE IF( lsame( pivtng, 'F' ) ) THEN
609  ipvtng = 3
610  npvts = min( n, m )
611  ELSE
612  ipvtng = -1
613  END IF
614 *
615 * Decode GRADE
616 *
617  IF( lsame( grade, 'N' ) ) THEN
618  igrade = 0
619  ELSE IF( lsame( grade, 'L' ) ) THEN
620  igrade = 1
621  ELSE IF( lsame( grade, 'R' ) ) THEN
622  igrade = 2
623  ELSE IF( lsame( grade, 'B' ) ) THEN
624  igrade = 3
625  ELSE IF( lsame( grade, 'E' ) ) THEN
626  igrade = 4
627  ELSE IF( lsame( grade, 'H' ) ) THEN
628  igrade = 5
629  ELSE IF( lsame( grade, 'S' ) ) THEN
630  igrade = 6
631  ELSE
632  igrade = -1
633  END IF
634 *
635 * Decode PACK
636 *
637  IF( lsame( pack, 'N' ) ) THEN
638  ipack = 0
639  ELSE IF( lsame( pack, 'U' ) ) THEN
640  ipack = 1
641  ELSE IF( lsame( pack, 'L' ) ) THEN
642  ipack = 2
643  ELSE IF( lsame( pack, 'C' ) ) THEN
644  ipack = 3
645  ELSE IF( lsame( pack, 'R' ) ) THEN
646  ipack = 4
647  ELSE IF( lsame( pack, 'B' ) ) THEN
648  ipack = 5
649  ELSE IF( lsame( pack, 'Q' ) ) THEN
650  ipack = 6
651  ELSE IF( lsame( pack, 'Z' ) ) THEN
652  ipack = 7
653  ELSE
654  ipack = -1
655  END IF
656 *
657 * Set certain internal parameters
658 *
659  mnmin = min( m, n )
660  kll = min( kl, m-1 )
661  kuu = min( ku, n-1 )
662 *
663 * If inv(DL) is used, check to see if DL has a zero entry.
664 *
665  dzero = .false.
666  IF( igrade.EQ.4 .AND. model.EQ.0 ) THEN
667  DO 10 i = 1, m
668  IF( dl( i ).EQ.czero )
669  $ dzero = .true.
670  10 CONTINUE
671  END IF
672 *
673 * Check values in IPIVOT
674 *
675  badpvt = .false.
676  IF( ipvtng.GT.0 ) THEN
677  DO 20 j = 1, npvts
678  IF( ipivot( j ).LE.0 .OR. ipivot( j ).GT.npvts )
679  $ badpvt = .true.
680  20 CONTINUE
681  END IF
682 *
683 * Set INFO if an error
684 *
685  IF( m.LT.0 ) THEN
686  info = -1
687  ELSE IF( m.NE.n .AND. ( isym.EQ.0 .OR. isym.EQ.2 ) ) THEN
688  info = -1
689  ELSE IF( n.LT.0 ) THEN
690  info = -2
691  ELSE IF( idist.EQ.-1 ) THEN
692  info = -3
693  ELSE IF( isym.EQ.-1 ) THEN
694  info = -5
695  ELSE IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
696  info = -7
697  ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
698  $ cond.LT.one ) THEN
699  info = -8
700  ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
701  $ irsign.EQ.-1 ) THEN
702  info = -10
703  ELSE IF( igrade.EQ.-1 .OR. ( igrade.EQ.4 .AND. m.NE.n ) .OR.
704  $ ( ( igrade.EQ.1 .OR. igrade.EQ.2 .OR. igrade.EQ.3 .OR.
705  $ igrade.EQ.4 .OR. igrade.EQ.6 ) .AND. isym.EQ.0 ) .OR.
706  $ ( ( igrade.EQ.1 .OR. igrade.EQ.2 .OR. igrade.EQ.3 .OR.
707  $ igrade.EQ.4 .OR. igrade.EQ.5 ) .AND. isym.EQ.2 ) ) THEN
708  info = -11
709  ELSE IF( igrade.EQ.4 .AND. dzero ) THEN
710  info = -12
711  ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
712  $ igrade.EQ.5 .OR. igrade.EQ.6 ) .AND.
713  $ ( model.LT.-6 .OR. model.GT.6 ) ) THEN
714  info = -13
715  ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
716  $ igrade.EQ.5 .OR. igrade.EQ.6 ) .AND.
717  $ ( model.NE.-6 .AND. model.NE.0 .AND. model.NE.6 ) .AND.
718  $ condl.LT.one ) THEN
719  info = -14
720  ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
721  $ ( moder.LT.-6 .OR. moder.GT.6 ) ) THEN
722  info = -16
723  ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
724  $ ( moder.NE.-6 .AND. moder.NE.0 .AND. moder.NE.6 ) .AND.
725  $ condr.LT.one ) THEN
726  info = -17
727  ELSE IF( ipvtng.EQ.-1 .OR. ( ipvtng.EQ.3 .AND. m.NE.n ) .OR.
728  $ ( ( ipvtng.EQ.1 .OR. ipvtng.EQ.2 ) .AND. ( isym.EQ.0 .OR.
729  $ isym.EQ.2 ) ) ) THEN
730  info = -18
731  ELSE IF( ipvtng.NE.0 .AND. badpvt ) THEN
732  info = -19
733  ELSE IF( kl.LT.0 ) THEN
734  info = -20
735  ELSE IF( ku.LT.0 .OR. ( ( isym.EQ.0 .OR. isym.EQ.2 ) .AND. kl.NE.
736  $ ku ) ) THEN
737  info = -21
738  ELSE IF( sparse.LT.zero .OR. sparse.GT.one ) THEN
739  info = -22
740  ELSE IF( ipack.EQ.-1 .OR. ( ( ipack.EQ.1 .OR. ipack.EQ.2 .OR.
741  $ ipack.EQ.5 .OR. ipack.EQ.6 ) .AND. isym.EQ.1 ) .OR.
742  $ ( ipack.EQ.3 .AND. isym.EQ.1 .AND. ( kl.NE.0 .OR. m.NE.
743  $ n ) ) .OR. ( ipack.EQ.4 .AND. isym.EQ.1 .AND. ( ku.NE.
744  $ 0 .OR. m.NE.n ) ) ) THEN
745  info = -24
746  ELSE IF( ( ( ipack.EQ.0 .OR. ipack.EQ.1 .OR. ipack.EQ.2 ) .AND.
747  $ lda.LT.max( 1, m ) ) .OR. ( ( ipack.EQ.3 .OR. ipack.EQ.
748  $ 4 ) .AND. lda.LT.1 ) .OR. ( ( ipack.EQ.5 .OR. ipack.EQ.
749  $ 6 ) .AND. lda.LT.kuu+1 ) .OR.
750  $ ( ipack.EQ.7 .AND. lda.LT.kll+kuu+1 ) ) THEN
751  info = -26
752  END IF
753 *
754  IF( info.NE.0 ) THEN
755  CALL xerbla( 'ZLATMR', -info )
756  RETURN
757  END IF
758 *
759 * Decide if we can pivot consistently
760 *
761  fulbnd = .false.
762  IF( kuu.EQ.n-1 .AND. kll.EQ.m-1 )
763  $ fulbnd = .true.
764 *
765 * Initialize random number generator
766 *
767  DO 30 i = 1, 4
768  iseed( i ) = mod( abs( iseed( i ) ), 4096 )
769  30 CONTINUE
770 *
771  iseed( 4 ) = 2*( iseed( 4 ) / 2 ) + 1
772 *
773 * 2) Set up D, DL, and DR, if indicated.
774 *
775 * Compute D according to COND and MODE
776 *
777  CALL zlatm1( mode, cond, irsign, idist, iseed, d, mnmin, info )
778  IF( info.NE.0 ) THEN
779  info = 1
780  RETURN
781  END IF
782  IF( mode.NE.0 .AND. mode.NE.-6 .AND. mode.NE.6 ) THEN
783 *
784 * Scale by DMAX
785 *
786  temp = abs( d( 1 ) )
787  DO 40 i = 2, mnmin
788  temp = max( temp, abs( d( i ) ) )
789  40 CONTINUE
790  IF( temp.EQ.zero .AND. dmax.NE.czero ) THEN
791  info = 2
792  RETURN
793  END IF
794  IF( temp.NE.zero ) THEN
795  calpha = dmax / temp
796  ELSE
797  calpha = cone
798  END IF
799  DO 50 i = 1, mnmin
800  d( i ) = calpha*d( i )
801  50 CONTINUE
802 *
803  END IF
804 *
805 * If matrix Hermitian, make D real
806 *
807  IF( isym.EQ.0 ) THEN
808  DO 60 i = 1, mnmin
809  d( i ) = dble( d( i ) )
810  60 CONTINUE
811  END IF
812 *
813 * Compute DL if grading set
814 *
815  IF( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR. igrade.EQ.
816  $ 5 .OR. igrade.EQ.6 ) THEN
817  CALL zlatm1( model, condl, 0, idist, iseed, dl, m, info )
818  IF( info.NE.0 ) THEN
819  info = 3
820  RETURN
821  END IF
822  END IF
823 *
824 * Compute DR if grading set
825 *
826  IF( igrade.EQ.2 .OR. igrade.EQ.3 ) THEN
827  CALL zlatm1( moder, condr, 0, idist, iseed, dr, n, info )
828  IF( info.NE.0 ) THEN
829  info = 4
830  RETURN
831  END IF
832  END IF
833 *
834 * 3) Generate IWORK if pivoting
835 *
836  IF( ipvtng.GT.0 ) THEN
837  DO 70 i = 1, npvts
838  iwork( i ) = i
839  70 CONTINUE
840  IF( fulbnd ) THEN
841  DO 80 i = 1, npvts
842  k = ipivot( i )
843  j = iwork( i )
844  iwork( i ) = iwork( k )
845  iwork( k ) = j
846  80 CONTINUE
847  ELSE
848  DO 90 i = npvts, 1, -1
849  k = ipivot( i )
850  j = iwork( i )
851  iwork( i ) = iwork( k )
852  iwork( k ) = j
853  90 CONTINUE
854  END IF
855  END IF
856 *
857 * 4) Generate matrices for each kind of PACKing
858 * Always sweep matrix columnwise (if symmetric, upper
859 * half only) so that matrix generated does not depend
860 * on PACK
861 *
862  IF( fulbnd ) THEN
863 *
864 * Use ZLATM3 so matrices generated with differing PIVOTing only
865 * differ only in the order of their rows and/or columns.
866 *
867  IF( ipack.EQ.0 ) THEN
868  IF( isym.EQ.0 ) THEN
869  DO 110 j = 1, n
870  DO 100 i = 1, j
871  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
872  $ idist, iseed, d, igrade, dl, dr, ipvtng,
873  $ iwork, sparse )
874  a( isub, jsub ) = ctemp
875  a( jsub, isub ) = dconjg( ctemp )
876  100 CONTINUE
877  110 CONTINUE
878  ELSE IF( isym.EQ.1 ) THEN
879  DO 130 j = 1, n
880  DO 120 i = 1, m
881  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
882  $ idist, iseed, d, igrade, dl, dr, ipvtng,
883  $ iwork, sparse )
884  a( isub, jsub ) = ctemp
885  120 CONTINUE
886  130 CONTINUE
887  ELSE IF( isym.EQ.2 ) THEN
888  DO 150 j = 1, n
889  DO 140 i = 1, j
890  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
891  $ idist, iseed, d, igrade, dl, dr, ipvtng,
892  $ iwork, sparse )
893  a( isub, jsub ) = ctemp
894  a( jsub, isub ) = ctemp
895  140 CONTINUE
896  150 CONTINUE
897  END IF
898 *
899  ELSE IF( ipack.EQ.1 ) THEN
900 *
901  DO 170 j = 1, n
902  DO 160 i = 1, j
903  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
904  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
905  $ sparse )
906  mnsub = min( isub, jsub )
907  mxsub = max( isub, jsub )
908  IF( mxsub.EQ.isub .AND. isym.EQ.0 ) THEN
909  a( mnsub, mxsub ) = dconjg( ctemp )
910  ELSE
911  a( mnsub, mxsub ) = ctemp
912  END IF
913  IF( mnsub.NE.mxsub )
914  $ a( mxsub, mnsub ) = czero
915  160 CONTINUE
916  170 CONTINUE
917 *
918  ELSE IF( ipack.EQ.2 ) THEN
919 *
920  DO 190 j = 1, n
921  DO 180 i = 1, j
922  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
923  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
924  $ sparse )
925  mnsub = min( isub, jsub )
926  mxsub = max( isub, jsub )
927  IF( mxsub.EQ.jsub .AND. isym.EQ.0 ) THEN
928  a( mxsub, mnsub ) = dconjg( ctemp )
929  ELSE
930  a( mxsub, mnsub ) = ctemp
931  END IF
932  IF( mnsub.NE.mxsub )
933  $ a( mnsub, mxsub ) = czero
934  180 CONTINUE
935  190 CONTINUE
936 *
937  ELSE IF( ipack.EQ.3 ) THEN
938 *
939  DO 210 j = 1, n
940  DO 200 i = 1, j
941  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
942  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
943  $ sparse )
944 *
945 * Compute K = location of (ISUB,JSUB) entry in packed
946 * array
947 *
948  mnsub = min( isub, jsub )
949  mxsub = max( isub, jsub )
950  k = mxsub*( mxsub-1 ) / 2 + mnsub
951 *
952 * Convert K to (IISUB,JJSUB) location
953 *
954  jjsub = ( k-1 ) / lda + 1
955  iisub = k - lda*( jjsub-1 )
956 *
957  IF( mxsub.EQ.isub .AND. isym.EQ.0 ) THEN
958  a( iisub, jjsub ) = dconjg( ctemp )
959  ELSE
960  a( iisub, jjsub ) = ctemp
961  END IF
962  200 CONTINUE
963  210 CONTINUE
964 *
965  ELSE IF( ipack.EQ.4 ) THEN
966 *
967  DO 230 j = 1, n
968  DO 220 i = 1, j
969  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
970  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
971  $ sparse )
972 *
973 * Compute K = location of (I,J) entry in packed array
974 *
975  mnsub = min( isub, jsub )
976  mxsub = max( isub, jsub )
977  IF( mnsub.EQ.1 ) THEN
978  k = mxsub
979  ELSE
980  k = n*( n+1 ) / 2 - ( n-mnsub+1 )*( n-mnsub+2 ) /
981  $ 2 + mxsub - mnsub + 1
982  END IF
983 *
984 * Convert K to (IISUB,JJSUB) location
985 *
986  jjsub = ( k-1 ) / lda + 1
987  iisub = k - lda*( jjsub-1 )
988 *
989  IF( mxsub.EQ.jsub .AND. isym.EQ.0 ) THEN
990  a( iisub, jjsub ) = dconjg( ctemp )
991  ELSE
992  a( iisub, jjsub ) = ctemp
993  END IF
994  220 CONTINUE
995  230 CONTINUE
996 *
997  ELSE IF( ipack.EQ.5 ) THEN
998 *
999  DO 250 j = 1, n
1000  DO 240 i = j - kuu, j
1001  IF( i.LT.1 ) THEN
1002  a( j-i+1, i+n ) = czero
1003  ELSE
1004  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
1005  $ idist, iseed, d, igrade, dl, dr, ipvtng,
1006  $ iwork, sparse )
1007  mnsub = min( isub, jsub )
1008  mxsub = max( isub, jsub )
1009  IF( mxsub.EQ.jsub .AND. isym.EQ.0 ) THEN
1010  a( mxsub-mnsub+1, mnsub ) = dconjg( ctemp )
1011  ELSE
1012  a( mxsub-mnsub+1, mnsub ) = ctemp
1013  END IF
1014  END IF
1015  240 CONTINUE
1016  250 CONTINUE
1017 *
1018  ELSE IF( ipack.EQ.6 ) THEN
1019 *
1020  DO 270 j = 1, n
1021  DO 260 i = j - kuu, j
1022  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
1023  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
1024  $ sparse )
1025  mnsub = min( isub, jsub )
1026  mxsub = max( isub, jsub )
1027  IF( mxsub.EQ.isub .AND. isym.EQ.0 ) THEN
1028  a( mnsub-mxsub+kuu+1, mxsub ) = dconjg( ctemp )
1029  ELSE
1030  a( mnsub-mxsub+kuu+1, mxsub ) = ctemp
1031  END IF
1032  260 CONTINUE
1033  270 CONTINUE
1034 *
1035  ELSE IF( ipack.EQ.7 ) THEN
1036 *
1037  IF( isym.NE.1 ) THEN
1038  DO 290 j = 1, n
1039  DO 280 i = j - kuu, j
1040  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
1041  $ idist, iseed, d, igrade, dl, dr, ipvtng,
1042  $ iwork, sparse )
1043  mnsub = min( isub, jsub )
1044  mxsub = max( isub, jsub )
1045  IF( i.LT.1 )
1046  $ a( j-i+1+kuu, i+n ) = czero
1047  IF( mxsub.EQ.isub .AND. isym.EQ.0 ) THEN
1048  a( mnsub-mxsub+kuu+1, mxsub ) = dconjg( ctemp )
1049  ELSE
1050  a( mnsub-mxsub+kuu+1, mxsub ) = ctemp
1051  END IF
1052  IF( i.GE.1 .AND. mnsub.NE.mxsub ) THEN
1053  IF( mnsub.EQ.isub .AND. isym.EQ.0 ) THEN
1054  a( mxsub-mnsub+1+kuu,
1055  $ mnsub ) = dconjg( ctemp )
1056  ELSE
1057  a( mxsub-mnsub+1+kuu, mnsub ) = ctemp
1058  END IF
1059  END IF
1060  280 CONTINUE
1061  290 CONTINUE
1062  ELSE IF( isym.EQ.1 ) THEN
1063  DO 310 j = 1, n
1064  DO 300 i = j - kuu, j + kll
1065  ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
1066  $ idist, iseed, d, igrade, dl, dr, ipvtng,
1067  $ iwork, sparse )
1068  a( isub-jsub+kuu+1, jsub ) = ctemp
1069  300 CONTINUE
1070  310 CONTINUE
1071  END IF
1072 *
1073  END IF
1074 *
1075  ELSE
1076 *
1077 * Use ZLATM2
1078 *
1079  IF( ipack.EQ.0 ) THEN
1080  IF( isym.EQ.0 ) THEN
1081  DO 330 j = 1, n
1082  DO 320 i = 1, j
1083  a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1084  $ iseed, d, igrade, dl, dr, ipvtng,
1085  $ iwork, sparse )
1086  a( j, i ) = dconjg( a( i, j ) )
1087  320 CONTINUE
1088  330 CONTINUE
1089  ELSE IF( isym.EQ.1 ) THEN
1090  DO 350 j = 1, n
1091  DO 340 i = 1, m
1092  a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1093  $ iseed, d, igrade, dl, dr, ipvtng,
1094  $ iwork, sparse )
1095  340 CONTINUE
1096  350 CONTINUE
1097  ELSE IF( isym.EQ.2 ) THEN
1098  DO 370 j = 1, n
1099  DO 360 i = 1, j
1100  a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1101  $ iseed, d, igrade, dl, dr, ipvtng,
1102  $ iwork, sparse )
1103  a( j, i ) = a( i, j )
1104  360 CONTINUE
1105  370 CONTINUE
1106  END IF
1107 *
1108  ELSE IF( ipack.EQ.1 ) THEN
1109 *
1110  DO 390 j = 1, n
1111  DO 380 i = 1, j
1112  a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist, iseed,
1113  $ d, igrade, dl, dr, ipvtng, iwork, sparse )
1114  IF( i.NE.j )
1115  $ a( j, i ) = czero
1116  380 CONTINUE
1117  390 CONTINUE
1118 *
1119  ELSE IF( ipack.EQ.2 ) THEN
1120 *
1121  DO 410 j = 1, n
1122  DO 400 i = 1, j
1123  IF( isym.EQ.0 ) THEN
1124  a( j, i ) = dconjg( zlatm2( m, n, i, j, kl, ku,
1125  $ idist, iseed, d, igrade, dl, dr,
1126  $ ipvtng, iwork, sparse ) )
1127  ELSE
1128  a( j, i ) = zlatm2( m, n, i, j, kl, ku, idist,
1129  $ iseed, d, igrade, dl, dr, ipvtng,
1130  $ iwork, sparse )
1131  END IF
1132  IF( i.NE.j )
1133  $ a( i, j ) = czero
1134  400 CONTINUE
1135  410 CONTINUE
1136 *
1137  ELSE IF( ipack.EQ.3 ) THEN
1138 *
1139  isub = 0
1140  jsub = 1
1141  DO 430 j = 1, n
1142  DO 420 i = 1, j
1143  isub = isub + 1
1144  IF( isub.GT.lda ) THEN
1145  isub = 1
1146  jsub = jsub + 1
1147  END IF
1148  a( isub, jsub ) = zlatm2( m, n, i, j, kl, ku, idist,
1149  $ iseed, d, igrade, dl, dr, ipvtng,
1150  $ iwork, sparse )
1151  420 CONTINUE
1152  430 CONTINUE
1153 *
1154  ELSE IF( ipack.EQ.4 ) THEN
1155 *
1156  IF( isym.EQ.0 .OR. isym.EQ.2 ) THEN
1157  DO 450 j = 1, n
1158  DO 440 i = 1, j
1159 *
1160 * Compute K = location of (I,J) entry in packed array
1161 *
1162  IF( i.EQ.1 ) THEN
1163  k = j
1164  ELSE
1165  k = n*( n+1 ) / 2 - ( n-i+1 )*( n-i+2 ) / 2 +
1166  $ j - i + 1
1167  END IF
1168 *
1169 * Convert K to (ISUB,JSUB) location
1170 *
1171  jsub = ( k-1 ) / lda + 1
1172  isub = k - lda*( jsub-1 )
1173 *
1174  a( isub, jsub ) = zlatm2( m, n, i, j, kl, ku,
1175  $ idist, iseed, d, igrade, dl, dr,
1176  $ ipvtng, iwork, sparse )
1177  IF( isym.EQ.0 )
1178  $ a( isub, jsub ) = dconjg( a( isub, jsub ) )
1179  440 CONTINUE
1180  450 CONTINUE
1181  ELSE
1182  isub = 0
1183  jsub = 1
1184  DO 470 j = 1, n
1185  DO 460 i = j, m
1186  isub = isub + 1
1187  IF( isub.GT.lda ) THEN
1188  isub = 1
1189  jsub = jsub + 1
1190  END IF
1191  a( isub, jsub ) = zlatm2( m, n, i, j, kl, ku,
1192  $ idist, iseed, d, igrade, dl, dr,
1193  $ ipvtng, iwork, sparse )
1194  460 CONTINUE
1195  470 CONTINUE
1196  END IF
1197 *
1198  ELSE IF( ipack.EQ.5 ) THEN
1199 *
1200  DO 490 j = 1, n
1201  DO 480 i = j - kuu, j
1202  IF( i.LT.1 ) THEN
1203  a( j-i+1, i+n ) = czero
1204  ELSE
1205  IF( isym.EQ.0 ) THEN
1206  a( j-i+1, i ) = dconjg( zlatm2( m, n, i, j, kl,
1207  $ ku, idist, iseed, d, igrade, dl,
1208  $ dr, ipvtng, iwork, sparse ) )
1209  ELSE
1210  a( j-i+1, i ) = zlatm2( m, n, i, j, kl, ku,
1211  $ idist, iseed, d, igrade, dl, dr,
1212  $ ipvtng, iwork, sparse )
1213  END IF
1214  END IF
1215  480 CONTINUE
1216  490 CONTINUE
1217 *
1218  ELSE IF( ipack.EQ.6 ) THEN
1219 *
1220  DO 510 j = 1, n
1221  DO 500 i = j - kuu, j
1222  a( i-j+kuu+1, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1223  $ iseed, d, igrade, dl, dr, ipvtng,
1224  $ iwork, sparse )
1225  500 CONTINUE
1226  510 CONTINUE
1227 *
1228  ELSE IF( ipack.EQ.7 ) THEN
1229 *
1230  IF( isym.NE.1 ) THEN
1231  DO 530 j = 1, n
1232  DO 520 i = j - kuu, j
1233  a( i-j+kuu+1, j ) = zlatm2( m, n, i, j, kl, ku,
1234  $ idist, iseed, d, igrade, dl,
1235  $ dr, ipvtng, iwork, sparse )
1236  IF( i.LT.1 )
1237  $ a( j-i+1+kuu, i+n ) = czero
1238  IF( i.GE.1 .AND. i.NE.j ) THEN
1239  IF( isym.EQ.0 ) THEN
1240  a( j-i+1+kuu, i ) = dconjg( a( i-j+kuu+1,
1241  $ j ) )
1242  ELSE
1243  a( j-i+1+kuu, i ) = a( i-j+kuu+1, j )
1244  END IF
1245  END IF
1246  520 CONTINUE
1247  530 CONTINUE
1248  ELSE IF( isym.EQ.1 ) THEN
1249  DO 550 j = 1, n
1250  DO 540 i = j - kuu, j + kll
1251  a( i-j+kuu+1, j ) = zlatm2( m, n, i, j, kl, ku,
1252  $ idist, iseed, d, igrade, dl,
1253  $ dr, ipvtng, iwork, sparse )
1254  540 CONTINUE
1255  550 CONTINUE
1256  END IF
1257 *
1258  END IF
1259 *
1260  END IF
1261 *
1262 * 5) Scaling the norm
1263 *
1264  IF( ipack.EQ.0 ) THEN
1265  onorm = zlange( 'M', m, n, a, lda, tempa )
1266  ELSE IF( ipack.EQ.1 ) THEN
1267  onorm = zlansy( 'M', 'U', n, a, lda, tempa )
1268  ELSE IF( ipack.EQ.2 ) THEN
1269  onorm = zlansy( 'M', 'L', n, a, lda, tempa )
1270  ELSE IF( ipack.EQ.3 ) THEN
1271  onorm = zlansp( 'M', 'U', n, a, tempa )
1272  ELSE IF( ipack.EQ.4 ) THEN
1273  onorm = zlansp( 'M', 'L', n, a, tempa )
1274  ELSE IF( ipack.EQ.5 ) THEN
1275  onorm = zlansb( 'M', 'L', n, kll, a, lda, tempa )
1276  ELSE IF( ipack.EQ.6 ) THEN
1277  onorm = zlansb( 'M', 'U', n, kuu, a, lda, tempa )
1278  ELSE IF( ipack.EQ.7 ) THEN
1279  onorm = zlangb( 'M', n, kll, kuu, a, lda, tempa )
1280  END IF
1281 *
1282  IF( anorm.GE.zero ) THEN
1283 *
1284  IF( anorm.GT.zero .AND. onorm.EQ.zero ) THEN
1285 *
1286 * Desired scaling impossible
1287 *
1288  info = 5
1289  RETURN
1290 *
1291  ELSE IF( ( anorm.GT.one .AND. onorm.LT.one ) .OR.
1292  $ ( anorm.LT.one .AND. onorm.GT.one ) ) THEN
1293 *
1294 * Scale carefully to avoid over / underflow
1295 *
1296  IF( ipack.LE.2 ) THEN
1297  DO 560 j = 1, n
1298  CALL zdscal( m, one / onorm, a( 1, j ), 1 )
1299  CALL zdscal( m, anorm, a( 1, j ), 1 )
1300  560 CONTINUE
1301 *
1302  ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 ) THEN
1303 *
1304  CALL zdscal( n*( n+1 ) / 2, one / onorm, a, 1 )
1305  CALL zdscal( n*( n+1 ) / 2, anorm, a, 1 )
1306 *
1307  ELSE IF( ipack.GE.5 ) THEN
1308 *
1309  DO 570 j = 1, n
1310  CALL zdscal( kll+kuu+1, one / onorm, a( 1, j ), 1 )
1311  CALL zdscal( kll+kuu+1, anorm, a( 1, j ), 1 )
1312  570 CONTINUE
1313 *
1314  END IF
1315 *
1316  ELSE
1317 *
1318 * Scale straightforwardly
1319 *
1320  IF( ipack.LE.2 ) THEN
1321  DO 580 j = 1, n
1322  CALL zdscal( m, anorm / onorm, a( 1, j ), 1 )
1323  580 CONTINUE
1324 *
1325  ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 ) THEN
1326 *
1327  CALL zdscal( n*( n+1 ) / 2, anorm / onorm, a, 1 )
1328 *
1329  ELSE IF( ipack.GE.5 ) THEN
1330 *
1331  DO 590 j = 1, n
1332  CALL zdscal( kll+kuu+1, anorm / onorm, a( 1, j ), 1 )
1333  590 CONTINUE
1334  END IF
1335 *
1336  END IF
1337 *
1338  END IF
1339 *
1340 * End of ZLATMR
1341 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
complex *16 function zlatm3(M, N, I, J, ISUB, JSUB, KL, KU, IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE)
ZLATM3
Definition: zlatm3.f:231
double precision function zlansb(NORM, UPLO, N, K, AB, LDAB, WORK)
ZLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
Definition: zlansb.f:132
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
double precision function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
Definition: zlansy.f:125
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:54
subroutine zlatm1(MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO)
ZLATM1
Definition: zlatm1.f:139
double precision function zlansp(NORM, UPLO, N, AP, WORK)
ZLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
Definition: zlansp.f:117
complex *16 function zlatm2(M, N, I, J, KL, KU, IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE)
ZLATM2
Definition: zlatm2.f:213
double precision function zlangb(NORM, N, KL, KU, AB, LDAB, WORK)
ZLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlangb.f:127
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: