TESTING/LIN/derrls.f

   1 *> \brief \b DERRLS
   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 DERRLS( 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 *> DERRLS tests the error exits for the DOUBLE PRECISION least squares
  25 *> driver routines (DGELS, SGELSS, SGELSY, SGELSD).
  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 2015
  52 *
  53 *> \ingroup double_lin
  54 *
  55 *  =====================================================================
  56       SUBROUTINE DERRLS( PATH, NUNIT )
  57 *
  58 *  -- LAPACK test routine (version 3.6.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 2015
  62 *
  63 *     .. Scalar Arguments ..
  64       CHARACTER*3        PATH
  65       INTEGER            NUNIT
  66 *     ..
  67 *
  68 *  =====================================================================
  69 *
  70 *     .. Parameters ..
  71       INTEGER            NMAX
  72       PARAMETER          ( NMAX = 2 )
  73 *     ..
  74 *     .. Local Scalars ..
  75       CHARACTER*2        C2
  76       INTEGER            INFO, IRNK
  77       DOUBLE PRECISION   RCOND
  78 *     ..
  79 *     .. Local Arrays ..
  80       INTEGER            IP( NMAX )
  81       DOUBLE PRECISION   A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ),
  82      $                   W( NMAX )
  83 *     ..
  84 *     .. External Functions ..
  85       LOGICAL            LSAMEN
  86       EXTERNAL           LSAMEN
  87 *     ..
  88 *     .. External Subroutines ..
  89       EXTERNAL           ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELSY
  90 *     ..
  91 *     .. Scalars in Common ..
  92       LOGICAL            LERR, OK
  93       CHARACTER*32       SRNAMT
  94       INTEGER            INFOT, NOUT
  95 *     ..
  96 *     .. Common blocks ..
  97       COMMON             / INFOC / INFOT, NOUT, OK, LERR
  98       COMMON             / SRNAMC / SRNAMT
  99 *     ..
 100 *     .. Executable Statements ..
 101 *
 102       NOUT = NUNIT
 103       WRITE( NOUT, FMT = * )
 104       C2 = PATH( 2: 3 )
 105       A( 1, 1 ) = 1.0D+0
 106       A( 1, 2 ) = 2.0D+0
 107       A( 2, 2 ) = 3.0D+0
 108       A( 2, 1 ) = 4.0D+0
 109       OK = .TRUE.
 110 *
 111       IF( LSAMEN( 2, C2, 'LS' ) ) THEN
 112 *
 113 *        Test error exits for the least squares driver routines.
 114 *
 115 *        DGELS
 116 *
 117          SRNAMT = 'DGELS '
 118          INFOT = 1
 119          CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
 120          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 121          INFOT = 2
 122          CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
 123          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 124          INFOT = 3
 125          CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
 126          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 127          INFOT = 4
 128          CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
 129          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 130          INFOT = 6
 131          CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
 132          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 133          INFOT = 8
 134          CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
 135          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 136          INFOT = 10
 137          CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
 138          CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
 139 *
 140 *        DGELSS
 141 *
 142          SRNAMT = 'DGELSS'
 143          INFOT = 1
 144          CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
 145          CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
 146          INFOT = 2
 147          CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
 148          CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
 149          INFOT = 3
 150          CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
 151          CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
 152          INFOT = 5
 153          CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
 154          CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
 155          INFOT = 7
 156          CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
 157          CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
 158 *
 159 *        DGELSY
 160 *
 161          SRNAMT = 'DGELSY'
 162          INFOT = 1
 163          CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
 164      $                INFO )
 165          CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
 166          INFOT = 2
 167          CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
 168      $                INFO )
 169          CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
 170          INFOT = 3
 171          CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
 172      $                INFO )
 173          CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
 174          INFOT = 5
 175          CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
 176      $                INFO )
 177          CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
 178          INFOT = 7
 179          CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
 180      $                INFO )
 181          CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
 182          INFOT = 12
 183          CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
 184          CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
 185 *
 186 *        DGELSD
 187 *
 188          SRNAMT = 'DGELSD'
 189          INFOT = 1
 190          CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
 191      $                INFO )
 192          CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
 193          INFOT = 2
 194          CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
 195      $                INFO )
 196          CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
 197          INFOT = 3
 198          CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
 199      $                INFO )
 200          CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
 201          INFOT = 5
 202          CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP,
 203      $                INFO )
 204          CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
 205          INFOT = 7
 206          CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP,
 207      $                INFO )
 208          CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
 209          INFOT = 12
 210          CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
 211      $                INFO )
 212          CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
 213       END IF
 214 *
 215 *     Print a summary line.
 216 *
 217       CALL ALAESM( PATH, OK, NOUT )
 218 *
 219       RETURN
 220 *
 221 *     End of DERRLS
 222 *
 223       END