d8/ded/cerrps_8f_source.html

00001       SUBROUTINE CERRPS( PATH, NUNIT )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
00004 *     Craig Lucas, University of Manchester / NAG Ltd.
00005 *     October, 2008
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            NUNIT
00009       CHARACTER*3        PATH
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  CERRPS tests the error exits for the COMPLEX routines
00016 *  for CPSTRF..
00017 *
00018 *  Arguments
00019 *  =========
00020 *
00021 *  PATH    (input) CHARACTER*3
00022 *          The LAPACK path name for the routines to be tested.
00023 *
00024 *  NUNIT   (input) INTEGER
00025 *          The unit number for output.
00026 *
00027 *  =====================================================================
00028 *
00029 *     .. Parameters ..
00030       INTEGER            NMAX
00031       PARAMETER          ( NMAX = 4 )
00032 *     ..
00033 *     .. Local Scalars ..
00034       INTEGER            I, INFO, J
00035 *     ..
00036 *     .. Local Arrays ..
00037       COMPLEX            A( NMAX, NMAX )
00038       REAL               RWORK( 2*NMAX )
00039       INTEGER            PIV( NMAX )
00040 *     ..
00041 *     .. External Subroutines ..
00042       EXTERNAL           ALAESM, CHKXER, CPSTF2, CPSTRF
00043 *     ..
00044 *     .. Scalars in Common ..
00045       INTEGER            INFOT, NOUT
00046       LOGICAL            LERR, OK
00047       CHARACTER*32       SRNAMT
00048 *     ..
00049 *     .. Common blocks ..
00050       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00051       COMMON             / SRNAMC / SRNAMT
00052 *     ..
00053 *     .. Intrinsic Functions ..
00054       INTRINSIC          REAL
00055 *     ..
00056 *     .. Executable Statements ..
00057 *
00058       NOUT = NUNIT
00059       WRITE( NOUT, FMT = * )
00060 *
00061 *     Set the variables to innocuous values.
00062 *
00063       DO 110 J = 1, NMAX
00064          DO 100 I = 1, NMAX
00065             A( I, J ) = 1.0 / REAL( I+J )
00066 *
00067   100    CONTINUE
00068          PIV( J ) = J
00069          RWORK( J ) = 0.
00070          RWORK( NMAX+J ) = 0.
00071 *
00072   110 CONTINUE
00073       OK = .TRUE.
00074 *
00075 *
00076 *        Test error exits of the routines that use the Cholesky
00077 *        decomposition of an Hermitian positive semidefinite matrix.
00078 *
00079 *        CPSTRF
00080 *
00081       SRNAMT = 'CPSTRF'
00082       INFOT = 1
00083       CALL CPSTRF( '/', 0, A, 1, PIV, 1, -1.0, RWORK, INFO )
00084       CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
00085       INFOT = 2
00086       CALL CPSTRF( 'U', -1, A, 1, PIV, 1, -1.0, RWORK, INFO )
00087       CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
00088       INFOT = 4
00089       CALL CPSTRF( 'U', 2, A, 1, PIV, 1, -1.0, RWORK, INFO )
00090       CALL CHKXER( 'CPSTRF', INFOT, NOUT, LERR, OK )
00091 *
00092 *        CPSTF2
00093 *
00094       SRNAMT = 'CPSTF2'
00095       INFOT = 1
00096       CALL CPSTF2( '/', 0, A, 1, PIV, 1, -1.0, RWORK, INFO )
00097       CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
00098       INFOT = 2
00099       CALL CPSTF2( 'U', -1, A, 1, PIV, 1, -1.0, RWORK, INFO )
00100       CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
00101       INFOT = 4
00102       CALL CPSTF2( 'U', 2, A, 1, PIV, 1, -1.0, RWORK, INFO )
00103       CALL CHKXER( 'CPSTF2', INFOT, NOUT, LERR, OK )
00104 *
00105 *
00106 *     Print a summary line.
00107 *
00108       CALL ALAESM( PATH, OK, NOUT )
00109 *
00110       RETURN
00111 *
00112 *     End of CERRPS
00113 *
00114       END