d6/da6/serrps_8f_source.html

00001       SUBROUTINE SERRPS( 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 *  SERRPS tests the error exits for the REAL routines
00016 *  for SPSTRF..
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       REAL               A( NMAX, NMAX ), WORK( 2*NMAX )
00038       INTEGER            PIV( NMAX )
00039 *     ..
00040 *     .. External Subroutines ..
00041       EXTERNAL           ALAESM, CHKXER, SPSTF2, SPSTRF
00042 *     ..
00043 *     .. Scalars in Common ..
00044       INTEGER            INFOT, NOUT
00045       LOGICAL            LERR, OK
00046       CHARACTER*32       SRNAMT
00047 *     ..
00048 *     .. Common blocks ..
00049       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00050       COMMON             / SRNAMC / SRNAMT
00051 *     ..
00052 *     .. Intrinsic Functions ..
00053       INTRINSIC          REAL
00054 *     ..
00055 *     .. Executable Statements ..
00056 *
00057       NOUT = NUNIT
00058       WRITE( NOUT, FMT = * )
00059 *
00060 *     Set the variables to innocuous values.
00061 *
00062       DO 110 J = 1, NMAX
00063          DO 100 I = 1, NMAX
00064             A( I, J ) = 1.0 / REAL( I+J )
00065 *
00066   100    CONTINUE
00067          PIV( J ) = J
00068          WORK( J ) = 0.
00069          WORK( NMAX+J ) = 0.
00070 *
00071   110 CONTINUE
00072       OK = .TRUE.
00073 *
00074 *
00075 *        Test error exits of the routines that use the Cholesky
00076 *        decomposition of a symmetric positive semidefinite matrix.
00077 *
00078 *        SPSTRF
00079 *
00080       SRNAMT = 'SPSTRF'
00081       INFOT = 1
00082       CALL SPSTRF( '/', 0, A, 1, PIV, 1, -1.0, WORK, INFO )
00083       CALL CHKXER( 'SPSTRF', INFOT, NOUT, LERR, OK )
00084       INFOT = 2
00085       CALL SPSTRF( 'U', -1, A, 1, PIV, 1, -1.0, WORK, INFO )
00086       CALL CHKXER( 'SPSTRF', INFOT, NOUT, LERR, OK )
00087       INFOT = 4
00088       CALL SPSTRF( 'U', 2, A, 1, PIV, 1, -1.0, WORK, INFO )
00089       CALL CHKXER( 'SPSTRF', INFOT, NOUT, LERR, OK )
00090 *
00091 *        SPSTF2
00092 *
00093       SRNAMT = 'SPSTF2'
00094       INFOT = 1
00095       CALL SPSTF2( '/', 0, A, 1, PIV, 1, -1.0, WORK, INFO )
00096       CALL CHKXER( 'SPSTF2', INFOT, NOUT, LERR, OK )
00097       INFOT = 2
00098       CALL SPSTF2( 'U', -1, A, 1, PIV, 1, -1.0, WORK, INFO )
00099       CALL CHKXER( 'SPSTF2', INFOT, NOUT, LERR, OK )
00100       INFOT = 4
00101       CALL SPSTF2( 'U', 2, A, 1, PIV, 1, -1.0, WORK, INFO )
00102       CALL CHKXER( 'SPSTF2', INFOT, NOUT, LERR, OK )
00103 *
00104 *
00105 *     Print a summary line.
00106 *
00107       CALL ALAESM( PATH, OK, NOUT )
00108 *
00109       RETURN
00110 *
00111 *     End of SERRPS
00112 *
00113       END