/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/* file:     slip_bound.c                                                   */
/*                                                                          */
/*                                                                          */
/* description: Routines to handle slip boundary conditions                 */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  authors:   Daniel Koester                                               */
/*             Institut fuer Mathematik                                     */
/*             Universitaet Augsburg                                        */
/*             Universitaetsstr. 14                                         */
/*             D-86159 Augsburg, Germany                                    */
/*                                                                          */
/*  http://www.alberta-fem.de                                               */
/*                                                                          */
/*--------------------------------------------------------------------------*/

#include "nst.h"

/****************************************************************************/
/* Implementation of slip boundary conditions of the form                   */
/*                                                                          */
/* u \cdot \nu = 0 (or anything fixed for inflow/outflow boundary...)       */
/*                                                                          */
/* where u is a vector-valued unknown and \nu is the local outer unit       */
/* normal, or a discrete approximation.                                     */
/*                                                                          */
/* The general idea is to incorporate these b.c. in the system matrix as    */
/* it is done with standard Dirichlet type b.c. Thus, no manipulation needs */
/* to be done on vectors during matrix-vector multiplication.               */
/*                                                                          */
/* If the domain boundaries are parallel to coordinate axes, the following  */
/* transformation on the system matrix can be done: Let i represent a       */
/* slip boundary DOF and A_ii \in \R^{n \times n} be a local block of the   */
/* system matrix. Assume that n=3 and \nu_i = (1,0,0)^T                     */
/*                                                                          */
/*        | a_11 a_12 a_13 |                        |  0    0    0   |      */
/* A_ij = | a_21 a_22 a_23 |   --->   A^\tilde_ij = | a_21 a_22 a_23 |      */
/*        | a_31 a_32 a_33 |                        | a_31 a_32 a_33 |      */
/*                                                                          */
/* Vectors (typically unknown and right hand side of the problem) can be    */
/* changed as follows:                                                      */
/*                                                                          */
/*       | u_1 |                     |  0  |                                */
/* U_i = | u_2 |   ---> U^\tilde_i = | u_2 |                                */
/*       | u_3 |                     | u_3 |                                */
/*                                                                          */
/* for u \cdot \nu = 0.                                                     */
/*                                                                          */
/* This can be generalized to the case of non-parallel slip walls. In this  */
/* case, we need a local projection operator P in the direction of \nu. It  */
/* can be defined as P_ik = Id_3 - \nu \otimes \nu, where \otimes denotes    */
/* a tensor product. We then have                                           */
/*                                                                          */
/* A^\tilde_ij = P_ik A_kj   and   U^\tilde_i = P_ij U_j                    */
/*                                                                          */
/* Unfortunately, this approach fails due to rounding errors, since we      */
/* cannot guarantee a residual of EXACTLY 0.0 in the direction of \nu.      */
/*                                                                          */
/* The solution implemented here is to transform matrices and vectors using */
/* a Householder transformation so that b.c. can be applied as in the       */
/* parallel wall case. This produces residuals which are exactly 0.0.       */
/*                                                                          */
/* The Householder matrix S applied is                                      */
/*                                                                          */
/*            | \nu_1 +- 1 |  (sign chosen to avoid loss of precision)      */
/* a^\tilde = | \nu_2      |                                                */
/*            | \nu_3      |                                                */
/*                                                                          */
/* a = a^\tilde / |a^\tilde|                                                */
/*                                                                          */
/* S = Id_n - 2.0 a \otimes a                                               */
/*                                                                          */
/****************************************************************************/

/****************************************************************************/
/* sb_get_status_dof_real_d_vec(drdv) get the transformation status of a    */
/* DOF_REAL_D_VEC drdv. The private pointer drdv->mem_info is used for this */
/* purpose.                                                                 */
/****************************************************************************/

SB_STATUS sb_get_status_dof_real_d_vec(const DOF_REAL_D_VEC *drdv)
{
  FUNCNAME("sb_get_status_dof_real_d_vec");
  SLIP_BOUND_HANDLER *sbh = (SLIP_BOUND_HANDLER *)drdv->mem_info;

  if(!sbh)
    return SB_UNDEFINED;
  else {
    if(sbh->status == SB_UNDEFINED)
      return SB_UNDEFINED;
    else if (sbh->status == SB_NORMAL)
      return SB_NORMAL;
    else if (sbh->status == SB_TRANSFORMED)
      return SB_TRANSFORMED;
    else
      ERROR_EXIT("Error while getting SB_STATUS!\n");
  }

  return 0;
}


