cchkee.f
来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 1,803 行 · 第 1/5 页
F
1,803 行
IF( MXBVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' MAXB ', MXBVAL( I ), 0
FATAL = .TRUE.
ELSE IF( MXBVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' MAXB ', MXBVAL( I ), NMAX
FATAL = .TRUE.
END IF
140 CONTINUE
WRITE( NOUT, FMT = 9983 )'MAXB: ',
$ ( MXBVAL( I ), I = 1, NPARMS )
ELSE
DO 150 I = 1, NPARMS
MXBVAL( I ) = 1
150 CONTINUE
END IF
*
* Read the values for INMIN.
*
IF( NEP ) THEN
READ( NIN, FMT = * )( INMIN( I ), I = 1, NPARMS )
DO 540 I = 1, NPARMS
IF( INMIN( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' INMIN ', INMIN( I ), 0
FATAL = .TRUE.
END IF
540 CONTINUE
WRITE( NOUT, FMT = 9983 )'INMIN: ',
$ ( INMIN( I ), I = 1, NPARMS )
ELSE
DO 550 I = 1, NPARMS
INMIN( I ) = 1
550 CONTINUE
END IF
*
* Read the values for INWIN.
*
IF( NEP ) THEN
READ( NIN, FMT = * )( INWIN( I ), I = 1, NPARMS )
DO 560 I = 1, NPARMS
IF( INWIN( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' INWIN ', INWIN( I ), 0
FATAL = .TRUE.
END IF
560 CONTINUE
WRITE( NOUT, FMT = 9983 )'INWIN: ',
$ ( INWIN( I ), I = 1, NPARMS )
ELSE
DO 570 I = 1, NPARMS
INWIN( I ) = 1
570 CONTINUE
END IF
*
* Read the values for INIBL.
*
IF( NEP ) THEN
READ( NIN, FMT = * )( INIBL( I ), I = 1, NPARMS )
DO 580 I = 1, NPARMS
IF( INIBL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' INIBL ', INIBL( I ), 0
FATAL = .TRUE.
END IF
580 CONTINUE
WRITE( NOUT, FMT = 9983 )'INIBL: ',
$ ( INIBL( I ), I = 1, NPARMS )
ELSE
DO 590 I = 1, NPARMS
INIBL( I ) = 1
590 CONTINUE
END IF
*
* Read the values for ISHFTS.
*
IF( NEP ) THEN
READ( NIN, FMT = * )( ISHFTS( I ), I = 1, NPARMS )
DO 600 I = 1, NPARMS
IF( ISHFTS( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' ISHFTS ', ISHFTS( I ), 0
FATAL = .TRUE.
END IF
600 CONTINUE
WRITE( NOUT, FMT = 9983 )'ISHFTS: ',
$ ( ISHFTS( I ), I = 1, NPARMS )
ELSE
DO 610 I = 1, NPARMS
ISHFTS( I ) = 1
610 CONTINUE
END IF
*
* Read the values for IACC22.
*
IF( NEP ) THEN
READ( NIN, FMT = * )( IACC22( I ), I = 1, NPARMS )
DO 620 I = 1, NPARMS
IF( IACC22( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' IACC22 ', IACC22( I ), 0
FATAL = .TRUE.
END IF
620 CONTINUE
WRITE( NOUT, FMT = 9983 )'IACC22: ',
$ ( IACC22( I ), I = 1, NPARMS )
ELSE
DO 630 I = 1, NPARMS
IACC22( I ) = 1
630 CONTINUE
END IF
*
* Read the values for NBCOL.
*
IF( CGG ) THEN
READ( NIN, FMT = * )( NBCOL( I ), I = 1, NPARMS )
DO 160 I = 1, NPARMS
IF( NBCOL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )'NBCOL ', NBCOL( I ), 0
FATAL = .TRUE.
ELSE IF( NBCOL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )'NBCOL ', NBCOL( I ), NMAX
FATAL = .TRUE.
END IF
160 CONTINUE
WRITE( NOUT, FMT = 9983 )'NBCOL:',
$ ( NBCOL( I ), I = 1, NPARMS )
ELSE
DO 170 I = 1, NPARMS
NBCOL( I ) = 1
170 CONTINUE
END IF
END IF
*
* Calculate and print the machine dependent constants.
*
WRITE( NOUT, FMT = * )
EPS = SLAMCH( 'Underflow threshold' )
WRITE( NOUT, FMT = 9981 )'underflow', EPS
EPS = SLAMCH( 'Overflow threshold' )
WRITE( NOUT, FMT = 9981 )'overflow ', EPS
EPS = SLAMCH( 'Epsilon' )
WRITE( NOUT, FMT = 9981 )'precision', EPS
*
* Read the threshold value for the test ratios.
*
READ( NIN, FMT = * )THRESH
WRITE( NOUT, FMT = 9982 )THRESH
IF( SEP .OR. SVD .OR. CGG ) THEN
*
* Read the flag that indicates whether to test LAPACK routines.
*
READ( NIN, FMT = * )TSTCHK
*
* Read the flag that indicates whether to test driver routines.
*
READ( NIN, FMT = * )TSTDRV
END IF
*
* Read the flag that indicates whether to test the error exits.
*
READ( NIN, FMT = * )TSTERR
*
* Read the code describing how to set the random number seed.
*
READ( NIN, FMT = * )NEWSD
*
* If NEWSD = 2, read another line with 4 integers for the seed.
*
IF( NEWSD.EQ.2 )
$ READ( NIN, FMT = * )( IOLDSD( I ), I = 1, 4 )
*
DO 180 I = 1, 4
ISEED( I ) = IOLDSD( I )
180 CONTINUE
*
IF( FATAL ) THEN
WRITE( NOUT, FMT = 9999 )
STOP
END IF
*
* Read the input lines indicating the test path and its parameters.
* The first three characters indicate the test path, and the number
* of test matrix types must be the first nonblank item in columns
* 4-80.
*
190 CONTINUE
*
IF( .NOT.( CGX .OR. CXV ) ) THEN
*
200 CONTINUE
READ( NIN, FMT = '(A80)', END = 380 )LINE
C3 = LINE( 1: 3 )
LENP = LEN( LINE )
I = 3
ITMP = 0
I1 = 0
210 CONTINUE
I = I + 1
IF( I.GT.LENP ) THEN
IF( I1.GT.0 ) THEN
GO TO 240
ELSE
NTYPES = MAXT
GO TO 240
END IF
END IF
IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN
I1 = I
C1 = LINE( I1: I1 )
*
* Check that a valid integer was read
*
DO 220 K = 1, 10
IF( C1.EQ.INTSTR( K: K ) ) THEN
IC = K - 1
GO TO 230
END IF
220 CONTINUE
WRITE( NOUT, FMT = 9991 )I, LINE
GO TO 200
230 CONTINUE
ITMP = 10*ITMP + IC
GO TO 210
ELSE IF( I1.GT.0 ) THEN
GO TO 240
ELSE
GO TO 210
END IF
240 CONTINUE
NTYPES = ITMP
*
* Skip the tests if NTYPES is <= 0.
*
IF( .NOT.( CEV .OR. CES .OR. CVX .OR. CSX .OR. CGV .OR.
$ CGS ) .AND. NTYPES.LE.0 ) THEN
WRITE( NOUT, FMT = 9990 )C3
GO TO 200
END IF
*
ELSE
IF( CGX )
$ C3 = 'CGX'
IF( CXV )
$ C3 = 'CXV'
END IF
*
* Reset the random number seed.
*
IF( NEWSD.EQ.0 ) THEN
DO 250 K = 1, 4
ISEED( K ) = IOLDSD( K )
250 CONTINUE
END IF
*
IF( LSAMEN( 3, C3, 'CHS' ) .OR. LSAMEN( 3, C3, 'NEP' ) ) THEN
*
* -------------------------------------
* NEP: Nonsymmetric Eigenvalue Problem
* -------------------------------------
* Vary the parameters
* NB = block size
* NBMIN = minimum block size
* NX = crossover point
* NS = number of shifts
* MAXB = minimum submatrix size
*
MAXTYP = 21
NTYPES = MIN( MAXTYP, NTYPES )
CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
CALL XLAENV( 1, 1 )
IF( TSTERR )
$ CALL CERRHS( 'CHSEQR', NOUT )
DO 270 I = 1, NPARMS
CALL XLAENV( 1, NBVAL( I ) )
CALL XLAENV( 2, NBMIN( I ) )
CALL XLAENV( 3, NXVAL( I ) )
CALL XLAENV(12, MAX( 11, INMIN( I ) ) )
CALL XLAENV(13, INWIN( I ) )
CALL XLAENV(14, INIBL( I ) )
CALL XLAENV(15, ISHFTS( I ) )
CALL XLAENV(16, IACC22( I ) )
*
IF( NEWSD.EQ.0 ) THEN
DO 260 K = 1, 4
ISEED( K ) = IOLDSD( K )
260 CONTINUE
END IF
WRITE( NOUT, FMT = 9961 )C3, NBVAL( I ), NBMIN( I ),
$ NXVAL( I ), MAX( 11, INMIN(I)),
$ INWIN( I ), INIBL( I ), ISHFTS( I ), IACC22( I )
CALL CCHKHS( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
$ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
$ A( 1, 4 ), A( 1, 5 ), NMAX, A( 1, 6 ),
$ A( 1, 7 ), DC( 1, 1 ), DC( 1, 2 ), A( 1, 8 ),
$ A( 1, 9 ), A( 1, 10 ), A( 1, 11 ), A( 1, 12 ),
$ DC( 1, 3 ), WORK, LWORK, RWORK, IWORK, LOGWRK,
$ RESULT, INFO )
IF( INFO.NE.0 )
$ WRITE( NOUT, FMT = 9980 )'CCHKHS', INFO
270 CONTINUE
*
ELSE IF( LSAMEN( 3, C3, 'CST' ) .OR. LSAMEN( 3, C3, 'SEP' ) ) THEN
*
* ----------------------------------
* SEP: Symmetric Eigenvalue Problem
* ----------------------------------
* Vary the parameters
* NB = block size
* NBMIN = minimum block size
* NX = crossover point
*
MAXTYP = 21
NTYPES = MIN( MAXTYP, NTYPES )
CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
CALL XLAENV( 1, 1 )
CALL XLAENV( 9, 25 )
IF( TSTERR )
$ CALL CERRST( 'CST', NOUT )
DO 290 I = 1, NPARMS
CALL XLAENV( 1, NBVAL( I ) )
CALL XLAENV( 2, NBMIN( I ) )
CALL XLAENV( 3, NXVAL( I ) )
*
IF( NEWSD.EQ.0 ) THEN
DO 280 K = 1, 4
ISEED( K ) = IOLDSD( K )
280 CONTINUE
END IF
WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
$ NXVAL( I )
IF( TSTCHK ) THEN
CALL CCHKST( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
$ NOUT, A( 1, 1 ), NMAX, A( 1, 2 ),
$ DR( 1, 1 ), DR( 1, 2 ), DR( 1, 3 ),
$ DR( 1, 4 ), DR( 1, 5 ), DR( 1, 6 ),
$ DR( 1, 7 ), DR( 1, 8 ), DR( 1, 9 ),
$ DR( 1, 10 ), DR( 1, 11 ), A( 1, 3 ), NMAX,
$ A( 1, 4 ), A( 1, 5 ), DC( 1, 1 ), A( 1, 6 ),
$ WORK, LWORK, RWORK, LWORK, IWORK, LIWORK,
$ RESULT, INFO )
IF( INFO.NE.0 )
$ WRITE( NOUT, FMT = 9980 )'CCHKST', INFO
END IF
IF( TSTDRV ) THEN
CALL CDRVST( NN, NVAL, 18, DOTYPE, ISEED, THRESH, NOUT,
$ A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
$ DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
$ DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
$ DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
$ LWORK, IWORK, LIWORK, RESULT, INFO )
IF( INFO.NE.0 )
$ WRITE( NOUT, FMT = 9980 )'CDRVST', INFO
END IF
290 CONTINUE
*
ELSE IF( LSAMEN( 3, C3, 'CSG' ) ) THEN
*
* ----------------------------------------------
* CSG: Hermitian Generalized Eigenvalue Problem
* ----------------------------------------------
* Vary the parameters
* NB = block size
* NBMIN = minimum block size
* NX = cross⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?