LAPACK: TESTING/LIN/derrrfp.f Source File

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