![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRAB 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 DERRAB( NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NUNIT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> DERRAB tests the error exits for DSGESV. 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 DERRAB( 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 INTEGER IP( NMAX ) 00070 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00071 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), 00072 $ W( 2*NMAX ), X( NMAX ) 00073 DOUBLE PRECISION WORK(1) 00074 REAL SWORK(1) 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL CHKXER, DSGESV 00078 * .. 00079 * .. Scalars in Common .. 00080 LOGICAL LERR, OK 00081 CHARACTER*32 SRNAMT 00082 INTEGER INFOT, NOUT 00083 * .. 00084 * .. Common blocks .. 00085 COMMON / INFOC / INFOT, NOUT, OK, LERR 00086 COMMON / SRNAMC / SRNAMT 00087 * .. 00088 * .. Intrinsic Functions .. 00089 INTRINSIC DBLE 00090 * .. 00091 * .. Executable Statements .. 00092 * 00093 NOUT = NUNIT 00094 WRITE( NOUT, FMT = * ) 00095 * 00096 * Set the variables to innocuous values. 00097 * 00098 DO 20 J = 1, NMAX 00099 DO 10 I = 1, NMAX 00100 A( I, J ) = 1.D0 / DBLE( I+J ) 00101 AF( I, J ) = 1.D0 / DBLE( I+J ) 00102 10 CONTINUE 00103 B( J ) = 0.D0 00104 R1( J ) = 0.D0 00105 R2( J ) = 0.D0 00106 W( J ) = 0.D0 00107 X( J ) = 0.D0 00108 C( J ) = 0.D0 00109 R( J ) = 0.D0 00110 IP( J ) = J 00111 20 CONTINUE 00112 OK = .TRUE. 00113 * 00114 SRNAMT = 'DSGESV' 00115 INFOT = 1 00116 CALL DSGESV(-1,0,A,1,IP,B,1,X,1,WORK,SWORK,ITER,INFO) 00117 CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK ) 00118 INFOT = 2 00119 CALL DSGESV(0,-1,A,1,IP,B,1,X,1,WORK,SWORK,ITER,INFO) 00120 CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK ) 00121 INFOT = 4 00122 CALL DSGESV(2,1,A,1,IP,B,2,X,2,WORK,SWORK,ITER,INFO) 00123 CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK ) 00124 INFOT = 7 00125 CALL DSGESV(2,1,A,2,IP,B,1,X,2,WORK,SWORK,ITER,INFO) 00126 CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK ) 00127 INFOT = 9 00128 CALL DSGESV(2,1,A,2,IP,B,2,X,1,WORK,SWORK,ITER,INFO) 00129 CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK ) 00130 * 00131 * Print a summary line. 00132 * 00133 IF( OK ) THEN 00134 WRITE( NOUT, FMT = 9999 )'DSGESV' 00135 ELSE 00136 WRITE( NOUT, FMT = 9998 )'DSGESV' 00137 END IF 00138 * 00139 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' ) 00140 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ', 00141 $ 'exits ***' ) 00142 * 00143 RETURN 00144 * 00145 * End of DERRAB 00146 * 00147 END