TESTING/LIN/derrrfp.f

   1 *> \brief \b DERRRFP
   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 DERRRFP( NUNIT )
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER            NUNIT
  15 *       ..
  16 *
  17 *
  18 *> \par Purpose:
  19 *  =============
  20 *>
  21 *> \verbatim
  22 *>
  23 *> DERRRFP tests the error exits for the DOUBLE PRECISION driver routines
  24 *> for solving linear systems of equations.
  25 *>
  26 *> DDRVRFP tests the DOUBLE PRECISION LAPACK RFP routines:
  27 *>     DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, DPFTRF, DPFTRS, DTPTTF,
  28 *>     DTPTTR, DTRTTF, and DTRTTP
  29 *> \endverbatim
  30 *
  31 *  Arguments:
  32 *  ==========
  33 *
  34 *> \param[in] NUNIT
  35 *> \verbatim
  36 *>          NUNIT is INTEGER
  37 *>          The unit number for output.
  38 *> \endverbatim
  39 *
  40 *  Authors:
  41 *  ========
  42 *
  43 *> \author Univ. of Tennessee
  44 *> \author Univ. of California Berkeley
  45 *> \author Univ. of Colorado Denver
  46 *> \author NAG Ltd.
  47 *
  48 *> \date November 2011
  49 *
  50 *> \ingroup double_lin
  51 *
  52 *  =====================================================================
  53       SUBROUTINE DERRRFP( NUNIT )
  54 *
  55 *  -- LAPACK test routine (version 3.4.0) --
  56 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  57 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  58 *     November 2011
  59 *
  60 *     .. Scalar Arguments ..
  61       INTEGER            NUNIT
  62 *     ..
  63 *
  64 *  =====================================================================
  65 *
  66 *     ..
  67 *     .. Local Scalars ..
  68       INTEGER            INFO
  69       DOUBLE PRECISION   ALPHA, BETA
  70 *     ..
  71 *     .. Local Arrays ..
  72       DOUBLE PRECISION   A( 1, 1), B( 1, 1)
  73 *     ..
  74 *     .. External Subroutines ..
  75       EXTERNAL           CHKXER, DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR,
  76      +                   DPFTRI, DPFTRF, DPFTRS, DTPTTF, DTPTTR, DTRTTF,
  77      +                   DTRTTP
  78 *     ..
  79 *     .. Scalars in Common ..
  80       LOGICAL            LERR, OK
  81       CHARACTER*32       SRNAMT
  82       INTEGER            INFOT, NOUT
  83 *     ..
  84 *     .. Common blocks ..
  85       COMMON             / INFOC / INFOT, NOUT, OK, LERR
  86       COMMON             / SRNAMC / SRNAMT
  87 *     ..
  88 *     .. Executable Statements ..
  89 *
  90       NOUT = NUNIT
  91       OK = .TRUE.
  92       A( 1, 1 ) = 1.0D+0
  93       B( 1, 1 ) = 1.0D+0
  94       ALPHA     = 1.0D+0
  95       BETA      = 1.0D+0
  96 *
  97       SRNAMT = 'DPFTRF'
  98       INFOT = 1
  99       CALL DPFTRF( '/', 'U', 0, A, INFO )
 100       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
 101       INFOT = 2
 102       CALL DPFTRF( 'N', '/', 0, A, INFO )
 103       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
 104       INFOT = 3
 105       CALL DPFTRF( 'N', 'U', -1, A, INFO )
 106       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
 107 *
 108       SRNAMT = 'DPFTRS'
 109       INFOT = 1
 110       CALL DPFTRS( '/', 'U', 0, 0, A, B, 1, INFO )
 111       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 112       INFOT = 2
 113       CALL DPFTRS( 'N', '/', 0, 0, A, B, 1, INFO )
 114       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 115       INFOT = 3
 116       CALL DPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO )
 117       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 118       INFOT = 4
 119       CALL DPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO )
 120       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 121       INFOT = 7
 122       CALL DPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO )
 123       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 124 *
 125       SRNAMT = 'DPFTRI'
 126       INFOT = 1
 127       CALL DPFTRI( '/', 'U', 0, A, INFO )
 128       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
 129       INFOT = 2
 130       CALL DPFTRI( 'N', '/', 0, A, INFO )
 131       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
 132       INFOT = 3
 133       CALL DPFTRI( 'N', 'U', -1, A, INFO )
 134       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
 135 *
 136       SRNAMT = 'DTFSM '
 137       INFOT = 1
 138       CALL DTFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
 139       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 140       INFOT = 2
 141       CALL DTFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
 142       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 143       INFOT = 3
 144       CALL DTFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
 145       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 146       INFOT = 4
 147       CALL DTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 )
 148       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 149       INFOT = 5
 150       CALL DTFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 )
 151       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 152       INFOT = 6
 153       CALL DTFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 )
 154       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 155       INFOT = 7
 156       CALL DTFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 )
 157       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 158       INFOT = 11
 159       CALL DTFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 )
 160       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
 161 *
 162       SRNAMT = 'DTFTRI'
 163       INFOT = 1
 164       CALL DTFTRI( '/', 'L', 'N', 0, A, INFO )
 165       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
 166       INFOT = 2
 167       CALL DTFTRI( 'N', '/', 'N', 0, A, INFO )
 168       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
 169       INFOT = 3
 170       CALL DTFTRI( 'N', 'L', '/', 0, A, INFO )
 171       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
 172       INFOT = 4
 173       CALL DTFTRI( 'N', 'L', 'N', -1, A, INFO )
 174       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
 175 *
 176       SRNAMT = 'DTFTTR'
 177       INFOT = 1
 178       CALL DTFTTR( '/', 'U', 0, A, B, 1, INFO )
 179       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
 180       INFOT = 2
 181       CALL DTFTTR( 'N', '/', 0, A, B, 1, INFO )
 182       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
 183       INFOT = 3
 184       CALL DTFTTR( 'N', 'U', -1, A, B, 1, INFO )
 185       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
 186       INFOT = 6
 187       CALL DTFTTR( 'N', 'U', 0, A, B, 0, INFO )
 188       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
 189 *
 190       SRNAMT = 'DTRTTF'
 191       INFOT = 1
 192       CALL DTRTTF( '/', 'U', 0, A, 1, B, INFO )
 193       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
 194       INFOT = 2
 195       CALL DTRTTF( 'N', '/', 0, A, 1, B, INFO )
 196       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
 197       INFOT = 3
 198       CALL DTRTTF( 'N', 'U', -1, A, 1, B, INFO )
 199       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
 200       INFOT = 5
 201       CALL DTRTTF( 'N', 'U', 0, A, 0, B, INFO )
 202       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
 203 *
 204       SRNAMT = 'DTFTTP'
 205       INFOT = 1
 206       CALL DTFTTP( '/', 'U', 0, A, B, INFO )
 207       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
 208       INFOT = 2
 209       CALL DTFTTP( 'N', '/', 0, A, B, INFO )
 210       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
 211       INFOT = 3
 212       CALL DTFTTP( 'N', 'U', -1, A, B, INFO )
 213       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
 214 *
 215       SRNAMT = 'DTPTTF'
 216       INFOT = 1
 217       CALL DTPTTF( '/', 'U', 0, A, B, INFO )
 218       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
 219       INFOT = 2
 220       CALL DTPTTF( 'N', '/', 0, A, B, INFO )
 221       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
 222       INFOT = 3
 223       CALL DTPTTF( 'N', 'U', -1, A, B, INFO )
 224       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
 225 *
 226       SRNAMT = 'DTRTTP'
 227       INFOT = 1
 228       CALL DTRTTP( '/', 0, A, 1,  B, INFO )
 229       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
 230       INFOT = 2
 231       CALL DTRTTP( 'U', -1, A, 1,  B, INFO )
 232       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
 233       INFOT = 4
 234       CALL DTRTTP( 'U', 0, A, 0,  B, INFO )
 235       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
 236 *
 237       SRNAMT = 'DTPTTR'
 238       INFOT = 1
 239       CALL DTPTTR( '/', 0, A, B, 1,  INFO )
 240       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
 241       INFOT = 2
 242       CALL DTPTTR( 'U', -1, A, B, 1,  INFO )
 243       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
 244       INFOT = 5
 245       CALL DTPTTR( 'U', 0, A, B, 0, INFO )
 246       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
 247 *
 248       SRNAMT = 'DSFRK '
 249       INFOT = 1
 250       CALL DSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B )
 251       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
 252       INFOT = 2
 253       CALL DSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B )
 254       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
 255       INFOT = 3
 256       CALL DSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B )
 257       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
 258       INFOT = 4
 259       CALL DSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B )
 260       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
 261       INFOT = 5
 262       CALL DSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B )
 263       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
 264       INFOT = 8
 265       CALL DSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B )
 266       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
 267 *
 268 *     Print a summary line.
 269 *
 270       IF( OK ) THEN
 271          WRITE( NOUT, FMT = 9999 )
 272       ELSE
 273          WRITE( NOUT, FMT = 9998 )
 274       END IF
 275 *
 276  9999 FORMAT( 1X, 'DOUBLE PRECISION RFP routines passed the tests of ',
 277      $        'the error exits' )
 278  9998 FORMAT( ' *** RFP routines failed the tests of the error ',
 279      $        'exits ***' )
 280       RETURN
 281 *
 282 *     End of DERRRFP
 283 *
 284       END