/* nag_dorgqr (f08afc) Example Program.

 *

 * Copyright 2001 Numerical Algorithms Group.

 *

 * Mark 7, 2001.

 */



#include <stdio.h>

#include <string.h>

#include <nag.h>

#include <nag_stdlib.h>

#include <nagf08.h>

#include <nagx04.h>



int main(void)

{

  /* Scalars */

  Integer  i, j, m, n, pda, tau_len;

  Integer  exit_status=0;

  NagError fail;

  Nag_OrderType order;

  /* Arrays */

  char   *title=0;

  double *a=0, *tau=0;



#ifdef NAG_COLUMN_MAJOR

#define A(I,J) a[(J-1)*pda + I - 1]

  order = Nag_ColMajor;

#else

#define A(I,J) a[(I-1)*pda + J - 1]

  order = Nag_RowMajor;

#endif



  INIT_FAIL(fail);

  Vprintf("nag_dorgqr (f08afc) Example Program Results\n\n");



  /* Skip heading in data file */

  Vscanf("%*[^\n] ");

  Vscanf("%ld%ld%*[^\n] ", &m, &n);

#ifdef NAG_COLUMN_MAJOR

  pda = m;

#else

  pda = n;

#endif

  tau_len = MIN(m, n);



  /* Allocate memory */

  if ( !(title = NAG_ALLOC(31, char)) ||

       !(a = NAG_ALLOC(m * n, double)) ||

       !(tau = NAG_ALLOC(tau_len, double)) )

    {

      Vprintf("Allocation failure\n");

      exit_status = -1;

      goto END;

    }



  /* Read A from data file */

  for (i = 1; i <= m; ++i)

    {

      for (j = 1; j <= n; ++j)

        Vscanf("%lf", &A(i,j));

    }

  Vscanf("%*[^\n] ");



  /* Compute the QR factorization of A */

  /* nag_dgeqrf (f08aec).

   * QR factorization of real general rectangular matrix

   */

  nag_dgeqrf(order, m, n, a, pda, tau, &fail);

  if (fail.code != NE_NOERROR)

    {

      Vprintf("Error from nag_dgeqrf (f08aec).\n%s\n", fail.message);

      exit_status = 1;

      goto END;

    }

  /* Form the leading N columns of Q explicitly */

  /* nag_dorgqr (f08afc).

   * Form all or part of orthogonal Q from QR factorization

   * determined by nag_dgeqrf (f08aec) or nag_dgeqpf (f08bec)

   */

  nag_dorgqr(order, m, n, n, a, pda, tau, &fail);

  if (fail.code != NE_NOERROR)

    {

      Vprintf("Error from nag_dorgqr (f08afc).\n%s\n", fail.message);

      exit_status = 1;

      goto END;

    }

  /* Print the leading N columns of Q only */

  Vsprintf(title, "The leading %2ld columns of Q\n", n);

  /* nag_gen_real_mat_print (x04cac).

   * Print real general matrix (easy-to-use)

   */

  nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, m, n, a,

                         pda, title, 0, &fail);

  if (fail.code != NE_NOERROR)

    {

      Vprintf("Error from nag_gen_real_mat_print (x04cac).\n%s\n",

              fail.message);

      exit_status = 1;

      goto END;

    }



 END:

  if (title) NAG_FREE(title);

  if (a) NAG_FREE(a);

  if (tau) NAG_FREE(tau);



  return exit_status;

}