![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERRAC 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 ZERRAC( NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NUNIT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> ZERRPX tests the error exits for ZCPOSV. 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 complex16_lin 00046 * 00047 * ===================================================================== 00048 SUBROUTINE ZERRAC( 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 COMPLEX*16 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 RWORK( NMAX ) 00073 COMPLEX*16 WORK(NMAX*NMAX) 00074 COMPLEX SWORK(NMAX*NMAX) 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL CHKXER, ZCPOSV 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 20 CONTINUE 00111 OK = .TRUE. 00112 * 00113 SRNAMT = 'ZCPOSV' 00114 INFOT = 1 00115 CALL ZCPOSV('/',0,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO) 00116 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK ) 00117 INFOT = 2 00118 CALL ZCPOSV('U',-1,0,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO) 00119 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK ) 00120 INFOT = 3 00121 CALL ZCPOSV('U',0,-1,A,1,B,1,X,1,WORK,SWORK,RWORK,ITER,INFO) 00122 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK ) 00123 INFOT = 5 00124 CALL ZCPOSV('U',2,1,A,1,B,2,X,2,WORK,SWORK,RWORK,ITER,INFO) 00125 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK ) 00126 INFOT = 7 00127 CALL ZCPOSV('U',2,1,A,2,B,1,X,2,WORK,SWORK,RWORK,ITER,INFO) 00128 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK ) 00129 INFOT = 9 00130 CALL ZCPOSV('U',2,1,A,2,B,2,X,1,WORK,SWORK,RWORK,ITER,INFO) 00131 CALL CHKXER( 'ZCPOSV', INFOT, NOUT, LERR, OK ) 00132 * 00133 * Print a summary line. 00134 * 00135 IF( OK ) THEN 00136 WRITE( NOUT, FMT = 9999 )'ZCPOSV' 00137 ELSE 00138 WRITE( NOUT, FMT = 9998 )'ZCPOSV' 00139 END IF 00140 * 00141 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' ) 00142 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ', 00143 $ 'exits ***' ) 00144 * 00145 RETURN 00146 * 00147 * End of ZERRAC 00148 * 00149 END