LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sorghr.f
Go to the documentation of this file.
00001 *> \brief \b SORGHR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SORGHR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorghr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorghr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorghr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
00025 *       ..
00026 *       .. Array Arguments ..
00027 *       REAL               A( LDA, * ), TAU( * ), WORK( * )
00028 *       ..
00029 *  
00030 *
00031 *> \par Purpose:
00032 *  =============
00033 *>
00034 *> \verbatim
00035 *>
00036 *> SORGHR generates a real orthogonal matrix Q which is defined as the
00037 *> product of IHI-ILO elementary reflectors of order N, as returned by
00038 *> SGEHRD:
00039 *>
00040 *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
00041 *> \endverbatim
00042 *
00043 *  Arguments:
00044 *  ==========
00045 *
00046 *> \param[in] N
00047 *> \verbatim
00048 *>          N is INTEGER
00049 *>          The order of the matrix Q. N >= 0.
00050 *> \endverbatim
00051 *>
00052 *> \param[in] ILO
00053 *> \verbatim
00054 *>          ILO is INTEGER
00055 *> \endverbatim
00056 *>
00057 *> \param[in] IHI
00058 *> \verbatim
00059 *>          IHI is INTEGER
00060 *>
00061 *>          ILO and IHI must have the same values as in the previous call
00062 *>          of SGEHRD. Q is equal to the unit matrix except in the
00063 *>          submatrix Q(ilo+1:ihi,ilo+1:ihi).
00064 *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
00065 *> \endverbatim
00066 *>
00067 *> \param[in,out] A
00068 *> \verbatim
00069 *>          A is REAL array, dimension (LDA,N)
00070 *>          On entry, the vectors which define the elementary reflectors,
00071 *>          as returned by SGEHRD.
00072 *>          On exit, the N-by-N orthogonal matrix Q.
00073 *> \endverbatim
00074 *>
00075 *> \param[in] LDA
00076 *> \verbatim
00077 *>          LDA is INTEGER
00078 *>          The leading dimension of the array A. LDA >= max(1,N).
00079 *> \endverbatim
00080 *>
00081 *> \param[in] TAU
00082 *> \verbatim
00083 *>          TAU is REAL array, dimension (N-1)
00084 *>          TAU(i) must contain the scalar factor of the elementary
00085 *>          reflector H(i), as returned by SGEHRD.
00086 *> \endverbatim
00087 *>
00088 *> \param[out] WORK
00089 *> \verbatim
00090 *>          WORK is REAL array, dimension (MAX(1,LWORK))
00091 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
00092 *> \endverbatim
00093 *>
00094 *> \param[in] LWORK
00095 *> \verbatim
00096 *>          LWORK is INTEGER
00097 *>          The dimension of the array WORK. LWORK >= IHI-ILO.
00098 *>          For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
00099 *>          the optimal blocksize.
00100 *>
00101 *>          If LWORK = -1, then a workspace query is assumed; the routine
00102 *>          only calculates the optimal size of the WORK array, returns
00103 *>          this value as the first entry of the WORK array, and no error
00104 *>          message related to LWORK is issued by XERBLA.
00105 *> \endverbatim
00106 *>
00107 *> \param[out] INFO
00108 *> \verbatim
00109 *>          INFO is INTEGER
00110 *>          = 0:  successful exit
00111 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00112 *> \endverbatim
00113 *
00114 *  Authors:
00115 *  ========
00116 *
00117 *> \author Univ. of Tennessee 
00118 *> \author Univ. of California Berkeley 
00119 *> \author Univ. of Colorado Denver 
00120 *> \author NAG Ltd. 
00121 *
00122 *> \date November 2011
00123 *
00124 *> \ingroup realOTHERcomputational
00125 *
00126 *  =====================================================================
00127       SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
00128 *
00129 *  -- LAPACK computational routine (version 3.4.0) --
00130 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00131 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00132 *     November 2011
00133 *
00134 *     .. Scalar Arguments ..
00135       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
00136 *     ..
00137 *     .. Array Arguments ..
00138       REAL               A( LDA, * ), TAU( * ), WORK( * )
00139 *     ..
00140 *
00141 *  =====================================================================
00142 *
00143 *     .. Parameters ..
00144       REAL               ZERO, ONE
00145       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00146 *     ..
00147 *     .. Local Scalars ..
00148       LOGICAL            LQUERY
00149       INTEGER            I, IINFO, J, LWKOPT, NB, NH
00150 *     ..
00151 *     .. External Subroutines ..
00152       EXTERNAL           SORGQR, XERBLA
00153 *     ..
00154 *     .. External Functions ..
00155       INTEGER            ILAENV 
00156       EXTERNAL           ILAENV 
00157 *     ..
00158 *     .. Intrinsic Functions ..
00159       INTRINSIC          MAX, MIN
00160 *     ..
00161 *     .. Executable Statements ..
00162 *
00163 *     Test the input arguments
00164 *
00165       INFO = 0
00166       NH = IHI - ILO
00167       LQUERY = ( LWORK.EQ.-1 )
00168       IF( N.LT.0 ) THEN
00169          INFO = -1
00170       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
00171          INFO = -2
00172       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
00173          INFO = -3
00174       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00175          INFO = -5
00176       ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
00177          INFO = -8
00178       END IF
00179 *
00180       IF( INFO.EQ.0 ) THEN
00181          NB = ILAENV( 1, 'SORGQR', ' ', NH, NH, NH, -1 )
00182          LWKOPT = MAX( 1, NH )*NB
00183          WORK( 1 ) = LWKOPT
00184       END IF
00185 *
00186       IF( INFO.NE.0 ) THEN
00187          CALL XERBLA( 'SORGHR', -INFO )
00188          RETURN
00189       ELSE IF( LQUERY ) THEN
00190          RETURN
00191       END IF
00192 *
00193 *     Quick return if possible
00194 *
00195       IF( N.EQ.0 ) THEN
00196          WORK( 1 ) = 1
00197          RETURN
00198       END IF
00199 *
00200 *     Shift the vectors which define the elementary reflectors one
00201 *     column to the right, and set the first ilo and the last n-ihi
00202 *     rows and columns to those of the unit matrix
00203 *
00204       DO 40 J = IHI, ILO + 1, -1
00205          DO 10 I = 1, J - 1
00206             A( I, J ) = ZERO
00207    10    CONTINUE
00208          DO 20 I = J + 1, IHI
00209             A( I, J ) = A( I, J-1 )
00210    20    CONTINUE
00211          DO 30 I = IHI + 1, N
00212             A( I, J ) = ZERO
00213    30    CONTINUE
00214    40 CONTINUE
00215       DO 60 J = 1, ILO
00216          DO 50 I = 1, N
00217             A( I, J ) = ZERO
00218    50    CONTINUE
00219          A( J, J ) = ONE
00220    60 CONTINUE
00221       DO 80 J = IHI + 1, N
00222          DO 70 I = 1, N
00223             A( I, J ) = ZERO
00224    70    CONTINUE
00225          A( J, J ) = ONE
00226    80 CONTINUE
00227 *
00228       IF( NH.GT.0 ) THEN
00229 *
00230 *        Generate Q(ilo+1:ihi,ilo+1:ihi)
00231 *
00232          CALL SORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
00233      $                WORK, LWORK, IINFO )
00234       END IF
00235       WORK( 1 ) = LWKOPT
00236       RETURN
00237 *
00238 *     End of SORGHR
00239 *
00240       END
 All Files Functions