LAPACK: TESTING/LIN/cerrrfp.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CERRRFP( 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 *  CERRRFP tests the error exits for the COMPLEX driver routines
00015 *  for solving linear systems of equations.
00016 *
00017 *  CDRVRFP tests the COMPLEX LAPACK RFP routines:
00018 *      CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, CPFTRF, CPFTRS, CTPTTF,
00019 *      CTPTTR, CTRTTF, and CTRTTP
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       COMPLEX            ALPHA, BETA
00033 *     ..
00034 *     .. Local Arrays ..
00035       COMPLEX            A( 1, 1), B( 1, 1)
00036 *     ..
00037 *     .. External Subroutines ..
00038       EXTERNAL           CHKXER, CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR,
00039      +                   CPFTRI, CPFTRF, CPFTRS, CTPTTF, CTPTTR, CTRTTF,
00040      +                   CTRTTP
00041 *     ..
00042 *     .. Scalars in Common ..
00043       LOGICAL            LERR, OK
00044       CHARACTER*32       SRNAMT
00045       INTEGER            INFOT, NOUT
00046 *     ..
00047 *     .. Intrinsic Functions ..
00048       INTRINSIC          CMPLX
00049 *     ..
00050 *     .. Common blocks ..
00051       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00052       COMMON             / SRNAMC / SRNAMT
00053 *     ..
00054 *     .. Executable Statements ..
00055 *
00056       NOUT = NUNIT
00057       OK = .TRUE.
00058       A( 1, 1 ) = CMPLX( 1.D0 , 1.D0  )
00059       B( 1, 1 ) = CMPLX( 1.D0 , 1.D0  )
00060       ALPHA     = CMPLX( 1.D0 , 1.D0  )
00061       BETA      = CMPLX( 1.D0 , 1.D0  )
00062 *
00063       SRNAMT = 'CPFTRF'
00064       INFOT = 1
00065       CALL CPFTRF( '/', 'U', 0, A, INFO )
00066       CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK )
00067       INFOT = 2
00068       CALL CPFTRF( 'N', '/', 0, A, INFO )
00069       CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK )
00070       INFOT = 3
00071       CALL CPFTRF( 'N', 'U', -1, A, INFO )
00072       CALL CHKXER( 'CPFTRF', INFOT, NOUT, LERR, OK )
00073 *
00074       SRNAMT = 'CPFTRS'
00075       INFOT = 1
00076       CALL CPFTRS( '/', 'U', 0, 0, A, B, 1, INFO )
00077       CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK )
00078       INFOT = 2
00079       CALL CPFTRS( 'N', '/', 0, 0, A, B, 1, INFO )
00080       CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK )
00081       INFOT = 3
00082       CALL CPFTRS( 'N', 'U', -1, 0, A, B, 1, INFO )
00083       CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK )
00084       INFOT = 4
00085       CALL CPFTRS( 'N', 'U', 0, -1, A, B, 1, INFO )
00086       CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK )
00087       INFOT = 7
00088       CALL CPFTRS( 'N', 'U', 0, 0, A, B, 0, INFO )
00089       CALL CHKXER( 'CPFTRS', INFOT, NOUT, LERR, OK )
00090 *
00091       SRNAMT = 'CPFTRI'
00092       INFOT = 1
00093       CALL CPFTRI( '/', 'U', 0, A, INFO )
00094       CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK )
00095       INFOT = 2
00096       CALL CPFTRI( 'N', '/', 0, A, INFO )
00097       CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK )
00098       INFOT = 3
00099       CALL CPFTRI( 'N', 'U', -1, A, INFO )
00100       CALL CHKXER( 'CPFTRI', INFOT, NOUT, LERR, OK )
00101 *
00102       SRNAMT = 'CTFSM '
00103       INFOT = 1
00104       CALL CTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 )
00105       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00106       INFOT = 2
00107       CALL CTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 )
00108       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00109       INFOT = 3
00110       CALL CTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, ALPHA, A, B, 1 )
00111       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00112       INFOT = 4
00113       CALL CTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 )
00114       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00115       INFOT = 5
00116       CALL CTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, ALPHA, A, B, 1 )
00117       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00118       INFOT = 6
00119       CALL CTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, ALPHA, A, B, 1 )
00120       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00121       INFOT = 7
00122       CALL CTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, ALPHA, A, B, 1 )
00123       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00124       INFOT = 11
00125       CALL CTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 0 )
00126       CALL CHKXER( 'CTFSM ', INFOT, NOUT, LERR, OK )
00127 *
00128       SRNAMT = 'CTFTRI'
00129       INFOT = 1
00130       CALL CTFTRI( '/', 'L', 'N', 0, A, INFO )
00131       CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK )
00132       INFOT = 2
00133       CALL CTFTRI( 'N', '/', 'N', 0, A, INFO )
00134       CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK )
00135       INFOT = 3
00136       CALL CTFTRI( 'N', 'L', '/', 0, A, INFO )
00137       CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK )
00138       INFOT = 4
00139       CALL CTFTRI( 'N', 'L', 'N', -1, A, INFO )
00140       CALL CHKXER( 'CTFTRI', INFOT, NOUT, LERR, OK )
00141 *
00142       SRNAMT = 'CTFTTR'
00143       INFOT = 1
00144       CALL CTFTTR( '/', 'U', 0, A, B, 1, INFO )
00145       CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK )
00146       INFOT = 2
00147       CALL CTFTTR( 'N', '/', 0, A, B, 1, INFO )
00148       CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK )
00149       INFOT = 3
00150       CALL CTFTTR( 'N', 'U', -1, A, B, 1, INFO )
00151       CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK )
00152       INFOT = 6
00153       CALL CTFTTR( 'N', 'U', 0, A, B, 0, INFO )
00154       CALL CHKXER( 'CTFTTR', INFOT, NOUT, LERR, OK )
00155 *
00156       SRNAMT = 'CTRTTF'
00157       INFOT = 1
00158       CALL CTRTTF( '/', 'U', 0, A, 1, B, INFO )
00159       CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK )
00160       INFOT = 2
00161       CALL CTRTTF( 'N', '/', 0, A, 1, B, INFO )
00162       CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK )
00163       INFOT = 3
00164       CALL CTRTTF( 'N', 'U', -1, A, 1, B, INFO )
00165       CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK )
00166       INFOT = 5
00167       CALL CTRTTF( 'N', 'U', 0, A, 0, B, INFO )
00168       CALL CHKXER( 'CTRTTF', INFOT, NOUT, LERR, OK )
00169 *
00170       SRNAMT = 'CTFTTP'
00171       INFOT = 1
00172       CALL CTFTTP( '/', 'U', 0, A, B, INFO )
00173       CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK )
00174       INFOT = 2
00175       CALL CTFTTP( 'N', '/', 0, A, B, INFO )
00176       CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK )
00177       INFOT = 3
00178       CALL CTFTTP( 'N', 'U', -1, A, B, INFO )
00179       CALL CHKXER( 'CTFTTP', INFOT, NOUT, LERR, OK )
00180 *
00181       SRNAMT = 'CTPTTF'
00182       INFOT = 1
00183       CALL CTPTTF( '/', 'U', 0, A, B, INFO )
00184       CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK )
00185       INFOT = 2
00186       CALL CTPTTF( 'N', '/', 0, A, B, INFO )
00187       CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK )
00188       INFOT = 3
00189       CALL CTPTTF( 'N', 'U', -1, A, B, INFO )
00190       CALL CHKXER( 'CTPTTF', INFOT, NOUT, LERR, OK )
00191 *
00192       SRNAMT = 'CTRTTP'
00193       INFOT = 1
00194       CALL CTRTTP( '/', 0, A, 1,  B, INFO )
00195       CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK )
00196       INFOT = 2
00197       CALL CTRTTP( 'U', -1, A, 1,  B, INFO )
00198       CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK )
00199       INFOT = 4
00200       CALL CTRTTP( 'U', 0, A, 0,  B, INFO )
00201       CALL CHKXER( 'CTRTTP', INFOT, NOUT, LERR, OK )
00202 *
00203       SRNAMT = 'CTPTTR'
00204       INFOT = 1
00205       CALL CTPTTR( '/', 0, A, B, 1,  INFO )
00206       CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK )
00207       INFOT = 2
00208       CALL CTPTTR( 'U', -1, A, B, 1,  INFO )
00209       CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK )
00210       INFOT = 5
00211       CALL CTPTTR( 'U', 0, A, B, 0, INFO )
00212       CALL CHKXER( 'CTPTTR', INFOT, NOUT, LERR, OK )
00213 *
00214       SRNAMT = 'CHFRK '
00215       INFOT = 1
00216       CALL CHFRK( '/', 'U', 'N', 0, 0, ALPHA, A, 1, BETA, B )
00217       CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK )
00218       INFOT = 2
00219       CALL CHFRK( 'N', '/', 'N', 0, 0, ALPHA, A, 1, BETA, B )
00220       CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK )
00221       INFOT = 3
00222       CALL CHFRK( 'N', 'U', '/', 0, 0, ALPHA, A, 1, BETA, B )
00223       CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK )
00224       INFOT = 4
00225       CALL CHFRK( 'N', 'U', 'N', -1, 0, ALPHA, A, 1, BETA, B )
00226       CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK )
00227       INFOT = 5
00228       CALL CHFRK( 'N', 'U', 'N', 0, -1, ALPHA, A, 1, BETA, B )
00229       CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK )
00230       INFOT = 8
00231       CALL CHFRK( 'N', 'U', 'N', 0, 0, ALPHA, A, 0, BETA, B )
00232       CALL CHKXER( 'CHFRK ', INFOT, NOUT, LERR, OK )
00233 *
00234 *     Print a summary line.
00235 *
00236       IF( OK ) THEN
00237          WRITE( NOUT, FMT = 9999 )
00238       ELSE
00239          WRITE( NOUT, FMT = 9998 )
00240       END IF
00241 *
00242  9999 FORMAT( 1X, 'COMPLEX RFP routines passed the tests of the ',
00243      $        'error exits' )
00244  9998 FORMAT( ' *** RFP routines failed the tests of the error ',
00245      $        'exits ***' )
00246       RETURN
00247 *
00248 *     End of CERRRFP
00249 *
00250       END