/****************************************************************************/
/* sb_get_status_dof_dowb_matrix(ddm) same thing for DOF_DOWB_MATRICES.     */
/****************************************************************************/

SB_STATUS sb_get_status_dof_dowb_matrix(const DOF_DOWB_MATRIX *ddm)
{
  FUNCNAME("sb_get_status_dof_real_vec");
  SLIP_BOUND_HANDLER *sbh = (SLIP_BOUND_HANDLER *)ddm->mem_info;

  if(!sbh)
    return SB_UNDEFINED;
  else {
    if(sbh->status == SB_UNDEFINED)
      return SB_UNDEFINED;
    else if (sbh->status == SB_NORMAL)
      return SB_NORMAL;
    else if (sbh->status == SB_TRANSFORMED)
      return SB_TRANSFORMED;
    else
      ERROR_EXIT("Error while getting SB_STATUS!\n");
  }

  return 0;
}


/****************************************************************************/
/* sb_set_status_dof_real_d_vec(drdv, status): Set the status for vectors.  */
/****************************************************************************/

void sb_set_status_dof_real_d_vec(DOF_REAL_D_VEC *drdv, SB_STATUS status)
{
  FUNCNAME("sb_set_status_dof_real_d_vec");
  SLIP_BOUND_HANDLER *sbh = (SLIP_BOUND_HANDLER *)drdv->mem_info;

  if(!sbh) {
    sbh = MEM_ALLOC(1, SLIP_BOUND_HANDLER);
    drdv->mem_info = (void *)sbh;
  }

  TEST_EXIT((status == SB_UNDEFINED) || (status == SB_NORMAL) || 
	    (status == SB_TRANSFORMED), "Illegal SB_STATUS!\n");

  sbh->status = status;

  return;
}


/****************************************************************************/
/* sb_set_status_dof_dowb_matrix(ddm, status): Same thing for matrices.     */
/****************************************************************************/

void sb_set_status_dof_dowb_matrix(DOF_DOWB_MATRIX *ddm, SB_STATUS status)
{
  FUNCNAME("sb_set_status_dof_dowb_matrix");
  SLIP_BOUND_HANDLER *sbh = (SLIP_BOUND_HANDLER *)ddm->mem_info;

  if(!sbh) {
    sbh = MEM_ALLOC(1, SLIP_BOUND_HANDLER);
    ddm->mem_info = (void *)sbh;
  }

  TEST_EXIT((status == SB_UNDEFINED) || (status == SB_NORMAL) || 
	    (status == SB_TRANSFORMED), "Illegal SB_STATUS!\n");

  sbh->status = status;

  return;
}


/****************************************************************************/
/* sb_unset_status_dof_real_d_vec(drdv): Unset the status for vectors.      */
/****************************************************************************/

void sb_unset_status_dof_real_d_vec(DOF_REAL_D_VEC *drdv)
{
  FUNCNAME("sb_unset_status_dof_real_d_vec");
  SLIP_BOUND_HANDLER *sbh = (SLIP_BOUND_HANDLER *)drdv->mem_info;

  if(sbh) {
    SB_STATUS           status = sbh->status;

    TEST_EXIT((status == SB_UNDEFINED) || (status == SB_NORMAL) || 
	      (status == SB_TRANSFORMED), "Illegal SB_STATUS!\n");

    MEM_FREE(sbh, 1, SLIP_BOUND_HANDLER);
    drdv->mem_info = NULL;
  }

  return;
}


/****************************************************************************/
/* sb_unset_status_dof_dowb_matrix(ddm): Same thing for matrices.           */
/****************************************************************************/

