LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ sorbdb5()

subroutine sorbdb5 ( integer  M1,
integer  M2,
integer  N,
real, dimension(*)  X1,
integer  INCX1,
real, dimension(*)  X2,
integer  INCX2,
real, dimension(ldq1,*)  Q1,
integer  LDQ1,
real, dimension(ldq2,*)  Q2,
integer  LDQ2,
real, dimension(*)  WORK,
integer  LWORK,
integer  INFO 
)

SORBDB5

Download SORBDB5 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SORBDB5 orthogonalizes the column vector
      X = [ X1 ]
          [ X2 ]
 with respect to the columns of
      Q = [ Q1 ] .
          [ Q2 ]
 The columns of Q must be orthonormal.

 If the projection is zero according to Kahan's "twice is enough"
 criterion, then some other vector from the orthogonal complement
 is returned. This vector is chosen in an arbitrary but deterministic
 way.
Parameters
[in]M1
          M1 is INTEGER
           The dimension of X1 and the number of rows in Q1. 0 <= M1.
[in]M2
          M2 is INTEGER
           The dimension of X2 and the number of rows in Q2. 0 <= M2.
[in]N
          N is INTEGER
           The number of columns in Q1 and Q2. 0 <= N.
[in,out]X1
          X1 is REAL array, dimension (M1)
           On entry, the top part of the vector to be orthogonalized.
           On exit, the top part of the projected vector.
[in]INCX1
          INCX1 is INTEGER
           Increment for entries of X1.
[in,out]X2
          X2 is REAL array, dimension (M2)
           On entry, the bottom part of the vector to be
           orthogonalized. On exit, the bottom part of the projected
           vector.
[in]INCX2
          INCX2 is INTEGER
           Increment for entries of X2.
[in]Q1
          Q1 is REAL array, dimension (LDQ1, N)
           The top part of the orthonormal basis matrix.
[in]LDQ1
          LDQ1 is INTEGER
           The leading dimension of Q1. LDQ1 >= M1.
[in]Q2
          Q2 is REAL array, dimension (LDQ2, N)
           The bottom part of the orthonormal basis matrix.
[in]LDQ2
          LDQ2 is INTEGER
           The leading dimension of Q2. LDQ2 >= M2.
[out]WORK
          WORK is REAL array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
           The dimension of the array WORK. LWORK >= N.
[out]INFO
          INFO is INTEGER
           = 0:  successful exit.
           < 0:  if INFO = -i, the i-th argument had an illegal value.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
July 2012

Definition at line 158 of file sorbdb5.f.

158 *
159 * -- LAPACK computational routine (version 3.7.1) --
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  REAL q1(ldq1,*), q2(ldq2,*), work(*), x1(*), x2(*)
170 * ..
171 *
172 * =====================================================================
173 *
174 * .. Parameters ..
175  REAL one, zero
176  parameter( one = 1.0e0, zero = 0.0e0 )
177 * ..
178 * .. Local Scalars ..
179  INTEGER childinfo, i, j
180 * ..
181 * .. External Subroutines ..
182  EXTERNAL sorbdb6, xerbla
183 * ..
184 * .. External Functions ..
185  REAL snrm2
186  EXTERNAL snrm2
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( 'SORBDB5', -info )
216  RETURN
217  END IF
218 *
219 * Project X onto the orthogonal complement of Q
220 *
221  CALL sorbdb6( 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( snrm2(m1,x1,incx1) .NE. zero
227  $ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
243  $ ldq2, work, lwork, childinfo )
244  IF( snrm2(m1,x1,incx1) .NE. zero
245  $ .OR. snrm2(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 sorbdb6( m1, m2, n, x1, incx1, x2, incx2, q1, ldq1, q2,
262  $ ldq2, work, lwork, childinfo )
263  IF( snrm2(m1,x1,incx1) .NE. zero
264  $ .OR. snrm2(m2,x2,incx2) .NE. zero ) THEN
265  RETURN
266  END IF
267  END DO
268 *
269  RETURN
270 *
271 * End of SORBDB5
272 *
subroutine sorbdb6(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
SORBDB6
Definition: sorbdb6.f:156
real function snrm2(N, X, INCX)
SNRM2
Definition: snrm2.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
Here is the call graph for this function:
Here is the caller graph for this function: