/usr/src/RPM/BUILD/trilinos10-10.6.4/packages/intrepid/test/Discretization/Basis/HGRAD_LINE_C1_FEM/test_02.cpp

// @HEADER
// ************************************************************************
//
//                           Intrepid Package
//                 Copyright (2007) Sandia Corporation
//
// Under terms of Contract DE-AC04-94AL85000, there is a non-exclusive
// license for use of this work by or on behalf of the U.S. Government.
//
// This library is free software; you can redistribute it and/or modify
// it under the terms of the GNU Lesser General Public License as
// published by the Free Software Foundation; either version 2.1 of the
// License, or (at your option) any later version.
//
// This library is distributed in the hope that it will be useful, but
// WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
// Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
// USA
// Questions? Contact Pavel Bochev  (pbboche@sandia.gov), 
//                    Denis Ridzal  (dridzal@sandia.gov),
//                    Kara Peterson (kjpeter@sandia.gov).
//
// ************************************************************************
// @HEADER

#include "Intrepid_FieldContainer.hpp"
#include "Intrepid_HGRAD_LINE_C1_FEM.hpp"
#include "Intrepid_DefaultCubatureFactory.hpp"
#include "Intrepid_RealSpaceTools.hpp"
#include "Intrepid_ArrayTools.hpp"
#include "Intrepid_FunctionSpaceTools.hpp"
#include "Intrepid_CellTools.hpp"
#include "Teuchos_oblackholestream.hpp"
#include "Teuchos_RCP.hpp"
#include "Teuchos_GlobalMPISession.hpp"
#include "Teuchos_SerialDenseMatrix.hpp"
#include "Teuchos_SerialDenseVector.hpp"
#include "Teuchos_LAPACK.hpp"

using namespace std;
using namespace Intrepid;

void rhsFunc(FieldContainer<double> &, const FieldContainer<double> &, int);
void neumann(FieldContainer<double> &, const FieldContainer<double> &, const FieldContainer<double> &, int);
void u_exact(FieldContainer<double> &, const FieldContainer<double> &, int);

void rhsFunc(FieldContainer<double> & result, const FieldContainer<double> & points, int degree) {
  if (degree == 0) {
    for (int cell=0; cell<result.dimension(0); cell++) {
      for (int pt=0; pt<result.dimension(1); pt++) {
        result(cell,pt) = 1.0;
      }
    }
  }
  else if (degree == 1) {
    for (int cell=0; cell<result.dimension(0); cell++) {
      for (int pt=0; pt<result.dimension(1); pt++) {
        result(cell,pt) = points(cell,pt,0);
      }
    }
  }
  else {
    for (int cell=0; cell<result.dimension(0); cell++) {
      for (int pt=0; pt<result.dimension(1); pt++) {
        result(cell,pt) = pow(points(cell,pt,0), degree) - degree*(degree-1)*pow(points(cell,pt,0), degree-2);
      }
    }
  }
}

void neumann(FieldContainer<double> & g_phi, const FieldContainer<double> & phi1, const FieldContainer<double> & phi2, int degree) {
  double g_at_one, g_at_minus_one;
  int num_fields;

  if (degree == 0) {
    g_at_one = 0.0;
    g_at_minus_one = 0.0;
  }
  else {
    g_at_one = degree*pow(1.0, degree-1);
    g_at_minus_one = degree*pow(-1.0, degree-1);
  }

  num_fields = phi1.dimension(0);

  for (int i=0; i<num_fields; i++) {
    g_phi(0,i) = g_at_minus_one*phi1(i,0);
    g_phi(1,i) = g_at_one*phi2(i,0);
  }
}

void u_exact(FieldContainer<double> & result, const FieldContainer<double> & points, int degree) {
  for (int cell=0; cell<result.dimension(0); cell++) {
    for (int pt=0; pt<result.dimension(1); pt++) {
      result(cell,pt) = pow(points(pt,0), degree);
    }
  }
}