void sb_unset_status_dof_dowb_matrix(DOF_DOWB_MATRIX *ddm)
{
  FUNCNAME("sb_unset_status_dof_dowb_matrix");
  SLIP_BOUND_HANDLER *sbh = (SLIP_BOUND_HANDLER *)ddm->mem_info;

  if(sbh) {
    SB_STATUS           status = sbh->status;
    
    TEST_EXIT((status == SB_UNDEFINED) || (status == SB_NORMAL) || 
	      (status == SB_TRANSFORMED), "Illegal SB_STATUS!\n");

    MEM_FREE(sbh, 1, SLIP_BOUND_HANDLER);
    ddm->mem_info = NULL;
  }

  return;
}


/****************************************************************************/
/* sb_transform_dof_real_d_vec(drdv1, drdv2, normal, bound, current_status):*/
/* transform up to two vectors using the outer unit normal vector "normal", */
/* and the boundary vector "bound". FE_SPACEs must match in all vectors.    */
/*                                                                          */
/* The parameter "current_status" is used to check if the vectors are passed*/
/* in an incorrect state by mistake. It must match the private setting      */
/* obtained by sb_get_status_dof_real_d_vec().                              */
/****************************************************************************/

void sb_transform_dof_real_d_vec(DOF_REAL_D_VEC *drdv1, DOF_REAL_D_VEC *drdv2,
				 const DOF_REAL_D_VEC *normal, 
				 const DOF_SCHAR_VEC *bound,
				 SB_STATUS current_status)
{
  FUNCNAME("sb_transform_dof_real_d_vec");
  SB_STATUS       status;
  const FE_SPACE *fe_space;
  REAL_D          a;
  REAL            scp1, scp2;

  TEST_EXIT(drdv1||drdv2, "No DOF_REAL_D_VEC supplied!\n");
  TEST_EXIT(normal, "No outer unit normal vector supplied!\n");
  TEST_EXIT(bound, "No boundary vector supplied!\n");

  if(!drdv1) {
    drdv1 = drdv2;
    drdv2 = NULL;
  }
  
  fe_space = drdv1->fe_space;
  TEST_EXIT(fe_space, "DOF_REAL_D_VEC is lacking an fe_space!\n");
  TEST_EXIT((fe_space == normal->fe_space) && (fe_space == bound->fe_space),
	    "FE_SPACEs in vectors do not match!\n");
  if(drdv2) {
    TEST_EXIT(fe_space == drdv2->fe_space,
	      "FE_SPACEs in vectors do not match!\n");
  }

  if(current_status == SB_UNDEFINED)
    current_status = SB_NORMAL;
  TEST_EXIT((current_status == SB_NORMAL)||(current_status ==SB_TRANSFORMED),
	    "Bogus current status given!\n");
  
  status = sb_get_status_dof_real_d_vec(drdv1);
  TEST_EXIT((current_status == status) || (status == SB_UNDEFINED),
	    "Vector 1 seems to be in wrong state!\n");
  if(drdv2) {
    status = sb_get_status_dof_real_d_vec(drdv2);
    TEST_EXIT((current_status == status) || (status == SB_UNDEFINED),
	      "Vector 2 seems to be in wrong state!\n");
  }

  FOR_ALL_DOFS(fe_space->admin,
	       if(bound->vec[dof] == SLIP) {
		 COPY_DOW(normal->vec[dof], a);

		 if(a[0] >= 0.0)
		   a[0] += 1.0;
		 else
		   a[0] -= 1.0;
		 AX_DOW(1.0 / NORM_DOW(a), a);

		 scp1 = SCP_DOW(drdv1->vec[dof], a);
		 AXPY_DOW(-2.0 * scp1, a, drdv1->vec[dof]);

		 if(drdv2) {
		   scp2 = SCP_DOW(drdv2->vec[dof], a);
		   AXPY_DOW(-2.0 * scp2, a, drdv2->vec[dof]);
		 }
	       });
	       
  if(current_status == SB_NORMAL) {
    sb_set_status_dof_real_d_vec(drdv1, SB_TRANSFORMED);
    if(drdv2)
      sb_set_status_dof_real_d_vec(drdv2, SB_TRANSFORMED);
  }
  else {
    sb_set_status_dof_real_d_vec(drdv1, SB_NORMAL);
    if(drdv2)
      sb_set_status_dof_real_d_vec(drdv2, SB_NORMAL);
  }

  return;
}


