LAPACK: TESTING/LIN/zerrrfp.f Source File

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