![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.5.0.
1: *> \brief \b DORBDB5 2: * 3: * =========== DOCUMENTATION =========== 4: * 5: * Online html documentation available at 6: * http://www.netlib.org/lapack/explore-html/ 7: * 8: *> \htmlonly 9: *> Download DORBDB5 + dependencies 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorbdb5.f"> 11: *> [TGZ]</a> 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorbdb5.f"> 13: *> [ZIP]</a> 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorbdb5.f"> 15: *> [TXT]</a> 16: *> \endhtmlonly 17: * 18: * Definition: 19: * =========== 20: * 21: * SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, 22: * LDQ2, WORK, LWORK, INFO ) 23: * 24: * .. Scalar Arguments .. 25: * INTEGER INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2, 26: * $ N 27: * .. 28: * .. Array Arguments .. 29: * DOUBLE PRECISION Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*) 30: * .. 31: * 32: * 33: *> \par Purpose: 34: *> ============= 35: *> 36: *>\verbatim 37: *> 38: *> DORBDB5 orthogonalizes the column vector 39: *> X = [ X1 ] 40: *> [ X2 ] 41: *> with respect to the columns of 42: *> Q = [ Q1 ] . 43: *> [ Q2 ] 44: *> The columns of Q must be orthonormal. 45: *> 46: *> If the projection is zero according to Kahan's "twice is enough" 47: *> criterion, then some other vector from the orthogonal complement 48: *> is returned. This vector is chosen in an arbitrary but deterministic 49: *> way. 50: *> 51: *>\endverbatim 52: * 53: * Arguments: 54: * ========== 55: * 56: *> \param[in] M1 57: *> \verbatim 58: *> M1 is INTEGER 59: *> The dimension of X1 and the number of rows in Q1. 0 <= M1. 60: *> \endverbatim 61: *> 62: *> \param[in] M2 63: *> \verbatim 64: *> M2 is INTEGER 65: *> The dimension of X2 and the number of rows in Q2. 0 <= M2. 66: *> \endverbatim 67: *> 68: *> \param[in] N 69: *> \verbatim 70: *> N is INTEGER 71: *> The number of columns in Q1 and Q2. 0 <= N. 72: *> \endverbatim 73: *> 74: *> \param[in,out] X1 75: *> \verbatim 76: *> X1 is DOUBLE PRECISION array, dimension (M1) 77: *> On entry, the top part of the vector to be orthogonalized. 78: *> On exit, the top part of the projected vector. 79: *> \endverbatim 80: *> 81: *> \param[in] INCX1 82: *> \verbatim 83: *> INCX1 is INTEGER 84: *> Increment for entries of X1. 85: *> \endverbatim 86: *> 87: *> \param[in,out] X2 88: *> \verbatim 89: *> X2 is DOUBLE PRECISION array, dimension (M2) 90: *> On entry, the bottom part of the vector to be 91: *> orthogonalized. On exit, the bottom part of the projected 92: *> vector. 93: *> \endverbatim 94: *> 95: *> \param[in] INCX2 96: *> \verbatim 97: *> INCX2 is INTEGER 98: *> Increment for entries of X2. 99: *> \endverbatim 100: *> 101: *> \param[in] Q1 102: *> \verbatim 103: *> Q1 is DOUBLE PRECISION array, dimension (LDQ1, N) 104: *> The top part of the orthonormal basis matrix. 105: *> \endverbatim 106: *> 107: *> \param[in] LDQ1 108: *> \verbatim 109: *> LDQ1 is INTEGER 110: *> The leading dimension of Q1. LDQ1 >= M1. 111: *> \endverbatim 112: *> 113: *> \param[in] Q2 114: *> \verbatim 115: *> Q2 is DOUBLE PRECISION array, dimension (LDQ2, N) 116: *> The bottom part of the orthonormal basis matrix. 117: *> \endverbatim 118: *> 119: *> \param[in] LDQ2 120: *> \verbatim 121: *> LDQ2 is INTEGER 122: *> The leading dimension of Q2. LDQ2 >= M2. 123: *> \endverbatim 124: *> 125: *> \param[out] WORK 126: *> \verbatim 127: *> WORK is DOUBLE PRECISION array, dimension (LWORK) 128: *> \endverbatim 129: *> 130: *> \param[in] LWORK 131: *> \verbatim 132: *> LWORK is INTEGER 133: *> The dimension of the array WORK. LWORK >= N. 134: *> \endverbatim 135: *> 136: *> \param[out] INFO 137: *> \verbatim 138: *> INFO is INTEGER 139: *> = 0: successful exit. 140: *> < 0: if INFO = -i, the i-th argument had an illegal value. 141: *> \endverbatim 142: * 143: * Authors: 144: * ======== 145: * 146: *> \author Univ. of Tennessee 147: *> \author Univ. of California Berkeley 148: *> \author Univ. of Colorado Denver 149: *> \author NAG Ltd. 150: * 151: *> \date July 2012 152: * 153: *> \ingroup doubleOTHERcomputational 154: * 155: * ===================================================================== 156: SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, 157: $ LDQ2, WORK, LWORK, INFO ) 158: * 159: * -- LAPACK computational routine (version 3.5.0) -- 160: * -- LAPACK is a software package provided by Univ. of Tennessee, -- 161: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 162: * July 2012 163: * 164: * .. Scalar Arguments .. 165: INTEGER INCX1, INCX2, INFO, LDQ1, LDQ2, LWORK, M1, M2, 166: $ N 167: * .. 168: * .. Array Arguments .. 169: DOUBLE PRECISION Q1(LDQ1,*), Q2(LDQ2,*), WORK(*), X1(*), X2(*) 170: * .. 171: * 172: * ===================================================================== 173: * 174: * .. Parameters .. 175: DOUBLE PRECISION ONE, ZERO 176: PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) 177: * .. 178: * .. Local Scalars .. 179: INTEGER CHILDINFO, I, J 180: * .. 181: * .. External Subroutines .. 182: EXTERNAL DORBDB6, XERBLA 183: * .. 184: * .. External Functions .. 185: DOUBLE PRECISION DNRM2 186: EXTERNAL DNRM2 187: * .. 188: * .. Intrinsic Function .. 189: INTRINSIC MAX 190: * .. 191: * .. Executable Statements .. 192: * 193: * Test input arguments 194: * 195: INFO = 0 196: IF( M1 .LT. 0 ) THEN 197: INFO = -1 198: ELSE IF( M2 .LT. 0 ) THEN 199: INFO = -2 200: ELSE IF( N .LT. 0 ) THEN 201: INFO = -3 202: ELSE IF( INCX1 .LT. 1 ) THEN 203: INFO = -5 204: ELSE IF( INCX2 .LT. 1 ) THEN 205: INFO = -7 206: ELSE IF( LDQ1 .LT. MAX( 1, M1 ) ) THEN 207: INFO = -9 208: ELSE IF( LDQ2 .LT. MAX( 1, M2 ) ) THEN 209: INFO = -11 210: ELSE IF( LWORK .LT. N ) THEN 211: INFO = -13 212: END IF 213: * 214: IF( INFO .NE. 0 ) THEN 215: CALL XERBLA( 'DORBDB5', -INFO ) 216: RETURN 217: END IF 218: * 219: * Project X onto the orthogonal complement of Q 220: * 221: CALL DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, 222: $ WORK, LWORK, CHILDINFO ) 223: * 224: * If the projection is nonzero, then return 225: * 226: IF( DNRM2(M1,X1,INCX1) .NE. ZERO 227: $ .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN 228: RETURN 229: END IF 230: * 231: * Project each standard basis vector e_1,...,e_M1 in turn, stopping 232: * when a nonzero projection is found 233: * 234: DO I = 1, M1 235: DO J = 1, M1 236: X1(J) = ZERO 237: END DO 238: X1(I) = ONE 239: DO J = 1, M2 240: X2(J) = ZERO 241: END DO 242: CALL DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, 243: $ LDQ2, WORK, LWORK, CHILDINFO ) 244: IF( DNRM2(M1,X1,INCX1) .NE. ZERO 245: $ .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN 246: RETURN 247: END IF 248: END DO 249: * 250: * Project each standard basis vector e_(M1+1),...,e_(M1+M2) in turn, 251: * stopping when a nonzero projection is found 252: * 253: DO I = 1, M2 254: DO J = 1, M1 255: X1(J) = ZERO 256: END DO 257: DO J = 1, M2 258: X2(J) = ZERO 259: END DO 260: X2(I) = ONE 261: CALL DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, 262: $ LDQ2, WORK, LWORK, CHILDINFO ) 263: IF( DNRM2(M1,X1,INCX1) .NE. ZERO 264: $ .OR. DNRM2(M2,X2,INCX2) .NE. ZERO ) THEN 265: RETURN 266: END IF 267: END DO 268: * 269: RETURN 270: * 271: * End of DORBDB5 272: * 273: END 274: