Skip Navigation Links
Numerical Libraries
Linear Algebra
Differential Equations
Optimization
Samples
Skip Navigation Links
Linear Algebra
CSLapack
CSBlas
   1:  #region Translated by Jose Antonio De Santiago-Castillo.
   2:   
   3:  //Translated by Jose Antonio De Santiago-Castillo. 
   4:  //E-mail:JAntonioDeSantiago@gmail.com
   5:  //Web: www.DotNumerics.com
   6:  //
   7:  //Fortran to C# Translation.
   8:  //Translated by:
   9:  //F2CSharp Version 0.71 (November 10, 2009)
  10:  //Code Optimizations: None
  11:  //
  12:  #endregion
  13:   
  14:  using System;
  15:  using DotNumerics.FortranLibrary;
  16:   
  17:  namespace DotNumerics.CSLapack
  18:  {
  19:      /// <summary>
  20:      /// -- LAPACK routine (version 3.1) --
  21:      /// Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  22:      /// November 2006
  23:      /// Purpose
  24:      /// =======
  25:      /// 
  26:      /// DORGL2 generates an m by n real matrix Q with orthonormal rows,
  27:      /// which is defined as the first m rows of a product of k elementary
  28:      /// reflectors of order n
  29:      /// 
  30:      /// Q  =  H(k) . . . H(2) H(1)
  31:      /// 
  32:      /// as returned by DGELQF.
  33:      /// 
  34:      ///</summary>
  35:      public class DORGL2
  36:      {
  37:      
  38:   
  39:          #region Dependencies
  40:          
  41:          DLARF _dlarf; DSCAL _dscal; XERBLA _xerbla; 
  42:   
  43:          #endregion
  44:   
  45:   
  46:          #region Fields
  47:          
  48:          const double ONE = 1.0E+0; const double ZERO = 0.0E+0; int I = 0; int J = 0; int L = 0; 
  49:   
  50:          #endregion
  51:   
  52:          public DORGL2(DLARF dlarf, DSCAL dscal, XERBLA xerbla)
  53:          {
  54:      
  55:   
  56:              #region Set Dependencies
  57:              
  58:              this._dlarf = dlarf; this._dscal = dscal; this._xerbla = xerbla; 
  59:   
  60:              #endregion
  61:   
  62:          }
  63:      
  64:          public DORGL2()
  65:          {
  66:      
  67:   
  68:              #region Dependencies (Initialization)
  69:              
  70:              LSAME lsame = new LSAME();
  71:              XERBLA xerbla = new XERBLA();
  72:              DSCAL dscal = new DSCAL();
  73:              DGEMV dgemv = new DGEMV(lsame, xerbla);
  74:              DGER dger = new DGER(xerbla);
  75:              DLARF dlarf = new DLARF(dgemv, dger, lsame);
  76:   
  77:              #endregion
  78:   
  79:   
  80:              #region Set Dependencies
  81:              
  82:              this._dlarf = dlarf; this._dscal = dscal; this._xerbla = xerbla; 
  83:   
  84:              #endregion
  85:   
  86:          }
  87:          /// <summary>
  88:          /// Purpose
  89:          /// =======
  90:          /// 
  91:          /// DORGL2 generates an m by n real matrix Q with orthonormal rows,
  92:          /// which is defined as the first m rows of a product of k elementary
  93:          /// reflectors of order n
  94:          /// 
  95:          /// Q  =  H(k) . . . H(2) H(1)
  96:          /// 
  97:          /// as returned by DGELQF.
  98:          /// 
  99:          ///</summary>
 100:          /// <param name="M">
 101:          /// (input) INTEGER
 102:          /// The number of rows of the matrix Q. M .GE. 0.
 103:          ///</param>
 104:          /// <param name="N">
 105:          /// (input) INTEGER
 106:          /// The number of columns of the matrix Q. N .GE. M.
 107:          ///</param>
 108:          /// <param name="K">
 109:          /// (input) INTEGER
 110:          /// The number of elementary reflectors whose product defines the
 111:          /// matrix Q. M .GE. K .GE. 0.
 112:          ///</param>
 113:          /// <param name="A">
 114:          /// (input/output) DOUBLE PRECISION array, dimension (LDA,N)
 115:          /// On entry, the i-th row must contain the vector which defines
 116:          /// the elementary reflector H(i), for i = 1,2,...,k, as returned
 117:          /// by DGELQF in the first k rows of its array argument A.
 118:          /// On exit, the m-by-n matrix Q.
 119:          ///</param>
 120:          /// <param name="LDA">
 121:          /// (input) INTEGER
 122:          /// The first dimension of the array A. LDA .GE. max(1,M).
 123:          ///</param>
 124:          /// <param name="TAU">
 125:          /// (input) DOUBLE PRECISION array, dimension (K)
 126:          /// TAU(i) must contain the scalar factor of the elementary
 127:          /// reflector H(i), as returned by DGELQF.
 128:          ///</param>
 129:          /// <param name="WORK">
 130:          /// (workspace) DOUBLE PRECISION array, dimension (M)
 131:          ///</param>
 132:          /// <param name="INFO">
 133:          /// (output) INTEGER
 134:          /// = 0: successful exit
 135:          /// .LT. 0: if INFO = -i, the i-th argument has an illegal value
 136:          ///</param>
 137:          public void Run(int M, int N, int K, ref double[] A, int offset_a, int LDA, double[] TAU, int offset_tau
 138:                           , ref double[] WORK, int offset_work, ref int INFO)
 139:          {
 140:   
 141:              #region Array Index Correction
 142:              
 143:               int o_a = -1 - LDA + offset_a;  int o_tau = -1 + offset_tau;  int o_work = -1 + offset_work; 
 144:   
 145:              #endregion
 146:   
 147:   
 148:              #region Prolog
 149:              
 150:              // *
 151:              // *  -- LAPACK routine (version 3.1) --
 152:              // *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 153:              // *     November 2006
 154:              // *
 155:              // *     .. Scalar Arguments ..
 156:              // *     ..
 157:              // *     .. Array Arguments ..
 158:              // *     ..
 159:              // *
 160:              // *  Purpose
 161:              // *  =======
 162:              // *
 163:              // *  DORGL2 generates an m by n real matrix Q with orthonormal rows,
 164:              // *  which is defined as the first m rows of a product of k elementary
 165:              // *  reflectors of order n
 166:              // *
 167:              // *        Q  =  H(k) . . . H(2) H(1)
 168:              // *
 169:              // *  as returned by DGELQF.
 170:              // *
 171:              // *  Arguments
 172:              // *  =========
 173:              // *
 174:              // *  M       (input) INTEGER
 175:              // *          The number of rows of the matrix Q. M >= 0.
 176:              // *
 177:              // *  N       (input) INTEGER
 178:              // *          The number of columns of the matrix Q. N >= M.
 179:              // *
 180:              // *  K       (input) INTEGER
 181:              // *          The number of elementary reflectors whose product defines the
 182:              // *          matrix Q. M >= K >= 0.
 183:              // *
 184:              // *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
 185:              // *          On entry, the i-th row must contain the vector which defines
 186:              // *          the elementary reflector H(i), for i = 1,2,...,k, as returned
 187:              // *          by DGELQF in the first k rows of its array argument A.
 188:              // *          On exit, the m-by-n matrix Q.
 189:              // *
 190:              // *  LDA     (input) INTEGER
 191:              // *          The first dimension of the array A. LDA >= max(1,M).
 192:              // *
 193:              // *  TAU     (input) DOUBLE PRECISION array, dimension (K)
 194:              // *          TAU(i) must contain the scalar factor of the elementary
 195:              // *          reflector H(i), as returned by DGELQF.
 196:              // *
 197:              // *  WORK    (workspace) DOUBLE PRECISION array, dimension (M)
 198:              // *
 199:              // *  INFO    (output) INTEGER
 200:              // *          = 0: successful exit
 201:              // *          < 0: if INFO = -i, the i-th argument has an illegal value
 202:              // *
 203:              // *  =====================================================================
 204:              // *
 205:              // *     .. Parameters ..
 206:              // *     ..
 207:              // *     .. Local Scalars ..
 208:              // *     ..
 209:              // *     .. External Subroutines ..
 210:              // *     ..
 211:              // *     .. Intrinsic Functions ..
 212:              //      INTRINSIC          MAX;
 213:              // *     ..
 214:              // *     .. Executable Statements ..
 215:              // *
 216:              // *     Test the input arguments
 217:              // *
 218:   
 219:              #endregion
 220:   
 221:   
 222:              #region Body
 223:              
 224:              INFO = 0;
 225:              if (M < 0)
 226:              {
 227:                  INFO =  - 1;
 228:              }
 229:              else
 230:              {
 231:                  if (N < M)
 232:                  {
 233:                      INFO =  - 2;
 234:                  }
 235:                  else
 236:                  {
 237:                      if (K < 0 || K > M)
 238:                      {
 239:                          INFO =  - 3;
 240:                      }
 241:                      else
 242:                      {
 243:                          if (LDA < Math.Max(1, M))
 244:                          {
 245:                              INFO =  - 5;
 246:                          }
 247:                      }
 248:                  }
 249:              }
 250:              if (INFO != 0)
 251:              {
 252:                  this._xerbla.Run("DORGL2",  - INFO);
 253:                  return;
 254:              }
 255:              // *
 256:              // *     Quick return if possible
 257:              // *
 258:              if (M <= 0) return;
 259:              // *
 260:              if (K < M)
 261:              {
 262:                  // *
 263:                  // *        Initialise rows k+1:m to rows of the unit matrix
 264:                  // *
 265:                  for (J = 1; J <= N; J++)
 266:                  {
 267:                      for (L = K + 1; L <= M; L++)
 268:                      {
 269:                          A[L+J * LDA + o_a] = ZERO;
 270:                      }
 271:                      if (J > K && J <= M) A[J+J * LDA + o_a] = ONE;
 272:                  }
 273:              }
 274:              // *
 275:              for (I = K; I >= 1; I +=  - 1)
 276:              {
 277:                  // *
 278:                  // *        Apply H(i) to A(i:m,i:n) from the right
 279:                  // *
 280:                  if (I < N)
 281:                  {
 282:                      if (I < M)
 283:                      {
 284:                          A[I+I * LDA + o_a] = ONE;
 285:                          this._dlarf.Run("Right", M - I, N - I + 1, A, I+I * LDA + o_a, LDA, TAU[I + o_tau]
 286:                                          , ref A, I + 1+I * LDA + o_a, LDA, ref WORK, offset_work);
 287:                      }
 288:                      this._dscal.Run(N - I,  - TAU[I + o_tau], ref A, I+(I + 1) * LDA + o_a, LDA);
 289:                  }
 290:                  A[I+I * LDA + o_a] = ONE - TAU[I + o_tau];
 291:                  // *
 292:                  // *        Set A(i,1:i-1) to zero
 293:                  // *
 294:                  for (L = 1; L <= I - 1; L++)
 295:                  {
 296:                      A[I+L * LDA + o_a] = ZERO;
 297:                  }
 298:              }
 299:              return;
 300:              // *
 301:              // *     End of DORGL2
 302:              // *
 303:   
 304:              #endregion
 305:   
 306:          }
 307:      }
 308:  }