TESTING/LIN/derrps.f

   1 *> \brief \b DERRPS
   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 DERRPS( 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 *> DERRPS tests the error exits for the DOUBLE PRECISION routines
  25 *> for DPSTRF.
  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 double_lin
  54 *
  55 *  =====================================================================
  56       SUBROUTINE DERRPS( 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       DOUBLE PRECISION   A( NMAX, NMAX ), WORK( 2*NMAX )
  79       INTEGER            PIV( NMAX )
  80 *     ..
  81 *     .. External Subroutines ..
  82       EXTERNAL           ALAESM, CHKXER, DPSTF2, DPSTRF
  83 *     ..
  84 *     .. Scalars in Common ..
  85       INTEGER            INFOT, NOUT
  86       LOGICAL            LERR, OK
  87       CHARACTER*32       SRNAMT
  88 *     ..
  89 *     .. Common blocks ..
  90       COMMON             / INFOC / INFOT, NOUT, OK, LERR
  91       COMMON             / SRNAMC / SRNAMT
  92 *     ..
  93 *     .. Intrinsic Functions ..
  94       INTRINSIC          DBLE
  95 *     ..
  96 *     .. Executable Statements ..
  97 *
  98       NOUT = NUNIT
  99       WRITE( NOUT, FMT = * )
 100 *
 101 *     Set the variables to innocuous values.
 102 *
 103       DO 110 J = 1, NMAX
 104          DO 100 I = 1, NMAX
 105             A( I, J ) = 1.D0 / DBLE( I+J )
 106 *
 107   100    CONTINUE
 108          PIV( J ) = J
 109          WORK( J ) = 0.D0
 110          WORK( NMAX+J ) = 0.D0
 111 *
 112   110 CONTINUE
 113       OK = .TRUE.
 114 *
 115 *
 116 *        Test error exits of the routines that use the Cholesky
 117 *        decomposition of a symmetric positive semidefinite matrix.
 118 *
 119 *        DPSTRF
 120 *
 121       SRNAMT = 'DPSTRF'
 122       INFOT = 1
 123       CALL DPSTRF( '/', 0, A, 1, PIV, RANK, -1.D0, WORK, INFO )
 124       CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
 125       INFOT = 2
 126       CALL DPSTRF( 'U', -1, A, 1, PIV, RANK, -1.D0, WORK, INFO )
 127       CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
 128       INFOT = 4
 129       CALL DPSTRF( 'U', 2, A, 1, PIV, RANK, -1.D0, WORK, INFO )
 130       CALL CHKXER( 'DPSTRF', INFOT, NOUT, LERR, OK )
 131 *
 132 *        DPSTF2
 133 *
 134       SRNAMT = 'DPSTF2'
 135       INFOT = 1
 136       CALL DPSTF2( '/', 0, A, 1, PIV, RANK, -1.D0, WORK, INFO )
 137       CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
 138       INFOT = 2
 139       CALL DPSTF2( 'U', -1, A, 1, PIV, RANK, -1.D0, WORK, INFO )
 140       CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
 141       INFOT = 4
 142       CALL DPSTF2( 'U', 2, A, 1, PIV, RANK, -1.D0, WORK, INFO )
 143       CALL CHKXER( 'DPSTF2', INFOT, NOUT, LERR, OK )
 144 *
 145 *
 146 *     Print a summary line.
 147 *
 148       CALL ALAESM( PATH, OK, NOUT )
 149 *
 150       RETURN
 151 *
 152 *     End of DERRPS
 153 *
 154       END