/****************************************************************************/
/* sb_transform_dof_dowb_matrix(ddm, normal, bound, current_status):        */
/* transform a system matrix using the outer unit normal vector "normal",   */
/* and the boundary vector "bound". FE_SPACEs must match as above.          */
/*                                                                          */
/* The parameter "current_status" is used as a consistency check as above.  */
/*                                                                          */
/* Two types of DOF_DOWB_MATRIXes are supported at the moment: dowbm_full   */
/* and dowbm_diag, the latter being used to store a matrix operating from   */
/* a scalar FE space to a vector valued space (e.g. discrete gradient       */
/* operators for a Stokes problem).                                         */
/****************************************************************************/

void sb_transform_dof_dowb_matrix(DOF_DOWB_MATRIX *ddm,
				  const DOF_REAL_D_VEC *normal, 
				  const DOF_SCHAR_VEC *bound,
				  SB_STATUS current_status)
{
  FUNCNAME("sb_transform_dof_dowb_matrix");
  SB_STATUS        status;
  const FE_SPACE  *fe_space;
  DOWB_MATRIX_ROW *row = NULL;
  REAL_DD         *s_vector, tmp_dd, *entry_dd;
  DOF              jcol;
  REAL_D           a, *entry_d, tmp_d;
  int              j, k, l, m;
  DOWBM_TYPE       type;

  TEST_EXIT(ddm, "No DOF_DOWB_MATRIX supplied!\n");
  type = ddm->type;
  TEST_EXIT(type == dowbm_full, 
	    "DOF_DOWB_MATRIX must be of type dowbm_full!\n");

  TEST_EXIT(normal, "No outer unit normal vector supplied!\n");
  TEST_EXIT(bound, "No boundary vector supplied!\n");
  TEST_EXIT((current_status == SB_NORMAL) || (current_status ==SB_TRANSFORMED),
	    "Bogus current status given!\n");
  
  fe_space = ddm->fe_space;
  TEST_EXIT(fe_space, "DOF_DOWB_MATRIX is lacking an fe_space!\n");
  TEST_EXIT((fe_space == normal->fe_space) && (fe_space == bound->fe_space),
	    "FE_SPACEs in vectors do not match!\n");

  status = sb_get_status_dof_dowb_matrix(ddm);
  TEST_EXIT((current_status == status) || (status == SB_UNDEFINED),
	    "Bogus status of matrix!\n");

  s_vector = MEM_ALLOC(fe_space->admin->size_used, REAL_DD);

  FOR_ALL_DOFS(fe_space->admin,
	       if(bound->vec[dof] == SLIP) {
		 COPY_DOW(normal->vec[dof], a);
		 
		 if(a[0] >= 0.0)
		   a[0] += 1.0;
		 else
		   a[0] -= 1.0;
		 AX_DOW(1.0 / NORM_DOW(a), a);
		 
		 for(k = 0; k < DIM_OF_WORLD; k++) 
		   for(l = 0; l < DIM_OF_WORLD; l++) {
		     if(k == l)
		       s_vector[dof][k][k] = 1.0;
		     else
		       s_vector[dof][k][l] = 0.0;
		     s_vector[dof][k][l] -= 2.0 * a[k]*a[l];
		   }
	       }
	       );

  FOR_ALL_DOFS(fe_space->admin,
	       for (row = ddm->matrix_row[dof]; row; row = row->next)
	       for (j=0; j<ROW_LENGTH; j++) {
		 jcol = row->col[j];
		 
		 if (ENTRY_USED(jcol)) {
		   entry_dd = row->entry.full;

		   if(bound->vec[dof] == SLIP) {		   
		     MM_DOW(s_vector[dof], entry_dd[j], tmp_dd);
		     MCOPY_DOW(tmp_dd, entry_dd[j]);
		   }
		   if(bound->vec[jcol] == SLIP) {
		     MM_DOW(entry_dd[j], s_vector[jcol], tmp_dd);
		     MCOPY_DOW(tmp_dd, entry_dd[j]);
		   }
		 }
		 else if (jcol == NO_MORE_ENTRIES)
		   break;
	       }
	       );
  
  if(current_status == SB_NORMAL)
    sb_set_status_dof_dowb_matrix(ddm, SB_TRANSFORMED);
  else
    sb_set_status_dof_dowb_matrix(ddm, SB_NORMAL);
  
  return;
}


