TESTING/LIN/cerrqrt.f

   1 *> \brief \b CERRQRT
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE CERRQRT( PATH, NUNIT )
  12 *
  13 *       .. Scalar Arguments ..
  14 *       CHARACTER*3        PATH
  15 *       INTEGER            NUNIT
  16 *       ..
  17 *
  18 *
  19 *> \par Purpose:
  20 *  =============
  21 *>
  22 *> \verbatim
  23 *>
  24 *> CERRQRT tests the error exits for the COMPLEX routines
  25 *> that use the QRT decomposition of a general matrix.
  26 *> \endverbatim
  27 *
  28 *  Arguments:
  29 *  ==========
  30 *
  31 *> \param[in] PATH
  32 *> \verbatim
  33 *>          PATH is CHARACTER*3
  34 *>          The LAPACK path name for the routines to be tested.
  35 *> \endverbatim
  36 *>
  37 *> \param[in] NUNIT
  38 *> \verbatim
  39 *>          NUNIT is INTEGER
  40 *>          The unit number for output.
  41 *> \endverbatim
  42 *
  43 *  Authors:
  44 *  ========
  45 *
  46 *> \author Univ. of Tennessee
  47 *> \author Univ. of California Berkeley
  48 *> \author Univ. of Colorado Denver
  49 *> \author NAG Ltd.
  50 *
  51 *> \date November 2011
  52 *
  53 *> \ingroup complex_lin
  54 *
  55 *  =====================================================================
  56       SUBROUTINE CERRQRT( PATH, NUNIT )
  57       IMPLICIT NONE
  58 *
  59 *  -- LAPACK test routine (version 3.4.0) --
  60 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  61 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  62 *     November 2011
  63 *
  64 *     .. Scalar Arguments ..
  65       CHARACTER*3        PATH
  66       INTEGER            NUNIT
  67 *     ..
  68 *
  69 *  =====================================================================
  70 *
  71 *     .. Parameters ..
  72       INTEGER            NMAX
  73       PARAMETER          ( NMAX = 2 )
  74 *     ..
  75 *     .. Local Scalars ..
  76       INTEGER            I, INFO, J
  77 *     ..
  78 *     .. Local Arrays ..
  79       COMPLEX            A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
  80      $                   C( NMAX, NMAX )
  81 *     ..
  82 *     .. External Subroutines ..
  83       EXTERNAL           ALAESM, CHKXER, CGEQRT2, CGEQRT3, CGEQRT,
  84      $                   CGEMQRT
  85 *     ..
  86 *     .. Scalars in Common ..
  87       LOGICAL            LERR, OK
  88       CHARACTER*32       SRNAMT
  89       INTEGER            INFOT, NOUT
  90 *     ..
  91 *     .. Common blocks ..
  92       COMMON             / INFOC / INFOT, NOUT, OK, LERR
  93       COMMON             / SRNAMC / SRNAMT
  94 *     ..
  95 *     .. Intrinsic Functions ..
  96       INTRINSIC          FLOAT, CMPLX
  97 *     ..
  98 *     .. Executable Statements ..
  99 *
 100       NOUT = NUNIT
 101       WRITE( NOUT, FMT = * )
 102 *
 103 *     Set the variables to innocuous values.
 104 *
 105       DO J = 1, NMAX
 106          DO I = 1, NMAX
 107             A( I, J ) = 1.0 / CMPLX( FLOAT(I+J), 0.0 )
 108             C( I, J ) = 1.0 / CMPLX( FLOAT(I+J), 0.0 )
 109             T( I, J ) = 1.0 / CMPLX( FLOAT(I+J), 0.0 )
 110          END DO
 111          W( J ) = 0.0
 112       END DO
 113       OK = .TRUE.
 114 *
 115 *     Error exits for QRT factorization
 116 *
 117 *     CGEQRT
 118 *
 119       SRNAMT = 'CGEQRT'
 120       INFOT = 1
 121       CALL CGEQRT( -1, 0, 1, A, 1, T, 1, W, INFO )
 122       CALL CHKXER( 'CGEQRT', INFOT, NOUT, LERR, OK )
 123       INFOT = 2
 124       CALL CGEQRT( 0, -1, 1, A, 1, T, 1, W, INFO )
 125       CALL CHKXER( 'CGEQRT', INFOT, NOUT, LERR, OK )
 126       INFOT = 3
 127       CALL CGEQRT( 0, 0, 0, A, 1, T, 1, W, INFO )
 128       CALL CHKXER( 'CGEQRT', INFOT, NOUT, LERR, OK )
 129       INFOT = 5
 130       CALL CGEQRT( 2, 1, 1, A, 1, T, 1, W, INFO )
 131       CALL CHKXER( 'CGEQRT', INFOT, NOUT, LERR, OK )
 132       INFOT = 7
 133       CALL CGEQRT( 2, 2, 2, A, 2, T, 1, W, INFO )
 134       CALL CHKXER( 'CGEQRT', INFOT, NOUT, LERR, OK )
 135 *
 136 *     CGEQRT2
 137 *
 138       SRNAMT = 'CGEQRT2'
 139       INFOT = 1
 140       CALL CGEQRT2( -1, 0, A, 1, T, 1, INFO )
 141       CALL CHKXER( 'CGEQRT2', INFOT, NOUT, LERR, OK )
 142       INFOT = 2
 143       CALL CGEQRT2( 0, -1, A, 1, T, 1, INFO )
 144       CALL CHKXER( 'CGEQRT2', INFOT, NOUT, LERR, OK )
 145       INFOT = 4
 146       CALL CGEQRT2( 2, 1, A, 1, T, 1, INFO )
 147       CALL CHKXER( 'CGEQRT2', INFOT, NOUT, LERR, OK )
 148       INFOT = 6
 149       CALL CGEQRT2( 2, 2, A, 2, T, 1, INFO )
 150       CALL CHKXER( 'CGEQRT2', INFOT, NOUT, LERR, OK )
 151 *
 152 *     CGEQRT3
 153 *
 154       SRNAMT = 'CGEQRT3'
 155       INFOT = 1
 156       CALL CGEQRT3( -1, 0, A, 1, T, 1, INFO )
 157       CALL CHKXER( 'CGEQRT3', INFOT, NOUT, LERR, OK )
 158       INFOT = 2
 159       CALL CGEQRT3( 0, -1, A, 1, T, 1, INFO )
 160       CALL CHKXER( 'CGEQRT3', INFOT, NOUT, LERR, OK )
 161       INFOT = 4
 162       CALL CGEQRT3( 2, 1, A, 1, T, 1, INFO )
 163       CALL CHKXER( 'CGEQRT3', INFOT, NOUT, LERR, OK )
 164       INFOT = 6
 165       CALL CGEQRT3( 2, 2, A, 2, T, 1, INFO )
 166       CALL CHKXER( 'CGEQRT3', INFOT, NOUT, LERR, OK )
 167 *
 168 *     CGEMQRT
 169 *
 170       SRNAMT = 'CGEMQRT'
 171       INFOT = 1
 172       CALL CGEMQRT( '/', 'N', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO )
 173       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 174       INFOT = 2
 175       CALL CGEMQRT( 'L', '/', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO )
 176       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 177       INFOT = 3
 178       CALL CGEMQRT( 'L', 'N', -1, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO )
 179       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 180       INFOT = 4
 181       CALL CGEMQRT( 'L', 'N', 0, -1, 0, 1, A, 1, T, 1, C, 1, W, INFO )
 182       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 183       INFOT = 5
 184       CALL CGEMQRT( 'L', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO )
 185       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 186       INFOT = 5
 187       CALL CGEMQRT( 'R', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO )
 188       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 189       INFOT = 6
 190       CALL CGEMQRT( 'L', 'N', 0, 0, 0, 0, A, 1, T, 1, C, 1, W, INFO )
 191       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 192       INFOT = 8
 193       CALL CGEMQRT( 'R', 'N', 1, 2, 1, 1, A, 1, T, 1, C, 1, W, INFO )
 194       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 195       INFOT = 8
 196       CALL CGEMQRT( 'L', 'N', 2, 1, 1, 1, A, 1, T, 1, C, 1, W, INFO )
 197       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 198       INFOT = 10
 199       CALL CGEMQRT( 'R', 'N', 1, 1, 1, 1, A, 1, T, 0, C, 1, W, INFO )
 200       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 201       INFOT = 12
 202       CALL CGEMQRT( 'L', 'N', 1, 1, 1, 1, A, 1, T, 1, C, 0, W, INFO )
 203       CALL CHKXER( 'CGEMQRT', INFOT, NOUT, LERR, OK )
 204 *
 205 *     Print a summary line.
 206 *
 207       CALL ALAESM( PATH, OK, NOUT )
 208 *
 209       RETURN
 210 *
 211 *     End of CERRQRT
 212 *
 213       END