other routines
iparmq
USAGE:
__out__ = NumRu::Lapack.iparmq( ispec, name, opts, n, ilo, ihi, lwork, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
* Purpose
* =======
*
* This program sets problem and machine dependent parameters
* useful for xHSEQR and its subroutines. It is called whenever
* ILAENV is called with 12 <= ISPEC <= 16
*
* Arguments
* =========
*
* ISPEC (input) integer scalar
* ISPEC specifies which tunable parameter IPARMQ should
* return.
*
* ISPEC=12: (INMIN) Matrices of order nmin or less
* are sent directly to xLAHQR, the implicit
* double shift QR algorithm. NMIN must be
* at least 11.
*
* ISPEC=13: (INWIN) Size of the deflation window.
* This is best set greater than or equal to
* the number of simultaneous shifts NS.
* Larger matrices benefit from larger deflation
* windows.
*
* ISPEC=14: (INIBL) Determines when to stop nibbling and
* invest in an (expensive) multi-shift QR sweep.
* If the aggressive early deflation subroutine
* finds LD converged eigenvalues from an order
* NW deflation window and LD.GT.(NW*NIBBLE)/100,
* then the next QR sweep is skipped and early
* deflation is applied immediately to the
* remaining active diagonal block. Setting
* IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
* multi-shift QR sweep whenever early deflation
* finds a converged eigenvalue. Setting
* IPARMQ(ISPEC=14) greater than or equal to 100
* prevents TTQRE from skipping a multi-shift
* QR sweep.
*
* ISPEC=15: (NSHFTS) The number of simultaneous shifts in
* a multi-shift QR iteration.
*
* ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
* following meanings.
* 0: During the multi-shift QR sweep,
* xLAQR5 does not accumulate reflections and
* does not use matrix-matrix multiply to
* update the far-from-diagonal matrix
* entries.
* 1: During the multi-shift QR sweep,
* xLAQR5 and/or xLAQRaccumulates reflections and uses
* matrix-matrix multiply to update the
* far-from-diagonal matrix entries.
* 2: During the multi-shift QR sweep.
* xLAQR5 accumulates reflections and takes
* advantage of 2-by-2 block structure during
* matrix-matrix multiplies.
* (If xTRMM is slower than xGEMM, then
* IPARMQ(ISPEC=16)=1 may be more efficient than
* IPARMQ(ISPEC=16)=2 despite the greater level of
* arithmetic work implied by the latter choice.)
*
* NAME (input) character string
* Name of the calling subroutine
*
* OPTS (input) character string
* This is a concatenation of the string arguments to
* TTQRE.
*
* N (input) integer scalar
* N is the order of the Hessenberg matrix H.
*
* ILO (input) INTEGER
* IHI (input) INTEGER
* It is assumed that H is already upper triangular
* in rows and columns 1:ILO-1 and IHI+1:N.
*
* LWORK (input) integer scalar
* The amount of workspace available.
*
* Further Details
* ===============
*
* Little is known about how best to choose these parameters.
* It is possible to use different values of the parameters
* for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
*
* It is probably best to choose different parameters for
* different matrices and different parameters at different
* times during the iteration, but this has not been
* implemented --- yet.
*
*
* The best choices of most of the parameters depend
* in an ill-understood way on the relative execution
* rate of xLAQR3 and xLAQR5 and on the nature of each
* particular eigenvalue problem. Experiment may be the
* only practical way to determine which choices are most
* effective.
*
* Following is a list of default values supplied by IPARMQ.
* These defaults may be adjusted in order to attain better
* performance in any particular computational environment.
*
* IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
* Default: 75. (Must be at least 11.)
*
* IPARMQ(ISPEC=13) Recommended deflation window size.
* This depends on ILO, IHI and NS, the
* number of simultaneous shifts returned
* by IPARMQ(ISPEC=15). The default for
* (IHI-ILO+1).LE.500 is NS. The default
* for (IHI-ILO+1).GT.500 is 3*NS/2.
*
* IPARMQ(ISPEC=14) Nibble crossover point. Default: 14.
*
* IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
* a multi-shift QR iteration.
*
* If IHI-ILO+1 is ...
*
* greater than ...but less ... the
* or equal to ... than default is
*
* 0 30 NS = 2+
* 30 60 NS = 4+
* 60 150 NS = 10
* 150 590 NS = **
* 590 3000 NS = 64
* 3000 6000 NS = 128
* 6000 infinity NS = 256
*
* (+) By default matrices of this order are
* passed to the implicit double shift routine
* xLAHQR. See IPARMQ(ISPEC=12) above. These
* values of NS are used only in case of a rare
* xLAHQR failure.
*
* (**) The asterisks (**) indicate an ad-hoc
* function increasing from 10 to 64.
*
* IPARMQ(ISPEC=16) Select structured matrix multiply.
* (See ISPEC=16 above for details.)
* Default: 3.
*
* ================================================================
go to the page top
lsamen
USAGE:
__out__ = NumRu::Lapack.lsamen( n, ca, cb, [:usage => usage, :help => help])
FORTRAN MANUAL
LOGICAL FUNCTION LSAMEN( N, CA, CB )
* Purpose
* =======
*
* LSAMEN tests if the first N letters of CA are the same as the
* first N letters of CB, regardless of case.
* LSAMEN returns .TRUE. if CA and CB are equivalent except for case
* and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA )
* or LEN( CB ) is less than N.
*
* Arguments
* =========
*
* N (input) INTEGER
* The number of characters in CA and CB to be compared.
*
* CA (input) CHARACTER*(*)
* CB (input) CHARACTER*(*)
* CA and CB specify two character strings of length at least N.
* Only the first N characters of each string will be accessed.
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN
* ..
go to the page top
ilazlr
USAGE:
__out__ = NumRu::Lapack.ilazlr( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILAZLR( M, N, A, LDA )
* Purpose
* =======
*
* ILAZLR scans A for its last non-zero row.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) COMPLEX*16 array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
iladiag
USAGE:
__out__ = NumRu::Lapack.iladiag( diag, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILADIAG( DIAG )
* Purpose
* =======
*
* This subroutine translated from a character string specifying if a
* matrix has unit diagonal or not to the relevant BLAST-specified
* integer constant.
*
* ILADIAG returns an INTEGER. If ILADIAG < 0, then the input is not a
* character indicating a unit or non-unit diagonal. Otherwise ILADIAG
* returns the constant value corresponding to DIAG.
*
* Arguments
* =========
* DIAG (input) CHARACTER*1
* = 'N': A is non-unit triangular;
* = 'U': A is unit triangular.
* =====================================================================
*
go to the page top
ilaslc
USAGE:
__out__ = NumRu::Lapack.ilaslc( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILASLC( M, N, A, LDA )
* Purpose
* =======
*
* ILASLC scans A for its last non-zero column.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) REAL array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
ilaver
USAGE:
vers_major, vers_minor, vers_patch = NumRu::Lapack.ilaver( , [:usage => usage, :help => help])
FORTRAN MANUAL
SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
* Purpose
* =======
*
* This subroutine return the Lapack version.
*
* Arguments
* =========
* VERS_MAJOR (output) INTEGER
* return the lapack major version
* VERS_MINOR (output) INTEGER
* return the lapack minor version from the major version
* VERS_PATCH (output) INTEGER
* return the lapack patch version from the minor version
* =====================================================================
*
INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
* =====================================================================
VERS_MAJOR = 3
VERS_MINOR = 3
VERS_PATCH = 0
* =====================================================================
*
RETURN
END
go to the page top
ilaslr
USAGE:
__out__ = NumRu::Lapack.ilaslr( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILASLR( M, N, A, LDA )
* Purpose
* =======
*
* ILASLR scans A for its last non-zero row.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) REAL array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
ilauplo
USAGE:
__out__ = NumRu::Lapack.ilauplo( uplo, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILAUPLO( UPLO )
* Purpose
* =======
*
* This subroutine translated from a character string specifying a
* upper- or lower-triangular matrix to the relevant BLAST-specified
* integer constant.
*
* ILAUPLO returns an INTEGER. If ILAUPLO < 0, then the input is not
* a character indicating an upper- or lower-triangular matrix.
* Otherwise ILAUPLO returns the constant value corresponding to UPLO.
*
* Arguments
* =========
* UPLO (input) CHARACTER
* = 'U': A is upper triangular;
* = 'L': A is lower triangular.
* =====================================================================
*
go to the page top
xerbla_array
USAGE:
= NumRu::Lapack.xerbla_array( srname_array, info, [:usage => usage, :help => help])
FORTRAN MANUAL
SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO)
* Purpose
* =======
*
* XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK
* and BLAS error handler. Rather than taking a Fortran string argument
* as the function's name, XERBLA_ARRAY takes an array of single
* characters along with the array's length. XERBLA_ARRAY then copies
* up to 32 characters of that array into a Fortran string and passes
* that to XERBLA. If called with a non-positive SRNAME_LEN,
* XERBLA_ARRAY will call XERBLA with a string of all blank characters.
*
* Say some macro or other device makes XERBLA_ARRAY available to C99
* by a name lapack_xerbla and with a common Fortran calling convention.
* Then a C99 program could invoke XERBLA via:
* {
* int flen = strlen(__func__);
* lapack_xerbla(__func__, &flen, &info);
* }
*
* Providing XERBLA_ARRAY is not necessary for intercepting LAPACK
* errors. XERBLA_ARRAY calls XERBLA.
*
* Arguments
* =========
*
* SRNAME_ARRAY (input) CHARACTER(1) array, dimension (SRNAME_LEN)
* The name of the routine which called XERBLA_ARRAY.
*
* SRNAME_LEN (input) INTEGER
* The length of the name in SRNAME_ARRAY.
*
* INFO (input) INTEGER
* The position of the invalid parameter in the parameter list
* of the calling routine.
*
* =====================================================================
*
* ..
* .. Local Scalars ..
INTEGER I
* ..
* .. Local Arrays ..
CHARACTER*32 SRNAME
* ..
* .. Intrinsic Functions ..
INTRINSIC MIN, LEN
* ..
* .. External Functions ..
EXTERNAL XERBLA
* ..
go to the page top
iladlr
USAGE:
__out__ = NumRu::Lapack.iladlr( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILADLR( M, N, A, LDA )
* Purpose
* =======
*
* ILADLR scans A for its last non-zero row.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) DOUBLE PRECISION array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
ilazlc
USAGE:
__out__ = NumRu::Lapack.ilazlc( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILAZLC( M, N, A, LDA )
* Purpose
* =======
*
* ILAZLC scans A for its last non-zero column.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) COMPLEX*16 array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
icmax1
USAGE:
__out__ = NumRu::Lapack.icmax1( cx, incx, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ICMAX1( N, CX, INCX )
* Purpose
* =======
*
* ICMAX1 finds the index of the element whose real part has maximum
* absolute value.
*
* Based on ICAMAX from Level 1 BLAS.
* The change is to use the 'genuine' absolute value.
*
* Contributed by Nick Higham for use with CLACON.
*
* Arguments
* =========
*
* N (input) INTEGER
* The number of elements in the vector CX.
*
* CX (input) COMPLEX array, dimension (N)
* The vector whose elements will be summed.
*
* INCX (input) INTEGER
* The spacing between successive values of CX. INCX >= 1.
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, IX
REAL SMAX
COMPLEX ZDUM
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Statement Functions ..
REAL CABS1
* ..
* .. Statement Function definitions ..
*
* NEXT LINE IS THE ONLY MODIFICATION.
CABS1( ZDUM ) = ABS( ZDUM )
* ..
go to the page top
ilaclr
USAGE:
__out__ = NumRu::Lapack.ilaclr( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILACLR( M, N, A, LDA )
* Purpose
* =======
*
* ILACLR scans A for its last non-zero row.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) COMPLEX array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
iladlc
USAGE:
__out__ = NumRu::Lapack.iladlc( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILADLC( M, N, A, LDA )
* Purpose
* =======
*
* ILADLC scans A for its last non-zero column.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) DOUBLE PRECISION array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
ilatrans
USAGE:
__out__ = NumRu::Lapack.ilatrans( trans, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILATRANS( TRANS )
* Purpose
* =======
*
* This subroutine translates from a character string specifying a
* transposition operation to the relevant BLAST-specified integer
* constant.
*
* ILATRANS returns an INTEGER. If ILATRANS < 0, then the input is not
* a character indicating a transposition operator. Otherwise ILATRANS
* returns the constant value corresponding to TRANS.
*
* Arguments
* =========
* TRANS (input) CHARACTER*1
* Specifies the form of the system of equations:
* = 'N': No transpose
* = 'T': Transpose
* = 'C': Conjugate transpose
* =====================================================================
*
go to the page top
ilaenv
USAGE:
__out__ = NumRu::Lapack.ilaenv( ispec, name, opts, n1, n2, n3, n4, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
* Purpose
* =======
*
* ILAENV is called from the LAPACK routines to choose problem-dependent
* parameters for the local environment. See ISPEC for a description of
* the parameters.
*
* ILAENV returns an INTEGER
* if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC
* if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value.
*
* This version provides a set of parameters which should give good,
* but not optimal, performance on many of the currently available
* computers. Users are encouraged to modify this subroutine to set
* the tuning parameters for their particular machine using the option
* and problem size information in the arguments.
*
* This routine will not function correctly if it is converted to all
* lower case. Converting it to all upper case is allowed.
*
* Arguments
* =========
*
* ISPEC (input) INTEGER
* Specifies the parameter to be returned as the value of
* ILAENV.
* = 1: the optimal blocksize; if this value is 1, an unblocked
* algorithm will give the best performance.
* = 2: the minimum block size for which the block routine
* should be used; if the usable block size is less than
* this value, an unblocked routine should be used.
* = 3: the crossover point (in a block routine, for N less
* than this value, an unblocked routine should be used)
* = 4: the number of shifts, used in the nonsymmetric
* eigenvalue routines (DEPRECATED)
* = 5: the minimum column dimension for blocking to be used;
* rectangular blocks must have dimension at least k by m,
* where k is given by ILAENV(2,...) and m by ILAENV(5,...)
* = 6: the crossover point for the SVD (when reducing an m by n
* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
* this value, a QR factorization is used first to reduce
* the matrix to a triangular form.)
* = 7: the number of processors
* = 8: the crossover point for the multishift QR method
* for nonsymmetric eigenvalue problems (DEPRECATED)
* = 9: maximum size of the subproblems at the bottom of the
* computation tree in the divide-and-conquer algorithm
* (used by xGELSD and xGESDD)
* =10: ieee NaN arithmetic can be trusted not to trap
* =11: infinity arithmetic can be trusted not to trap
* 12 <= ISPEC <= 16:
* xHSEQR or one of its subroutines,
* see IPARMQ for detailed explanation
*
* NAME (input) CHARACTER*(*)
* The name of the calling subroutine, in either upper case or
* lower case.
*
* OPTS (input) CHARACTER*(*)
* The character options to the subroutine NAME, concatenated
* into a single character string. For example, UPLO = 'U',
* TRANS = 'T', and DIAG = 'N' for a triangular routine would
* be specified as OPTS = 'UTN'.
*
* N1 (input) INTEGER
* N2 (input) INTEGER
* N3 (input) INTEGER
* N4 (input) INTEGER
* Problem dimensions for the subroutine NAME; these may not all
* be required.
*
* Further Details
* ===============
*
* The following conventions have been used when calling ILAENV from the
* LAPACK routines:
* 1) OPTS is a concatenation of all of the character options to
* subroutine NAME, in the same order that they appear in the
* argument list for NAME, even if they are not used in determining
* the value of the parameter specified by ISPEC.
* 2) The problem dimensions N1, N2, N3, N4 are specified in the order
* that they appear in the argument list for NAME. N1 is used
* first, N2 second, and so on, and unused problem dimensions are
* passed a value of -1.
* 3) The parameter value returned by ILAENV is checked for validity in
* the calling subroutine. For example, ILAENV is used to retrieve
* the optimal blocksize for STRTRI as follows:
*
* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
* IF( NB.LE.1 ) NB = MAX( 1, N )
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, IC, IZ, NB, NBMIN, NX
LOGICAL CNAME, SNAME
CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*6
* ..
* .. Intrinsic Functions ..
INTRINSIC CHAR, ICHAR, INT, MIN, REAL
* ..
* .. External Functions ..
INTEGER IEEECK, IPARMQ
EXTERNAL IEEECK, IPARMQ
* ..
go to the page top
ilaclc
USAGE:
__out__ = NumRu::Lapack.ilaclc( m, a, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILACLC( M, N, A, LDA )
* Purpose
* =======
*
* ILACLC scans A for its last non-zero column.
*
* Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A.
*
* N (input) INTEGER
* The number of columns of the matrix A.
*
* A (input) COMPLEX array, dimension (LDA,N)
* The m by n matrix A.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* =====================================================================
*
go to the page top
xerbla
USAGE:
= NumRu::Lapack.xerbla( srname, info, [:usage => usage, :help => help])
FORTRAN MANUAL
SUBROUTINE XERBLA( SRNAME, INFO )
* Purpose
* =======
*
* XERBLA is an error handler for the LAPACK routines.
* It is called by an LAPACK routine if an input parameter has an
* invalid value. A message is printed and execution stops.
*
* Installers may consider modifying the STOP statement in order to
* call system-specific exception-handling facilities.
*
* Arguments
* =========
*
* SRNAME (input) CHARACTER*(*)
* The name of the routine which called XERBLA.
*
* INFO (input) INTEGER
* The position of the invalid parameter in the parameter list
* of the calling routine.
*
* =====================================================================
*
* .. Intrinsic Functions ..
INTRINSIC LEN_TRIM
* ..
go to the page top
ieeeck
USAGE:
__out__ = NumRu::Lapack.ieeeck( ispec, zero, one, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
* Purpose
* =======
*
* IEEECK is called from the ILAENV to verify that Infinity and
* possibly NaN arithmetic is safe (i.e. will not trap).
*
* Arguments
* =========
*
* ISPEC (input) INTEGER
* Specifies whether to test just for inifinity arithmetic
* or whether to test for infinity and NaN arithmetic.
* = 0: Verify infinity arithmetic only.
* = 1: Verify infinity and NaN arithmetic.
*
* ZERO (input) REAL
* Must contain the value 0.0
* This is passed to prevent the compiler from optimizing
* away this code.
*
* ONE (input) REAL
* Must contain the value 1.0
* This is passed to prevent the compiler from optimizing
* away this code.
*
* RETURN VALUE: INTEGER
* = 0: Arithmetic failed to produce the correct answers
* = 1: Arithmetic produced the correct answers
*
* .. Local Scalars ..
REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
$ NEGZRO, NEWZRO, POSINF
* ..
go to the page top
izmax1
USAGE:
__out__ = NumRu::Lapack.izmax1( cx, incx, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION IZMAX1( N, CX, INCX )
* Purpose
* =======
*
* IZMAX1 finds the index of the element whose real part has maximum
* absolute value.
*
* Based on IZAMAX from Level 1 BLAS.
* The change is to use the 'genuine' absolute value.
*
* Contributed by Nick Higham for use with ZLACON.
*
* Arguments
* =========
*
* N (input) INTEGER
* The number of elements in the vector CX.
*
* CX (input) COMPLEX*16 array, dimension (N)
* The vector whose elements will be summed.
*
* INCX (input) INTEGER
* The spacing between successive values of CX. INCX >= 1.
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, IX
DOUBLE PRECISION SMAX
COMPLEX*16 ZDUM
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Statement Functions ..
DOUBLE PRECISION CABS1
* ..
* .. Statement Function definitions ..
*
* NEXT LINE IS THE ONLY MODIFICATION.
CABS1( ZDUM ) = ABS( ZDUM )
* ..
go to the page top
ilaprec
USAGE:
__out__ = NumRu::Lapack.ilaprec( prec, [:usage => usage, :help => help])
FORTRAN MANUAL
INTEGER FUNCTION ILAPREC( PREC )
* Purpose
* =======
*
* This subroutine translated from a character string specifying an
* intermediate precision to the relevant BLAST-specified integer
* constant.
*
* ILAPREC returns an INTEGER. If ILAPREC < 0, then the input is not a
* character indicating a supported intermediate precision. Otherwise
* ILAPREC returns the constant value corresponding to PREC.
*
* Arguments
* =========
* PREC (input) CHARACTER
* Specifies the form of the system of equations:
* = 'S': Single
* = 'D': Double
* = 'I': Indigenous
* = 'X', 'E': Extra
* =====================================================================
*
go to the page top
back to index