/****************************************************************************/
/* sb_slip_bound(ddm, drdv1, drdv2, bound):                                 */
/* Set boundary conditions in the matrix "ddm" and one or both vectors.     */
/* Please note that the system matrix acts as the identity on the slip bound*/
/* DOF in the x[0]-direction. This behaviour could be changed, but then     */
/* a different treatment for unknown and right hand side vectors would be   */
/* necessary. The current behaviour is analogous to Dirichlet boundary      */
/* treatment in ALBERTA.                                                    */
/****************************************************************************/

void sb_slip_bound(DOF_DOWB_MATRIX *ddm, DOF_REAL_D_VEC *drdv1, 
		   DOF_REAL_D_VEC *drdv2, DOF_SCHAR_VEC *bound)
{
  FUNCNAME("sb_slip_bound");
  const FE_SPACE  *fe_space = NULL;
  DOWB_MATRIX_ROW *row = NULL;
  REAL_DD         *entry_dd;
  DOWBM_TYPE       type;
  REAL_D          *entry_d;
  DOF              jcol;
  int              j, k;

  if(ddm) {
    type = ddm->type;
    TEST_EXIT(type == dowbm_full || type == dowbm_diag, 
	      "DOF_DOWB_MATRIX must be of type dowbm_full or dowbm_diag!\n");
    TEST_EXIT(sb_get_status_dof_dowb_matrix(ddm) == SB_TRANSFORMED,
	      "Matrix does not seem to be transformed!\n");
    fe_space = ddm->fe_space;
  }
  if(drdv1) {
    TEST_EXIT(sb_get_status_dof_real_d_vec(drdv1) == SB_TRANSFORMED,
	      "Vector 1 does not seem to be transformed!\n");

    if(fe_space)
      TEST_EXIT(fe_space == drdv1->fe_space,
		"FE_SPACEs do no match!\n");
    else
      fe_space = drdv1->fe_space;
  }
  if(drdv2) {
    TEST_EXIT(sb_get_status_dof_real_d_vec(drdv2) == SB_TRANSFORMED,
	      "Vector 2 does not seem to be transformed!\n");

    if(fe_space)
      TEST_EXIT(fe_space == drdv2->fe_space,
		"FE_SPACEs do no match!\n");
    else
      fe_space = drdv2->fe_space;
  }

  if(!ddm && !drdv1 && !drdv2)
    return;

  TEST_EXIT(bound, "No boundary vector given!\n");

  TEST_EXIT(fe_space == bound->fe_space,
	    "FE_SPACEs do not match!\n");

  TEST_EXIT(fe_space, "No FE_SPACEs found!\n");
 
  FOR_ALL_DOFS(fe_space->admin,
	       if(bound->vec[dof] == SLIP) {	       
		 if(ddm) {
		   for (row = ddm->matrix_row[dof]; row; row = row->next)
		     for (j = 0; j < ROW_LENGTH; j++) {
		       jcol = row->col[j];
		     
		       if (ENTRY_USED(jcol)) {
			 if(type == dowbm_diag) {
			   entry_d = row->entry.diag;

			   for(k = 0; k < DIM_OF_WORLD; k++)
			     entry_d[j][k] = 0.0;
			   if(jcol == dof)
			     entry_d[j][0] = 1.0;
			 }
			 else {
			   entry_dd = row->entry.full;

			   for (k = 0; k < DIM_OF_WORLD; k++)
			     entry_dd[j][0][k] = 0.0;
			   if(jcol == dof)
			     entry_dd[j][0][0] = 1.0;
			 }
		       }
		       else if (jcol == NO_MORE_ENTRIES)
			 break;
		     }
		 }
		 if(drdv1)
		   drdv1->vec[dof][0] = 0.0;
		 if(drdv2)
		   drdv2->vec[dof][0] = 0.0;
	       }
	       );

  return;
}