int main(int argc, char *argv[]) {

  Teuchos::GlobalMPISession mpiSession(&argc, &argv);

  // This little trick lets us print to std::cout only if
  // a (dummy) command-line argument is provided.
  int iprint     = argc - 1;
  Teuchos::RCP<std::ostream> outStream;
  Teuchos::oblackholestream bhs; // outputs nothing
  if (iprint > 0)
    outStream = Teuchos::rcp(&std::cout, false);
  else
    outStream = Teuchos::rcp(&bhs, false);

  // Save the format state of the original std::cout.
  Teuchos::oblackholestream oldFormatState;
  oldFormatState.copyfmt(std::cout);

  *outStream \
    << "===============================================================================\n" \
    << "|                                                                             |\n" \
    << "|               Unit Test (Basis_HGRAD_LINE_C1_FEM)                           |\n" \
    << "|                                                                             |\n" \
    << "|     1) Patch test involving mass and stiffness matrices,                    |\n" \
    << "|        for the Neumann problem on a REFERENCE line:                         |\n" \
    << "|                                                                             |\n" \
    << "|            - u'' + u = f  in (-1,1),  u' = g at -1,1                        |\n" \
    << "|                                                                             |\n" \
    << "|  Questions? Contact  Pavel Bochev  (pbboche@sandia.gov),                    |\n" \
    << "|                      Denis Ridzal  (dridzal@sandia.gov),                    |\n" \
    << "|                      Kara Peterson (kjpeter@sandia.gov).                    |\n" \
    << "|                                                                             |\n" \
    << "|  Intrepid's website: http://trilinos.sandia.gov/packages/intrepid           |\n" \
    << "|  Trilinos website:   http://trilinos.sandia.gov                             |\n" \
    << "|                                                                             |\n" \
    << "===============================================================================\n"\
    << "| TEST 1: Patch test                                                          |\n"\
    << "===============================================================================\n";

  
  int errorFlag = 0;
  double zero = 100*INTREPID_TOL;
  outStream -> precision(20);


  try {

    int max_order = 1;  // max total order of polynomial solution

    // Define array containing points at which the solution is evaluated
    int numIntervals = 100;
    int numInterpPoints = numIntervals + 1;
    FieldContainer<double> interp_points(numInterpPoints, 1);
    for (int i=0; i<numInterpPoints; i++) {
      interp_points(i,0) = -1.0+(2.0*(double)i)/(double)numIntervals;
    }
    
    DefaultCubatureFactory<double>  cubFactory;                                   // create factory
    shards::CellTopology line(shards::getCellTopologyData< shards::Line<> >());   // create cell topology

    //create basis
    Teuchos::RCP<Basis<double,FieldContainer<double> > > lineBasis =
      Teuchos::rcp(new Basis_HGRAD_LINE_C1_FEM<double,FieldContainer<double> >() );
    int numFields = lineBasis->getCardinality();
    int basis_order = lineBasis->getDegree();

    // create cubature
    Teuchos::RCP<Cubature<double> > lineCub = cubFactory.create(line, 2);
    int numCubPoints = lineCub->getNumPoints();
    int spaceDim = lineCub->getDimension();

    for (int soln_order=0; soln_order <= max_order; soln_order++) {

      // evaluate exact solution
      FieldContainer<double> exact_solution(1, numInterpPoints);
      u_exact(exact_solution, interp_points, soln_order);

      /* Computational arrays. */
      FieldContainer<double> cub_points(numCubPoints, spaceDim);
      FieldContainer<double> cub_points_physical(1, numCubPoints, spaceDim);
      FieldContainer<double> cub_weights(numCubPoints);
      FieldContainer<double> cell_nodes(1, 2, spaceDim);
      FieldContainer<double> jacobian(1, numCubPoints, spaceDim, spaceDim);
      FieldContainer<double> jacobian_inv(1, numCubPoints, spaceDim, spaceDim);
      FieldContainer<double> jacobian_det(1, numCubPoints);
      FieldContainer<double> weighted_measure(1, numCubPoints);

      FieldContainer<double> value_of_basis_at_cub_points(numFields, numCubPoints);
      FieldContainer<double> transformed_value_of_basis_at_cub_points(1, numFields, numCubPoints);
      FieldContainer<double> weighted_transformed_value_of_basis_at_cub_points(1, numFields, numCubPoints);
      FieldContainer<double> grad_of_basis_at_cub_points(numFields, numCubPoints, spaceDim);
      FieldContainer<double> transformed_grad_of_basis_at_cub_points(1, numFields, numCubPoints, spaceDim);
      FieldContainer<double> weighted_transformed_grad_of_basis_at_cub_points(1, numFields, numCubPoints, spaceDim);
      FieldContainer<double> fe_matrix(1, numFields, numFields);

      FieldContainer<double> rhs_at_cub_points_physical(1, numCubPoints);
      FieldContainer<double> rhs_and_soln_vector(1, numFields);

      FieldContainer<double> one_point(1, 1);
      FieldContainer<double> value_of_basis_at_one(numFields, 1);
      FieldContainer<double> value_of_basis_at_minusone(numFields, 1);
      FieldContainer<double> bc_neumann(2, numFields);

      FieldContainer<double> value_of_basis_at_interp_points(numFields, numInterpPoints);
      FieldContainer<double> transformed_value_of_basis_at_interp_points(1, numFields, numInterpPoints);
      FieldContainer<double> interpolant(1, numInterpPoints);

      FieldContainer<int> ipiv(numFields);

      /******************* START COMPUTATION ***********************/

      // get cubature points and weights
      lineCub->getCubature(cub_points, cub_weights);

      // fill cell vertex array
      cell_nodes(0, 0, 0) = -1.0;
      cell_nodes(0, 1, 0) = 1.0;

      // compute geometric cell information
      CellTools<double>::setJacobian(jacobian, cub_points, cell_nodes, line);
      CellTools<double>::setJacobianInv(jacobian_inv, jacobian);
      CellTools<double>::setJacobianDet(jacobian_det, jacobian);

      // compute weighted measure
      FunctionSpaceTools::computeCellMeasure<double>(weighted_measure, jacobian_det, cub_weights);

      // Computing mass matrices:
      // tabulate values of basis functions at (reference) cubature points
      lineBasis->getValues(value_of_basis_at_cub_points, cub_points, OPERATOR_VALUE);

      // transform values of basis functions
      FunctionSpaceTools::HGRADtransformVALUE<double>(transformed_value_of_basis_at_cub_points,
                                                      value_of_basis_at_cub_points);

      // multiply with weighted measure
      FunctionSpaceTools::multiplyMeasure<double>(weighted_transformed_value_of_basis_at_cub_points,
                                                  weighted_measure,
                                                  transformed_value_of_basis_at_cub_points);

      // compute mass matrices
      FunctionSpaceTools::integrate<double>(fe_matrix,
                                            transformed_value_of_basis_at_cub_points,
                                            weighted_transformed_value_of_basis_at_cub_points,
                                            COMP_CPP);

      // Computing stiffness matrices:
      // tabulate gradients of basis functions at (reference) cubature points
      lineBasis->getValues(grad_of_basis_at_cub_points, cub_points, OPERATOR_GRAD);

      // transform gradients of basis functions
      FunctionSpaceTools::HGRADtransformGRAD<double>(transformed_grad_of_basis_at_cub_points,
                                                     jacobian_inv,
                                                     grad_of_basis_at_cub_points);

      // multiply with weighted measure
      FunctionSpaceTools::multiplyMeasure<double>(weighted_transformed_grad_of_basis_at_cub_points,
                                                  weighted_measure,
                                                  transformed_grad_of_basis_at_cub_points);

      // compute stiffness matrices and sum into fe_matrix
      FunctionSpaceTools::integrate<double>(fe_matrix,
                                            transformed_grad_of_basis_at_cub_points,
                                            weighted_transformed_grad_of_basis_at_cub_points,
                                            COMP_CPP,
                                            true);

      // Computing RHS contributions:
      // map (reference) cubature points to physical space
      CellTools<double>::mapToPhysicalFrame(cub_points_physical, cub_points, cell_nodes, line);

      // evaluate rhs function
      rhsFunc(rhs_at_cub_points_physical, cub_points_physical, soln_order);

      // compute rhs
      FunctionSpaceTools::integrate<double>(rhs_and_soln_vector,
                                            rhs_at_cub_points_physical,
                                            weighted_transformed_value_of_basis_at_cub_points,
                                            COMP_CPP);

      // compute neumann b.c. contributions and adjust rhs
      one_point(0,0) = 1.0;   lineBasis->getValues(value_of_basis_at_one, one_point, OPERATOR_VALUE);
      one_point(0,0) = -1.0;  lineBasis->getValues(value_of_basis_at_minusone, one_point, OPERATOR_VALUE);
      neumann(bc_neumann, value_of_basis_at_minusone, value_of_basis_at_one, soln_order);
      for (int i=0; i<numFields; i++) {
        rhs_and_soln_vector(0, i) -= bc_neumann(0, i);
        rhs_and_soln_vector(0, i) += bc_neumann(1, i);
      }

      // Solution of linear system:
      int info = 0;
      Teuchos::LAPACK<int, double> solver;
      //solver.GESV(numRows, 1, &fe_mat(0,0), numRows, &ipiv(0), &fe_vec(0), numRows, &info);
      solver.GESV(numFields, 1, &fe_matrix[0], numFields, &ipiv(0), &rhs_and_soln_vector[0], numFields, &info);

      // Building interpolant:
      // evaluate basis at interpolation points
      lineBasis->getValues(value_of_basis_at_interp_points, interp_points, OPERATOR_VALUE);
      // transform values of basis functions
      FunctionSpaceTools::HGRADtransformVALUE<double>(transformed_value_of_basis_at_interp_points,
                                                      value_of_basis_at_interp_points);
      FunctionSpaceTools::evaluate<double>(interpolant, rhs_and_soln_vector, transformed_value_of_basis_at_interp_points);

      /******************* END COMPUTATION ***********************/
    
      RealSpaceTools<double>::subtract(interpolant, exact_solution);

      *outStream << "\nNorm-2 difference between exact solution polynomial of order "
                 << soln_order << " and finite element interpolant of order " << basis_order << ": "
                 << RealSpaceTools<double>::vectorNorm(&interpolant[0], interpolant.dimension(1), NORM_TWO) << "\n";

      if (RealSpaceTools<double>::vectorNorm(&interpolant[0], interpolant.dimension(1), NORM_TWO) > zero) {
        *outStream << "\n\nPatch test failed for solution polynomial order "
                   << soln_order << " and basis order " << basis_order << "\n\n";
        errorFlag++;
      }

    } // end for soln_order

  }
  // Catch unexpected errors
  catch (std::logic_error err) {
    *outStream << err.what() << "\n\n";
    errorFlag = -1000;
  };

  if (errorFlag != 0)
    std::cout << "End Result: TEST FAILED\n";
  else
    std::cout << "End Result: TEST PASSED\n";

  // reset format state of std::cout
  std::cout.copyfmt(oldFormatState);

  return errorFlag;
}