![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRAC 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE DERRAC( NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NUNIT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> DERRAC tests the error exits for DSPOSV. 00024 *> \endverbatim 00025 * 00026 * Arguments: 00027 * ========== 00028 * 00029 *> \param[in] NUNIT 00030 *> \verbatim 00031 *> NUNIT is INTEGER 00032 *> The unit number for output. 00033 *> \endverbatim 00034 * 00035 * Authors: 00036 * ======== 00037 * 00038 *> \author Univ. of Tennessee 00039 *> \author Univ. of California Berkeley 00040 *> \author Univ. of Colorado Denver 00041 *> \author NAG Ltd. 00042 * 00043 *> \date November 2011 00044 * 00045 *> \ingroup double_lin 00046 * 00047 * ===================================================================== 00048 SUBROUTINE DERRAC( NUNIT ) 00049 * 00050 * -- LAPACK test routine (version 3.4.0) -- 00051 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00052 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00053 * November 2011 00054 * 00055 * .. Scalar Arguments .. 00056 INTEGER NUNIT 00057 * .. 00058 * 00059 * ===================================================================== 00060 * 00061 * .. Parameters .. 00062 INTEGER NMAX 00063 PARAMETER ( NMAX = 4 ) 00064 * .. 00065 * .. Local Scalars .. 00066 INTEGER I, INFO, ITER, J 00067 * .. 00068 * .. Local Arrays .. 00069 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00070 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), 00071 $ W( 2*NMAX ), X( NMAX ) 00072 DOUBLE PRECISION WORK(NMAX*NMAX) 00073 REAL SWORK(NMAX*NMAX) 00074 * .. 00075 * .. External Subroutines .. 00076 EXTERNAL CHKXER, DSPOSV 00077 * .. 00078 * .. Scalars in Common .. 00079 LOGICAL LERR, OK 00080 CHARACTER*32 SRNAMT 00081 INTEGER INFOT, NOUT 00082 * .. 00083 * .. Common blocks .. 00084 COMMON / INFOC / INFOT, NOUT, OK, LERR 00085 COMMON / SRNAMC / SRNAMT 00086 * .. 00087 * .. Intrinsic Functions .. 00088 INTRINSIC DBLE 00089 * .. 00090 * .. Executable Statements .. 00091 * 00092 NOUT = NUNIT 00093 WRITE( NOUT, FMT = * ) 00094 * 00095 * Set the variables to innocuous values. 00096 * 00097 DO 20 J = 1, NMAX 00098 DO 10 I = 1, NMAX 00099 A( I, J ) = 1.D0 / DBLE( I+J ) 00100 AF( I, J ) = 1.D0 / DBLE( I+J ) 00101 10 CONTINUE 00102 B( J ) = 0.D0 00103 R1( J ) = 0.D0 00104 R2( J ) = 0.D0 00105 W( J ) = 0.D0 00106 X( J ) = 0.D0 00107 C( J ) = 0.D0 00108 R( J ) = 0.D0 00109 20 CONTINUE 00110 OK = .TRUE. 00111 * 00112 SRNAMT = 'DSPOSV' 00113 INFOT = 1 00114 CALL DSPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO) 00115 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 00116 INFOT = 2 00117 CALL DSPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,ITER,INFO) 00118 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 00119 INFOT = 3 00120 CALL DSPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,ITER,INFO) 00121 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 00122 INFOT = 5 00123 CALL DSPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,ITER,INFO) 00124 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 00125 INFOT = 7 00126 CALL DSPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,ITER,INFO) 00127 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 00128 INFOT = 9 00129 CALL DSPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,ITER,INFO) 00130 CALL CHKXER( 'DSPOSV', INFOT, NOUT, LERR, OK ) 00131 * 00132 * Print a summary line. 00133 * 00134 IF( OK ) THEN 00135 WRITE( NOUT, FMT = 9999 )'DSPOSV' 00136 ELSE 00137 WRITE( NOUT, FMT = 9998 )'DSPOSV' 00138 END IF 00139 * 00140 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' ) 00141 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ', 00142 $ 'exits ***' ) 00143 * 00144 RETURN 00145 * 00146 * End of DERRAC 00147 * 00148 END