LAPACK: TESTING/LIN/serrrfp.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SERRRFP( 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 *  SERRRFP tests the error exits for the REAL driver routines
00015 *  for solving linear systems of equations.
00016 *
00017 *  SDRVRFP tests the REAL LAPACK RFP routines:
00018 *      STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF,
00019 *      STPTTR, STRTTF, and STRTTP
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       REAL               ALPHA, BETA
00033 *     ..
00034 *     .. Local Arrays ..
00035       REAL               A( 1, 1), B( 1, 1)
00036 *     ..
00037 *     .. External Subroutines ..
00038       EXTERNAL           CHKXER, STFSM, STFTRI, SSFRK, STFTTP, STFTTR,
00039      +                   SPFTRI, SPFTRF, SPFTRS, STPTTF, STPTTR, STRTTF,
00040      +                   STRTTP
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.0E+0
00056       B( 1, 1 ) = 1.0E+0
00057       ALPHA     = 1.0E+0
00058       BETA      = 1.0E+0
00059 *
00060       SRNAMT = 'SPFTRF'
00061       INFOT = 1
00062       CALL SPFTRF( '/', 'U', 0, A, INFO )
00063       CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK )
00064       INFOT = 2
00065       CALL SPFTRF( 'N', '/', 0, A, INFO )
00066       CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK )
00067       INFOT = 3
00068       CALL SPFTRF( 'N', 'U', -1, A, INFO )
00069       CALL CHKXER( 'SPFTRF', INFOT, NOUT, LERR, OK )
00070 *
00071       SRNAMT = 'SPFTRS'
00072       INFOT = 1
00073       CALL SPFTRS( '/', 'U', 0, 0, A, B, 1, INFO )
00074       CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK )
00075       INFOT = 2
00076       CALL SPFTRS( 'N', '/', 0, 0, A, B, 1, INFO )
00077       CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK )
00078       INFOT = 3
00079       CALL SPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO )
00080       CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK )
00081       INFOT = 4
00082       CALL SPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO )
00083       CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK )
00084       INFOT = 7
00085       CALL SPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO )
00086       CALL CHKXER( 'SPFTRS', INFOT, NOUT, LERR, OK )
00087 *
00088       SRNAMT = 'SPFTRI'
00089       INFOT = 1
00090       CALL SPFTRI( '/', 'U', 0, A, INFO )
00091       CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK )
00092       INFOT = 2
00093       CALL SPFTRI( 'N', '/', 0, A, INFO )
00094       CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK )
00095       INFOT = 3
00096       CALL SPFTRI( 'N', 'U', -1, A, INFO )
00097       CALL CHKXER( 'SPFTRI', INFOT, NOUT, LERR, OK )
00098 *
00099       SRNAMT = 'STFSM '
00100       INFOT = 1
00101       CALL STFSM( '/', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
00102       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00103       INFOT = 2
00104       CALL STFSM( 'N', '/', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
00105       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00106       INFOT = 3
00107       CALL STFSM( 'N', 'L', '/', 'T', 'U', 0, 0, ALPHA, A, B, 1 )
00108       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00109       INFOT = 4
00110       CALL STFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 )
00111       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00112       INFOT = 5
00113       CALL STFSM( 'N', 'L', 'U', 'T', '/', 0, 0, ALPHA, A, B, 1 )
00114       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00115       INFOT = 6
00116       CALL STFSM( 'N', 'L', 'U', 'T', 'U', -1, 0, ALPHA, A, B, 1 )
00117       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00118       INFOT = 7
00119       CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, -1, ALPHA, A, B, 1 )
00120       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00121       INFOT = 11
00122       CALL STFSM( 'N', 'L', 'U', 'T', 'U', 0, 0, ALPHA, A, B, 0 )
00123       CALL CHKXER( 'STFSM ', INFOT, NOUT, LERR, OK )
00124 *
00125       SRNAMT = 'STFTRI'
00126       INFOT = 1
00127       CALL STFTRI( '/', 'L', 'N', 0, A, INFO )
00128       CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK )
00129       INFOT = 2
00130       CALL STFTRI( 'N', '/', 'N', 0, A, INFO )
00131       CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK )
00132       INFOT = 3
00133       CALL STFTRI( 'N', 'L', '/', 0, A, INFO )
00134       CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK )
00135       INFOT = 4
00136       CALL STFTRI( 'N', 'L', 'N', -1, A, INFO )
00137       CALL CHKXER( 'STFTRI', INFOT, NOUT, LERR, OK )
00138 *
00139       SRNAMT = 'STFTTR'
00140       INFOT = 1
00141       CALL STFTTR( '/', 'U', 0, A, B, 1, INFO )
00142       CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK )
00143       INFOT = 2
00144       CALL STFTTR( 'N', '/', 0, A, B, 1, INFO )
00145       CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK )
00146       INFOT = 3
00147       CALL STFTTR( 'N', 'U', -1, A, B, 1, INFO )
00148       CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK )
00149       INFOT = 6
00150       CALL STFTTR( 'N', 'U', 0, A, B, 0, INFO )
00151       CALL CHKXER( 'STFTTR', INFOT, NOUT, LERR, OK )
00152 *
00153       SRNAMT = 'STRTTF'
00154       INFOT = 1
00155       CALL STRTTF( '/', 'U', 0, A, 1, B, INFO )
00156       CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK )
00157       INFOT = 2
00158       CALL STRTTF( 'N', '/', 0, A, 1, B, INFO )
00159       CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK )
00160       INFOT = 3
00161       CALL STRTTF( 'N', 'U', -1, A, 1, B, INFO )
00162       CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK )
00163       INFOT = 5
00164       CALL STRTTF( 'N', 'U', 0, A, 0, B, INFO )
00165       CALL CHKXER( 'STRTTF', INFOT, NOUT, LERR, OK )
00166 *
00167       SRNAMT = 'STFTTP'
00168       INFOT = 1
00169       CALL STFTTP( '/', 'U', 0, A, B, INFO )
00170       CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK )
00171       INFOT = 2
00172       CALL STFTTP( 'N', '/', 0, A, B, INFO )
00173       CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK )
00174       INFOT = 3
00175       CALL STFTTP( 'N', 'U', -1, A, B, INFO )
00176       CALL CHKXER( 'STFTTP', INFOT, NOUT, LERR, OK )
00177 *
00178       SRNAMT = 'STPTTF'
00179       INFOT = 1
00180       CALL STPTTF( '/', 'U', 0, A, B, INFO )
00181       CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK )
00182       INFOT = 2
00183       CALL STPTTF( 'N', '/', 0, A, B, INFO )
00184       CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK )
00185       INFOT = 3
00186       CALL STPTTF( 'N', 'U', -1, A, B, INFO )
00187       CALL CHKXER( 'STPTTF', INFOT, NOUT, LERR, OK )
00188 *
00189       SRNAMT = 'STRTTP'
00190       INFOT = 1
00191       CALL STRTTP( '/', 0, A, 1,  B, INFO )
00192       CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK )
00193       INFOT = 2
00194       CALL STRTTP( 'U', -1, A, 1,  B, INFO )
00195       CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK )
00196       INFOT = 4
00197       CALL STRTTP( 'U', 0, A, 0,  B, INFO )
00198       CALL CHKXER( 'STRTTP', INFOT, NOUT, LERR, OK )
00199 *
00200       SRNAMT = 'STPTTR'
00201       INFOT = 1
00202       CALL STPTTR( '/', 0, A, B, 1,  INFO )
00203       CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK )
00204       INFOT = 2
00205       CALL STPTTR( 'U', -1, A, B, 1,  INFO )
00206       CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK )
00207       INFOT = 5
00208       CALL STPTTR( 'U', 0, A, B, 0, INFO )
00209       CALL CHKXER( 'STPTTR', INFOT, NOUT, LERR, OK )
00210 *
00211       SRNAMT = 'SSFRK '
00212       INFOT = 1
00213       CALL SSFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B )
00214       CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK )
00215       INFOT = 2
00216       CALL SSFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B )
00217       CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK )
00218       INFOT = 3
00219       CALL SSFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B )
00220       CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK )
00221       INFOT = 4
00222       CALL SSFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B )
00223       CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK )
00224       INFOT = 5
00225       CALL SSFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B )
00226       CALL CHKXER( 'SSFRK ', INFOT, NOUT, LERR, OK )
00227       INFOT = 8
00228       CALL SSFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B )
00229       CALL CHKXER( 'SSFRK ', 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, 'REAL 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 SERRRFP
00246 *
00247       END