TESTING/LIN/zerrps.f

   1 *> \brief \b ZERRPS
   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 ZERRPS( PATH, NUNIT )
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER            NUNIT
  15 *       CHARACTER*3        PATH
  16 *       ..
  17 *
  18 *
  19 *> \par Purpose:
  20 *  =============
  21 *>
  22 *> \verbatim
  23 *>
  24 *> ZERRPS tests the error exits for the COMPLEX routines
  25 *> for ZPSTRF.
  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 complex16_lin
  54 *
  55 *  =====================================================================
  56       SUBROUTINE ZERRPS( PATH, NUNIT )
  57 *
  58 *  -- LAPACK test routine (version 3.4.0) --
  59 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  60 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  61 *     November 2011
  62 *
  63 *     .. Scalar Arguments ..
  64       INTEGER            NUNIT
  65       CHARACTER*3        PATH
  66 *     ..
  67 *
  68 *  =====================================================================
  69 *
  70 *     .. Parameters ..
  71       INTEGER            NMAX
  72       PARAMETER          ( NMAX = 4 )
  73 *     ..
  74 *     .. Local Scalars ..
  75       INTEGER            I, INFO, J, RANK
  76 *     ..
  77 *     .. Local Arrays ..
  78       COMPLEX*16         A( NMAX, NMAX )
  79       DOUBLE PRECISION   RWORK( 2*NMAX )
  80       INTEGER            PIV( NMAX )
  81 *     ..
  82 *     .. External Subroutines ..
  83       EXTERNAL           ALAESM, CHKXER, ZPSTF2, ZPSTRF
  84 *     ..
  85 *     .. Scalars in Common ..
  86       INTEGER            INFOT, NOUT
  87       LOGICAL            LERR, OK
  88       CHARACTER*32       SRNAMT
  89 *     ..
  90 *     .. Common blocks ..
  91       COMMON             / INFOC / INFOT, NOUT, OK, LERR
  92       COMMON             / SRNAMC / SRNAMT
  93 *     ..
  94 *     .. Intrinsic Functions ..
  95       INTRINSIC          DBLE
  96 *     ..
  97 *     .. Executable Statements ..
  98 *
  99       NOUT = NUNIT
 100       WRITE( NOUT, FMT = * )
 101 *
 102 *     Set the variables to innocuous values.
 103 *
 104       DO 110 J = 1, NMAX
 105          DO 100 I = 1, NMAX
 106             A( I, J ) = 1.D0 / DBLE( I+J )
 107 *
 108   100    CONTINUE
 109          PIV( J ) = J
 110          RWORK( J ) = 0.D0
 111          RWORK( NMAX+J ) = 0.D0
 112 *
 113   110 CONTINUE
 114       OK = .TRUE.
 115 *
 116 *
 117 *        Test error exits of the routines that use the Cholesky
 118 *        decomposition of an Hermitian positive semidefinite matrix.
 119 *
 120 *        ZPSTRF
 121 *
 122       SRNAMT = 'ZPSTRF'
 123       INFOT = 1
 124       CALL ZPSTRF( '/', 0, A, 1, PIV, RANK, -1.D0, RWORK, INFO )
 125       CALL CHKXER( 'ZPSTRF', INFOT, NOUT, LERR, OK )
 126       INFOT = 2
 127       CALL ZPSTRF( 'U', -1, A, 1, PIV, RANK, -1.D0, RWORK, INFO )
 128       CALL CHKXER( 'ZPSTRF', INFOT, NOUT, LERR, OK )
 129       INFOT = 4
 130       CALL ZPSTRF( 'U', 2, A, 1, PIV, RANK, -1.D0, RWORK, INFO )
 131       CALL CHKXER( 'ZPSTRF', INFOT, NOUT, LERR, OK )
 132 *
 133 *        ZPSTF2
 134 *
 135       SRNAMT = 'ZPSTF2'
 136       INFOT = 1
 137       CALL ZPSTF2( '/', 0, A, 1, PIV, RANK, -1.D0, RWORK, INFO )
 138       CALL CHKXER( 'ZPSTF2', INFOT, NOUT, LERR, OK )
 139       INFOT = 2
 140       CALL ZPSTF2( 'U', -1, A, 1, PIV, RANK, -1.D0, RWORK, INFO )
 141       CALL CHKXER( 'ZPSTF2', INFOT, NOUT, LERR, OK )
 142       INFOT = 4
 143       CALL ZPSTF2( 'U', 2, A, 1, PIV, RANK, -1.D0, RWORK, INFO )
 144       CALL CHKXER( 'ZPSTF2', INFOT, NOUT, LERR, OK )
 145 *
 146 *
 147 *     Print a summary line.
 148 *
 149       CALL ALAESM( PATH, OK, NOUT )
 150 *
 151       RETURN
 152 *
 153 *     End of ZERRPS
 154 *
 155       END