225 lines
6.5 KiB
FortranFixed
225 lines
6.5 KiB
FortranFixed
REAL FUNCTION SOPLA2( SUBNAM, OPTS, M, N, K, L, NB )
|
|
*
|
|
* -- LAPACK timing routine (version 3.1) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
|
|
* October 2006
|
|
*
|
|
* .. Scalar Arguments ..
|
|
CHARACTER*(*) SUBNAM
|
|
CHARACTER*( * ) OPTS
|
|
INTEGER K, L, M, N, NB
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* SOPLA2 computes an approximation of the number of floating point
|
|
* operations used by the subroutine SUBNAM with character options
|
|
* OPTS and parameters M, N, K, L, and NB.
|
|
*
|
|
* This version counts operations for the LAPACK subroutines that
|
|
* call other LAPACK routines.
|
|
*
|
|
* Arguments
|
|
* =========
|
|
*
|
|
* SUBNAM (input) CHARACTER*(*)
|
|
* The name of the subroutine.
|
|
*
|
|
* OPTS (input) CHRACTER*(*)
|
|
* A string of character options to subroutine SUBNAM.
|
|
*
|
|
* M (input) INTEGER
|
|
* The number of rows of the coefficient matrix.
|
|
*
|
|
* N (input) INTEGER
|
|
* The number of columns of the coefficient matrix.
|
|
*
|
|
* K (input) INTEGER
|
|
* A third problem dimension, if needed.
|
|
*
|
|
* L (input) INTEGER
|
|
* A fourth problem dimension, if needed.
|
|
*
|
|
* NB (input) INTEGER
|
|
* The block size. If needed, NB >= 1.
|
|
*
|
|
* Notes
|
|
* =====
|
|
*
|
|
* In the comments below, the association is given between arguments
|
|
* in the requested subroutine and local arguments. For example,
|
|
*
|
|
* xORMBR: VECT // SIDE // TRANS, M, N, K => OPTS, M, N, K
|
|
*
|
|
* means that the character string VECT // SIDE // TRANS is passed to
|
|
* the argument OPTS, and the integer parameters M, N, and K are passed
|
|
* to the arguments M, N, and K,
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Local Scalars ..
|
|
LOGICAL CORZ, SORD
|
|
CHARACTER C1, SIDE, UPLO, VECT
|
|
CHARACTER*2 C2
|
|
CHARACTER*3 C3
|
|
CHARACTER(32) SUB2
|
|
INTEGER IHI, ILO, ISIDE, MI, NI, NQ
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME, LSAMEN
|
|
REAL SOPLA
|
|
EXTERNAL LSAME, LSAMEN, SOPLA
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* ---------------------------------------------------------
|
|
* Initialize SOPLA2 to 0 and do a quick return if possible.
|
|
* ---------------------------------------------------------
|
|
*
|
|
SOPLA2 = 0
|
|
C1 = SUBNAM( 1: 1 )
|
|
C2 = SUBNAM( 2: 3 )
|
|
C3 = SUBNAM( 4: 6 )
|
|
SORD = LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' )
|
|
CORZ = LSAME( C1, 'C' ) .OR. LSAME( C1, 'Z' )
|
|
IF( M.LE.0 .OR. .NOT.( SORD .OR. CORZ ) )
|
|
$ RETURN
|
|
*
|
|
* -------------------
|
|
* Orthogonal matrices
|
|
* -------------------
|
|
*
|
|
IF( ( SORD .AND. LSAMEN( 2, C2, 'OR' ) ) .OR.
|
|
$ ( CORZ .AND. LSAMEN( 2, C2, 'UN' ) ) ) THEN
|
|
*
|
|
IF( LSAMEN( 3, C3, 'GBR' ) ) THEN
|
|
*
|
|
* -GBR: VECT, M, N, K => OPTS, M, N, K
|
|
*
|
|
VECT = OPTS( 1: 1 )
|
|
IF( LSAME( VECT, 'Q' ) ) THEN
|
|
SUB2 = SUBNAM( 1: 3 ) // 'GQR'
|
|
IF( M.GE.K ) THEN
|
|
SOPLA2 = SOPLA( SUB2, M, N, K, 0, NB )
|
|
ELSE
|
|
SOPLA2 = SOPLA( SUB2, M-1, M-1, M-1, 0, NB )
|
|
END IF
|
|
ELSE
|
|
SUB2 = SUBNAM( 1: 3 ) // 'GLQ'
|
|
IF( K.LT.N ) THEN
|
|
SOPLA2 = SOPLA( SUB2, M, N, K, 0, NB )
|
|
ELSE
|
|
SOPLA2 = SOPLA( SUB2, N-1, N-1, N-1, 0, NB )
|
|
END IF
|
|
END IF
|
|
*
|
|
ELSE IF( LSAMEN( 3, C3, 'MBR' ) ) THEN
|
|
*
|
|
* -MBR: VECT // SIDE // TRANS, M, N, K => OPTS, M, N, K
|
|
*
|
|
VECT = OPTS( 1: 1 )
|
|
SIDE = OPTS( 2: 2 )
|
|
IF( LSAME( SIDE, 'L' ) ) THEN
|
|
NQ = M
|
|
ISIDE = 0
|
|
ELSE
|
|
NQ = N
|
|
ISIDE = 1
|
|
END IF
|
|
IF( LSAME( VECT, 'Q' ) ) THEN
|
|
SUB2 = SUBNAM( 1: 3 ) // 'MQR'
|
|
IF( NQ.GE.K ) THEN
|
|
SOPLA2 = SOPLA( SUB2, M, N, K, ISIDE, NB )
|
|
ELSE IF( ISIDE.EQ.0 ) THEN
|
|
SOPLA2 = SOPLA( SUB2, M-1, N, NQ-1, ISIDE, NB )
|
|
ELSE
|
|
SOPLA2 = SOPLA( SUB2, M, N-1, NQ-1, ISIDE, NB )
|
|
END IF
|
|
ELSE
|
|
SUB2 = SUBNAM( 1: 3 ) // 'MLQ'
|
|
IF( NQ.GT.K ) THEN
|
|
SOPLA2 = SOPLA( SUB2, M, N, K, ISIDE, NB )
|
|
ELSE IF( ISIDE.EQ.0 ) THEN
|
|
SOPLA2 = SOPLA( SUB2, M-1, N, NQ-1, ISIDE, NB )
|
|
ELSE
|
|
SOPLA2 = SOPLA( SUB2, M, N-1, NQ-1, ISIDE, NB )
|
|
END IF
|
|
END IF
|
|
*
|
|
ELSE IF( LSAMEN( 3, C3, 'GHR' ) ) THEN
|
|
*
|
|
* -GHR: N, ILO, IHI => M, N, K
|
|
*
|
|
ILO = N
|
|
IHI = K
|
|
SUB2 = SUBNAM( 1: 3 ) // 'GQR'
|
|
SOPLA2 = SOPLA( SUB2, IHI-ILO, IHI-ILO, IHI-ILO, 0, NB )
|
|
*
|
|
ELSE IF( LSAMEN( 3, C3, 'MHR' ) ) THEN
|
|
*
|
|
* -MHR: SIDE // TRANS, M, N, ILO, IHI => OPTS, M, N, K, L
|
|
*
|
|
SIDE = OPTS( 1: 1 )
|
|
ILO = K
|
|
IHI = L
|
|
IF( LSAME( SIDE, 'L' ) ) THEN
|
|
MI = IHI - ILO
|
|
NI = N
|
|
ISIDE = -1
|
|
ELSE
|
|
MI = M
|
|
NI = IHI - ILO
|
|
ISIDE = 1
|
|
END IF
|
|
SUB2 = SUBNAM( 1: 3 ) // 'MQR'
|
|
SOPLA2 = SOPLA( SUB2, MI, NI, IHI-ILO, ISIDE, NB )
|
|
*
|
|
ELSE IF( LSAMEN( 3, C3, 'GTR' ) ) THEN
|
|
*
|
|
* -GTR: UPLO, N => OPTS, M
|
|
*
|
|
UPLO = OPTS( 1: 1 )
|
|
IF( LSAME( UPLO, 'U' ) ) THEN
|
|
SUB2 = SUBNAM( 1: 3 ) // 'GQL'
|
|
SOPLA2 = SOPLA( SUB2, M-1, M-1, M-1, 0, NB )
|
|
ELSE
|
|
SUB2 = SUBNAM( 1: 3 ) // 'GQR'
|
|
SOPLA2 = SOPLA( SUB2, M-1, M-1, M-1, 0, NB )
|
|
END IF
|
|
*
|
|
ELSE IF( LSAMEN( 3, C3, 'MTR' ) ) THEN
|
|
*
|
|
* -MTR: SIDE // UPLO // TRANS, M, N => OPTS, M, N
|
|
*
|
|
SIDE = OPTS( 1: 1 )
|
|
UPLO = OPTS( 2: 2 )
|
|
IF( LSAME( SIDE, 'L' ) ) THEN
|
|
MI = M - 1
|
|
NI = N
|
|
NQ = M
|
|
ISIDE = -1
|
|
ELSE
|
|
MI = M
|
|
NI = N - 1
|
|
NQ = N
|
|
ISIDE = 1
|
|
END IF
|
|
*
|
|
IF( LSAME( UPLO, 'U' ) ) THEN
|
|
SUB2 = SUBNAM( 1: 3 ) // 'MQL'
|
|
SOPLA2 = SOPLA( SUB2, MI, NI, NQ-1, ISIDE, NB )
|
|
ELSE
|
|
SUB2 = SUBNAM( 1: 3 ) // 'MQR'
|
|
SOPLA2 = SOPLA( SUB2, MI, NI, NQ-1, ISIDE, NB )
|
|
END IF
|
|
*
|
|
END IF
|
|
END IF
|
|
*
|
|
RETURN
|
|
*
|
|
* End of SOPLA2
|
|
*
|
|
END
|