d6/d9a/derrac_8f_source.html

00001       SUBROUTINE DERRAC( NUNIT )
00002       IMPLICIT NONE
00003 *
00004 *  -- LAPACK test routine (version 3.1.2) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     May 2007
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            NUNIT
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  DERRAC tests the error exits for DSPOSV.
00016 *
00017 *  Arguments
00018 *  =========
00019 *
00020 *  NUNIT   (input) INTEGER
00021 *          The unit number for output.
00022 *
00023 *  =====================================================================
00024 *
00025 *     .. Parameters ..
00026       INTEGER            NMAX
00027       PARAMETER          ( NMAX = 4 )
00028 *     ..
00029 *     .. Local Scalars ..
00030       INTEGER            I, INFO, ITER, J
00031 *     ..
00032 *     .. Local Arrays ..
00033       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
00034      $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
00035      $                   W( 2*NMAX ), X( NMAX )
00036       DOUBLE PRECISION   WORK(NMAX*NMAX)
00037       REAL               SWORK(NMAX*NMAX)
00038 *     ..
00039 *     .. External Subroutines ..
00040       EXTERNAL           CHKXER, DSPOSV
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 *     .. Intrinsic Functions ..
00052       INTRINSIC          DBLE
00053 *     ..
00054 *     .. Executable Statements ..
00055 *
00056       NOUT = NUNIT
00057       WRITE( NOUT, FMT = * )
00058 *
00059 *     Set the variables to innocuous values.
00060 *
00061       DO 20 J = 1, NMAX
00062          DO 10 I = 1, NMAX
00063             A( I, J ) = 1.D0 / DBLE( I+J )
00064             AF( I, J ) = 1.D0 / DBLE( I+J )
00065    10    CONTINUE
00066          B( J ) = 0.D0
00067          R1( J ) = 0.D0
00068          R2( J ) = 0.D0
00069          W( J ) = 0.D0
00070          X( J ) = 0.D0
00071          C( J ) = 0.D0
00072          R( J ) = 0.D0
00073    20 CONTINUE
00074       OK = .TRUE.
00075 *
00076       SRNAMT = 'DSPOSV'
00077       INFOT = 1
00078       CALL DSPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
00079       CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
00080       INFOT = 2
00081       CALL DSPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
00082       CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
00083       INFOT = 3
00084       CALL DSPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,ITER,INFO)
00085       CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
00086       INFOT = 5
00087       CALL DSPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,ITER,INFO)
00088       CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
00089       INFOT = 7
00090       CALL DSPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,ITER,INFO)
00091       CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
00092       INFOT = 9
00093       CALL DSPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,ITER,INFO)
00094       CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK )
00095 *
00096 *     Print a summary line.
00097 *
00098       IF( OK ) THEN
00099          WRITE( NOUT, FMT = 9999 )'DSPOSV'
00100       ELSE
00101          WRITE( NOUT, FMT = 9998 )'DSPOSV'
00102       END IF
00103 *
00104  9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
00105  9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
00106      $      'exits ***' )
00107 *
00108       RETURN
00109 *
00110 *     End of DERRAC
00111 *
00112       END