zchkee.f
来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 1,803 行 · 第 1/5 页
F
1,803 行
ZBK = LSAMEN( 3, PATH, 'ZBK' )
ZGL = LSAMEN( 3, PATH, 'ZGL' )
ZGK = LSAMEN( 3, PATH, 'ZGK' )
*
* Report values of parameters.
*
IF( PATH.EQ.' ' ) THEN
GO TO 10
ELSE IF( NEP ) THEN
WRITE( NOUT, FMT = 9987 )
ELSE IF( SEP ) THEN
WRITE( NOUT, FMT = 9986 )
ELSE IF( SVD ) THEN
WRITE( NOUT, FMT = 9985 )
ELSE IF( ZEV ) THEN
WRITE( NOUT, FMT = 9979 )
ELSE IF( ZES ) THEN
WRITE( NOUT, FMT = 9978 )
ELSE IF( ZVX ) THEN
WRITE( NOUT, FMT = 9977 )
ELSE IF( ZSX ) THEN
WRITE( NOUT, FMT = 9976 )
ELSE IF( ZGG ) THEN
WRITE( NOUT, FMT = 9975 )
ELSE IF( ZGS ) THEN
WRITE( NOUT, FMT = 9964 )
ELSE IF( ZGX ) THEN
WRITE( NOUT, FMT = 9965 )
ELSE IF( ZGV ) THEN
WRITE( NOUT, FMT = 9963 )
ELSE IF( ZXV ) THEN
WRITE( NOUT, FMT = 9962 )
ELSE IF( ZHB ) THEN
WRITE( NOUT, FMT = 9974 )
ELSE IF( ZBB ) THEN
WRITE( NOUT, FMT = 9967 )
ELSE IF( GLM ) THEN
WRITE( NOUT, FMT = 9971 )
ELSE IF( GQR ) THEN
WRITE( NOUT, FMT = 9970 )
ELSE IF( GSV ) THEN
WRITE( NOUT, FMT = 9969 )
ELSE IF( LSE ) THEN
WRITE( NOUT, FMT = 9968 )
ELSE IF( ZBL ) THEN
*
* ZGEBAL: Balancing
*
CALL ZCHKBL( NIN, NOUT )
GO TO 380
ELSE IF( ZBK ) THEN
*
* ZGEBAK: Back transformation
*
CALL ZCHKBK( NIN, NOUT )
GO TO 380
ELSE IF( ZGL ) THEN
*
* ZGGBAL: Balancing
*
CALL ZCHKGL( NIN, NOUT )
GO TO 380
ELSE IF( ZGK ) THEN
*
* ZGGBAK: Back transformation
*
CALL ZCHKGK( NIN, NOUT )
GO TO 380
ELSE IF( LSAMEN( 3, PATH, 'ZEC' ) ) THEN
*
* ZEC: Eigencondition estimation
*
READ( NIN, FMT = * )THRESH
CALL XLAENV( 1, 1 )
TSTERR = .TRUE.
CALL ZCHKEC( THRESH, TSTERR, NIN, NOUT )
GO TO 380
ELSE
WRITE( NOUT, FMT = 9992 )PATH
GO TO 380
END IF
CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
WRITE( NOUT, FMT = 9972 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
WRITE( NOUT, FMT = 9984 )
*
* Read the number of values of M, P, and N.
*
READ( NIN, FMT = * )NN
IF( NN.LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' NN ', NN, 1
NN = 0
FATAL = .TRUE.
ELSE IF( NN.GT.MAXIN ) THEN
WRITE( NOUT, FMT = 9988 )' NN ', NN, MAXIN
NN = 0
FATAL = .TRUE.
END IF
*
* Read the values of M
*
IF( .NOT.( ZGX .OR. ZXV ) ) THEN
READ( NIN, FMT = * )( MVAL( I ), I = 1, NN )
IF( SVD ) THEN
VNAME = ' M '
ELSE
VNAME = ' N '
END IF
DO 20 I = 1, NN
IF( MVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )VNAME, MVAL( I ), 0
FATAL = .TRUE.
ELSE IF( MVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )VNAME, MVAL( I ), NMAX
FATAL = .TRUE.
END IF
20 CONTINUE
WRITE( NOUT, FMT = 9983 )'M: ', ( MVAL( I ), I = 1, NN )
END IF
*
* Read the values of P
*
IF( GLM .OR. GQR .OR. GSV .OR. LSE ) THEN
READ( NIN, FMT = * )( PVAL( I ), I = 1, NN )
DO 30 I = 1, NN
IF( PVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' P ', PVAL( I ), 0
FATAL = .TRUE.
ELSE IF( PVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' P ', PVAL( I ), NMAX
FATAL = .TRUE.
END IF
30 CONTINUE
WRITE( NOUT, FMT = 9983 )'P: ', ( PVAL( I ), I = 1, NN )
END IF
*
* Read the values of N
*
IF( SVD .OR. ZBB .OR. GLM .OR. GQR .OR. GSV .OR. LSE ) THEN
READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
DO 40 I = 1, NN
IF( NVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' N ', NVAL( I ), 0
FATAL = .TRUE.
ELSE IF( NVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' N ', NVAL( I ), NMAX
FATAL = .TRUE.
END IF
40 CONTINUE
ELSE
DO 50 I = 1, NN
NVAL( I ) = MVAL( I )
50 CONTINUE
END IF
IF( .NOT.( ZGX .OR. ZXV ) ) THEN
WRITE( NOUT, FMT = 9983 )'N: ', ( NVAL( I ), I = 1, NN )
ELSE
WRITE( NOUT, FMT = 9983 )'N: ', NN
END IF
*
* Read the number of values of K, followed by the values of K
*
IF( ZHB .OR. ZBB ) THEN
READ( NIN, FMT = * )NK
READ( NIN, FMT = * )( KVAL( I ), I = 1, NK )
DO 60 I = 1, NK
IF( KVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' K ', KVAL( I ), 0
FATAL = .TRUE.
ELSE IF( KVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' K ', KVAL( I ), NMAX
FATAL = .TRUE.
END IF
60 CONTINUE
WRITE( NOUT, FMT = 9983 )'K: ', ( KVAL( I ), I = 1, NK )
END IF
*
IF( ZEV .OR. ZES .OR. ZVX .OR. ZSX ) THEN
*
* For the nonsymmetric QR driver routines, only one set of
* parameters is allowed.
*
READ( NIN, FMT = * )NBVAL( 1 ), NBMIN( 1 ), NXVAL( 1 ),
$ INMIN( 1 ), INWIN( 1 ), INIBL(1), ISHFTS(1), IACC22(1)
IF( NBVAL( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' NB ', NBVAL( 1 ), 1
FATAL = .TRUE.
ELSE IF( NBMIN( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )'NBMIN ', NBMIN( 1 ), 1
FATAL = .TRUE.
ELSE IF( NXVAL( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' NX ', NXVAL( 1 ), 1
FATAL = .TRUE.
ELSE IF( INMIN( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' INMIN ', INMIN( 1 ), 1
FATAL = .TRUE.
ELSE IF( INWIN( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' INWIN ', INWIN( 1 ), 1
FATAL = .TRUE.
ELSE IF( INIBL( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' INIBL ', INIBL( 1 ), 1
FATAL = .TRUE.
ELSE IF( ISHFTS( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' ISHFTS ', ISHFTS( 1 ), 1
FATAL = .TRUE.
ELSE IF( IACC22( 1 ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' IACC22 ', IACC22( 1 ), 0
FATAL = .TRUE.
END IF
CALL XLAENV( 1, NBVAL( 1 ) )
CALL XLAENV( 2, NBMIN( 1 ) )
CALL XLAENV( 3, NXVAL( 1 ) )
CALL XLAENV(12, MAX( 11, INMIN( 1 ) ) )
CALL XLAENV(13, INWIN( 1 ) )
CALL XLAENV(14, INIBL( 1 ) )
CALL XLAENV(15, ISHFTS( 1 ) )
CALL XLAENV(16, IACC22( 1 ) )
WRITE( NOUT, FMT = 9983 )'NB: ', NBVAL( 1 )
WRITE( NOUT, FMT = 9983 )'NBMIN:', NBMIN( 1 )
WRITE( NOUT, FMT = 9983 )'NX: ', NXVAL( 1 )
WRITE( NOUT, FMT = 9983 )'INMIN: ', INMIN( 1 )
WRITE( NOUT, FMT = 9983 )'INWIN: ', INWIN( 1 )
WRITE( NOUT, FMT = 9983 )'INIBL: ', INIBL( 1 )
WRITE( NOUT, FMT = 9983 )'ISHFTS: ', ISHFTS( 1 )
WRITE( NOUT, FMT = 9983 )'IACC22: ', IACC22( 1 )
*
ELSE IF( ZGS .OR. ZGX .OR. ZGV .OR. ZXV ) THEN
*
* For the nonsymmetric generalized driver routines, only one set of
* parameters is allowed.
*
READ( NIN, FMT = * )NBVAL( 1 ), NBMIN( 1 ), NXVAL( 1 ),
$ NSVAL( 1 ), MXBVAL( 1 )
IF( NBVAL( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' NB ', NBVAL( 1 ), 1
FATAL = .TRUE.
ELSE IF( NBMIN( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )'NBMIN ', NBMIN( 1 ), 1
FATAL = .TRUE.
ELSE IF( NXVAL( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' NX ', NXVAL( 1 ), 1
FATAL = .TRUE.
ELSE IF( NSVAL( 1 ).LT.2 ) THEN
WRITE( NOUT, FMT = 9989 )' NS ', NSVAL( 1 ), 2
FATAL = .TRUE.
ELSE IF( MXBVAL( 1 ).LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )' MAXB ', MXBVAL( 1 ), 1
FATAL = .TRUE.
END IF
CALL XLAENV( 1, NBVAL( 1 ) )
CALL XLAENV( 2, NBMIN( 1 ) )
CALL XLAENV( 3, NXVAL( 1 ) )
CALL XLAENV( 4, NSVAL( 1 ) )
CALL XLAENV( 8, MXBVAL( 1 ) )
WRITE( NOUT, FMT = 9983 )'NB: ', NBVAL( 1 )
WRITE( NOUT, FMT = 9983 )'NBMIN:', NBMIN( 1 )
WRITE( NOUT, FMT = 9983 )'NX: ', NXVAL( 1 )
WRITE( NOUT, FMT = 9983 )'NS: ', NSVAL( 1 )
WRITE( NOUT, FMT = 9983 )'MAXB: ', MXBVAL( 1 )
ELSE IF( .NOT.ZHB .AND. .NOT.GLM .AND. .NOT.GQR .AND. .NOT.
$ GSV .AND. .NOT.LSE ) THEN
*
* For the other paths, the number of parameters can be varied
* from the input file. Read the number of parameter values.
*
READ( NIN, FMT = * )NPARMS
IF( NPARMS.LT.1 ) THEN
WRITE( NOUT, FMT = 9989 )'NPARMS', NPARMS, 1
NPARMS = 0
FATAL = .TRUE.
ELSE IF( NPARMS.GT.MAXIN ) THEN
WRITE( NOUT, FMT = 9988 )'NPARMS', NPARMS, MAXIN
NPARMS = 0
FATAL = .TRUE.
END IF
*
* Read the values of NB
*
IF( .NOT.ZBB ) THEN
READ( NIN, FMT = * )( NBVAL( I ), I = 1, NPARMS )
DO 70 I = 1, NPARMS
IF( NBVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' NB ', NBVAL( I ), 0
FATAL = .TRUE.
ELSE IF( NBVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' NB ', NBVAL( I ), NMAX
FATAL = .TRUE.
END IF
70 CONTINUE
WRITE( NOUT, FMT = 9983 )'NB: ',
$ ( NBVAL( I ), I = 1, NPARMS )
END IF
*
* Read the values of NBMIN
*
IF( NEP .OR. SEP .OR. SVD .OR. ZGG ) THEN
READ( NIN, FMT = * )( NBMIN( I ), I = 1, NPARMS )
DO 80 I = 1, NPARMS
IF( NBMIN( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )'NBMIN ', NBMIN( I ), 0
FATAL = .TRUE.
ELSE IF( NBMIN( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )'NBMIN ', NBMIN( I ), NMAX
FATAL = .TRUE.
END IF
80 CONTINUE
WRITE( NOUT, FMT = 9983 )'NBMIN:',
$ ( NBMIN( I ), I = 1, NPARMS )
ELSE
DO 90 I = 1, NPARMS
NBMIN( I ) = 1
90 CONTINUE
END IF
*
* Read the values of NX
*
IF( NEP .OR. SEP .OR. SVD ) THEN
READ( NIN, FMT = * )( NXVAL( I ), I = 1, NPARMS )
DO 100 I = 1, NPARMS
IF( NXVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' NX ', NXVAL( I ), 0
FATAL = .TRUE.
ELSE IF( NXVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' NX ', NXVAL( I ), NMAX
FATAL = .TRUE.
END IF
100 CONTINUE
WRITE( NOUT, FMT = 9983 )'NX: ',
$ ( NXVAL( I ), I = 1, NPARMS )
ELSE
DO 110 I = 1, NPARMS
NXVAL( I ) = 1
110 CONTINUE
END IF
*
* Read the values of NSHIFT (if ZGG) or NRHS (if SVD
* or ZBB).
*
IF( SVD .OR. ZBB .OR. ZGG ) THEN
READ( NIN, FMT = * )( NSVAL( I ), I = 1, NPARMS )
DO 120 I = 1, NPARMS
IF( NSVAL( I ).LT.0 ) THEN
WRITE( NOUT, FMT = 9989 )' NS ', NSVAL( I ), 0
FATAL = .TRUE.
ELSE IF( NSVAL( I ).GT.NMAX ) THEN
WRITE( NOUT, FMT = 9988 )' NS ', NSVAL( I ), NMAX
FATAL = .TRUE.
END IF
120 CONTINUE
WRITE( NOUT, FMT = 9983 )'NS: ',
$ ( NSVAL( I ), I = 1, NPARMS )
ELSE
DO 130 I = 1, NPARMS
NSVAL( I ) = 1
130 CONTINUE
END IF
*
* Read the values for MAXB.
*
IF( ZGG ) THEN
READ( NIN, FMT = * )( MXBVAL( I ), I = 1, NPARMS )
DO 140 I = 1, NPARMS
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?