LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
derrrfp.f
Go to the documentation of this file.
00001 *> \brief \b DERRRFP
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE DERRRFP( NUNIT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            NUNIT
00015 *       ..
00016 *  
00017 *
00018 *> \par Purpose:
00019 *  =============
00020 *>
00021 *> \verbatim
00022 *>
00023 *> DERRRFP tests the error exits for the DOUBLE PRECISION driver routines
00024 *> for solving linear systems of equations.
00025 *>
00026 *> DDRVRFP tests the DOUBLE PRECISION LAPACK RFP routines:
00027 *>     DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, DPFTRF, DPFTRS, DTPTTF,
00028 *>     DTPTTR, DTRTTF, and DTRTTP
00029 *> \endverbatim
00030 *
00031 *  Arguments:
00032 *  ==========
00033 *
00034 *> \param[in] NUNIT
00035 *> \verbatim
00036 *>          NUNIT is INTEGER
00037 *>          The unit number for output.
00038 *> \endverbatim
00039 *
00040 *  Authors:
00041 *  ========
00042 *
00043 *> \author Univ. of Tennessee 
00044 *> \author Univ. of California Berkeley 
00045 *> \author Univ. of Colorado Denver 
00046 *> \author NAG Ltd. 
00047 *
00048 *> \date November 2011
00049 *
00050 *> \ingroup double_lin
00051 *
00052 *  =====================================================================
00053       SUBROUTINE DERRRFP( NUNIT )
00054 *
00055 *  -- LAPACK test routine (version 3.4.0) --
00056 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00057 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00058 *     November 2011
00059 *
00060 *     .. Scalar Arguments ..
00061       INTEGER            NUNIT
00062 *     ..
00063 *
00064 *  =====================================================================
00065 *
00066 *     ..
00067 *     .. Local Scalars ..
00068       INTEGER            INFO
00069       DOUBLE PRECISION   ALPHA, BETA
00070 *     ..
00071 *     .. Local Arrays ..
00072       DOUBLE PRECISION   A( 1, 1), B( 1, 1)
00073 *     ..
00074 *     .. External Subroutines ..
00075       EXTERNAL           CHKXER, DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR,
00076      +                   DPFTRI, DPFTRF, DPFTRS, DTPTTF, DTPTTR, DTRTTF,
00077      +                   DTRTTP
00078 *     ..
00079 *     .. Scalars in Common ..
00080       LOGICAL            LERR, OK
00081       CHARACTER*32       SRNAMT
00082       INTEGER            INFOT, NOUT
00083 *     ..
00084 *     .. Common blocks ..
00085       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00086       COMMON             / SRNAMC / SRNAMT
00087 *     ..
00088 *     .. Executable Statements ..
00089 *
00090       NOUT = NUNIT
00091       OK = .TRUE.
00092       A( 1, 1 ) = 1.0D+0
00093       B( 1, 1 ) = 1.0D+0
00094       ALPHA     = 1.0D+0
00095       BETA      = 1.0D+0
00096 *
00097       SRNAMT = 'DPFTRF'
00098       INFOT = 1
00099       CALL DPFTRF( '/', 'U', 0, A, INFO )
00100       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
00101       INFOT = 2
00102       CALL DPFTRF( 'N', '/', 0, A, INFO )
00103       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
00104       INFOT = 3
00105       CALL DPFTRF( 'N', 'U', -1, A, INFO )
00106       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
00107 *
00108       SRNAMT = 'DPFTRS'
00109       INFOT = 1
00110       CALL DPFTRS( '/', 'U', 0, 0, A, B, 1, INFO )
00111       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
00112       INFOT = 2
00113       CALL DPFTRS( 'N', '/', 0, 0, A, B, 1, INFO )
00114       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
00115       INFOT = 3
00116       CALL DPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO )
00117       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
00118       INFOT = 4
00119       CALL DPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO )
00120       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
00121       INFOT = 7
00122       CALL DPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO )
00123       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
00124 *
00125       SRNAMT = 'DPFTRI'
00126       INFOT = 1
00127       CALL DPFTRI( '/', 'U', 0, A, INFO )
00128       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
00129       INFOT = 2
00130       CALL DPFTRI( 'N', '/', 0, A, INFO )
00131       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
00132       INFOT = 3
00133       CALL DPFTRI( 'N', 'U', -1, A, INFO )
00134       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
00135 *
00136       SRNAMT = 'DTFSM '
00137       INFOT = 1
00138       CALL DTFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
00139       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00140       INFOT = 2
00141       CALL DTFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
00142       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00143       INFOT = 3
00144       CALL DTFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
00145       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00146       INFOT = 4
00147       CALL DTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 )
00148       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00149       INFOT = 5
00150       CALL DTFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 )
00151       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00152       INFOT = 6
00153       CALL DTFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 )
00154       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00155       INFOT = 7
00156       CALL DTFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 )
00157       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00158       INFOT = 11
00159       CALL DTFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 )
00160       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
00161 *
00162       SRNAMT = 'DTFTRI'
00163       INFOT = 1
00164       CALL DTFTRI( '/', 'L', 'N', 0, A, INFO )
00165       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
00166       INFOT = 2
00167       CALL DTFTRI( 'N', '/', 'N', 0, A, INFO )
00168       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
00169       INFOT = 3
00170       CALL DTFTRI( 'N', 'L', '/', 0, A, INFO )
00171       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
00172       INFOT = 4
00173       CALL DTFTRI( 'N', 'L', 'N', -1, A, INFO )
00174       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
00175 *
00176       SRNAMT = 'DTFTTR'
00177       INFOT = 1
00178       CALL DTFTTR( '/', 'U', 0, A, B, 1, INFO )
00179       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
00180       INFOT = 2
00181       CALL DTFTTR( 'N', '/', 0, A, B, 1, INFO )
00182       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
00183       INFOT = 3
00184       CALL DTFTTR( 'N', 'U', -1, A, B, 1, INFO )
00185       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
00186       INFOT = 6
00187       CALL DTFTTR( 'N', 'U', 0, A, B, 0, INFO )
00188       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
00189 *
00190       SRNAMT = 'DTRTTF'
00191       INFOT = 1
00192       CALL DTRTTF( '/', 'U', 0, A, 1, B, INFO )
00193       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
00194       INFOT = 2
00195       CALL DTRTTF( 'N', '/', 0, A, 1, B, INFO )
00196       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
00197       INFOT = 3
00198       CALL DTRTTF( 'N', 'U', -1, A, 1, B, INFO )
00199       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
00200       INFOT = 5
00201       CALL DTRTTF( 'N', 'U', 0, A, 0, B, INFO )
00202       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
00203 *
00204       SRNAMT = 'DTFTTP'
00205       INFOT = 1
00206       CALL DTFTTP( '/', 'U', 0, A, B, INFO )
00207       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
00208       INFOT = 2
00209       CALL DTFTTP( 'N', '/', 0, A, B, INFO )
00210       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
00211       INFOT = 3
00212       CALL DTFTTP( 'N', 'U', -1, A, B, INFO )
00213       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
00214 *
00215       SRNAMT = 'DTPTTF'
00216       INFOT = 1
00217       CALL DTPTTF( '/', 'U', 0, A, B, INFO )
00218       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
00219       INFOT = 2
00220       CALL DTPTTF( 'N', '/', 0, A, B, INFO )
00221       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
00222       INFOT = 3
00223       CALL DTPTTF( 'N', 'U', -1, A, B, INFO )
00224       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
00225 *
00226       SRNAMT = 'DTRTTP'
00227       INFOT = 1
00228       CALL DTRTTP( '/', 0, A, 1,  B, INFO )
00229       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
00230       INFOT = 2
00231       CALL DTRTTP( 'U', -1, A, 1,  B, INFO )
00232       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
00233       INFOT = 4
00234       CALL DTRTTP( 'U', 0, A, 0,  B, INFO )
00235       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
00236 *
00237       SRNAMT = 'DTPTTR'
00238       INFOT = 1
00239       CALL DTPTTR( '/', 0, A, B, 1,  INFO )
00240       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
00241       INFOT = 2
00242       CALL DTPTTR( 'U', -1, A, B, 1,  INFO )
00243       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
00244       INFOT = 5
00245       CALL DTPTTR( 'U', 0, A, B, 0, INFO )
00246       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
00247 *
00248       SRNAMT = 'DSFRK '
00249       INFOT = 1
00250       CALL DSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B )
00251       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
00252       INFOT = 2
00253       CALL DSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B )
00254       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
00255       INFOT = 3
00256       CALL DSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B )
00257       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
00258       INFOT = 4
00259       CALL DSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B )
00260       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
00261       INFOT = 5
00262       CALL DSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B )
00263       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
00264       INFOT = 8
00265       CALL DSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B )
00266       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
00267 *
00268 *     Print a summary line.
00269 *
00270       IF( OK ) THEN
00271          WRITE( NOUT, FMT = 9999 )
00272       ELSE
00273          WRITE( NOUT, FMT = 9998 )
00274       END IF
00275 *
00276  9999 FORMAT( 1X, 'DOUBLE PRECISION RFP routines passed the tests of ',
00277      $        'the error exits' )
00278  9998 FORMAT( ' *** RFP routines failed the tests of the error ',
00279      $        'exits ***' )
00280       RETURN
00281 *
00282 *     End of DERRRFP
00283 *
00284       END
 All Files Functions