/*
    Copyright (C) 1998  Dennis Roddeman
    email: dennis.roddeman@uibk.ac.at

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program 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 General Public License for more details.


    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software Foundation 
    59 Temple Place, Suite 330, Boston, MA, 02111-1307, USA
*/

#include "tochnog.h"

long int *node_nel;
double   *node_lhside;
double   *node_rhside;
double   *node_rhside_internal;
double   *node_rhside_static;
double   *node_dof_tmp;

void element_loop( void )
{
  long int swit=0, nthread=0, length=0, inod=0, max_node=0, 
    ithread=0, indx=0, idim=0, ipuknwn=0, iuknwn=0, ldum=0, 
    *node_nel_ptr=NULL;
  double ddum[1], *node_lhside_ptr=NULL, *node_rhside_ptr=NULL, 
    *node_rhside_internal_ptr=NULL, *node_rhside_static_ptr=NULL, 
    *node_dof_tmp_ptr=NULL, *node_dof_new_ptr=NULL;

  swit = set_swit(-1,-1,"element_loop");
  if ( swit ) pri( "In routine ELEMENT_LOOP" );

  db_max_index( NODE, max_node, VERSION_NORMAL, GET );
  db( OPTIONS_PROCESSORS, 0, &nthread, ddum, ldum, VERSION_NORMAL, GET );

  length = (1+max_node)*nthread;
  node_nel = get_new_int( length );
  array_set( node_nel, 0, length );

  length = (1+max_node)*npuknwn*nthread;
  node_lhside = get_new_dbl( length );
  array_set( node_lhside, 0., length );

  length = (1+max_node)*npuknwn*nthread;
  node_rhside = get_new_dbl( length );
  array_set( node_rhside, 0., length );

  length = (1+max_node)*npuknwn*nthread;
  node_rhside_internal = get_new_dbl( length );
  array_set( node_rhside_internal, 0., length );

  length = (1+max_node)*npuknwn*nthread;
  node_rhside_static = get_new_dbl( length );
  array_set( node_rhside_static, 0., length );

  length = (1+max_node)*nuknwn*nthread;
  node_dof_tmp = get_new_dbl( length );
  array_set( node_dof_tmp, 0., length );

  parallel_sys_routine( &parallel_element_loop );

  db_set_dbl( NODE_DOF_TMP, VERSION_NORMAL );
  db_set_int( NODE_NEL, VERSION_NORMAL );

    // merge results for different threads
  for ( inod=0; inod<=max_node; inod++ ) {
    if ( db_active_index( NODE, inod, VERSION_NORMAL ) ) {
      node_nel_ptr = db_int( NODE_NEL, inod, VERSION_NORMAL );
      node_lhside_ptr = db_dbl( NODE_LHSIDE, inod, VERSION_NORMAL );
      node_rhside_ptr = db_dbl( NODE_RHSIDE, inod, VERSION_NORMAL );
      node_rhside_internal_ptr = db_dbl( NODE_RHSIDE_INTERNAL, inod, VERSION_NORMAL );
      node_rhside_static_ptr = db_dbl( NODE_RHSIDE_STATIC, inod, VERSION_NORMAL );
      node_dof_new_ptr = db_dbl( NODE_DOF, inod, VERSION_NEW );
      node_dof_tmp_ptr = db_dbl( NODE_DOF_TMP, inod, VERSION_NORMAL );
      for ( ithread=0; ithread<nthread; ithread++ ) {
        indx = ithread*(1+max_node)+inod;
        node_nel_ptr[0] += node_nel[indx];
        indx = ithread*(1+max_node)*npuknwn+inod*npuknwn;
        array_add( node_lhside_ptr, &node_lhside[indx], node_lhside_ptr, npuknwn );
        array_add( node_rhside_ptr, &node_rhside[indx], node_rhside_ptr, npuknwn );
        array_add( node_rhside_internal_ptr, &node_rhside_internal[indx], 
          node_rhside_internal_ptr, npuknwn );
        array_add( node_rhside_static_ptr, &node_rhside_static[indx], 
          node_rhside_static_ptr, npuknwn );
        indx = ithread*(1+max_node)*nuknwn+inod*nuknwn;
        array_add( node_dof_tmp_ptr, &node_dof_tmp[indx], node_dof_tmp_ptr, nuknwn );
      }
      if ( derivatives && node_nel_ptr[0]>0 ) {
        for ( idim=0; idim<ndim; idim++ ) {
          for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
            iuknwn = ipuknwn*nder + idim + 1;
            node_dof_new_ptr[iuknwn] = node_dof_tmp_ptr[iuknwn]/((double)node_nel_ptr[0]);
          }
        }
      }
    }
  }

  db_delete( NODE_DOF_TMP, VERSION_NORMAL );
  db_delete( NODE_NEL, VERSION_NORMAL );

  delete[] node_nel;
  delete[] node_lhside;
  delete[] node_rhside;
  delete[] node_rhside_internal;
  delete[] node_rhside_static;
  delete[] node_dof_tmp;

  if ( swit ) pri( "Out routine ELEMENT_LOOP" );
}

void parallel_element_loop( void )

{
  long int element=0, max_element=0, iloop=0, nloop=0, swit=0,
    ithread=0, *next_of_loop=NULL;

  swit = set_swit(-1,-1,"parallel_element_loop");
  if ( swit ) pri( "In routine PARALLEL_ELEMENT_LOOP" );

    // loop over elements
  db_max_index( ELEMENT, max_element, VERSION_NORMAL, GET );
  if ( max_element>=0 ) {
    next_of_loop = get_new_int(1+max_element);
    parallel_sys_next_of_loop( next_of_loop, max_element, nloop, ithread );
    for ( iloop=0; iloop<nloop; iloop++ ) {
      element = next_of_loop[iloop];
      if ( element>max_element )
        break;
      else if ( db_active_index( ELEMENT, element, VERSION_NORMAL ) )
        elem( element, ithread );
    }
    delete[] next_of_loop;
  }

  if ( swit ) pri( "Out routine PARALLEL_ELEMENT_LOOP" );
}

void elem( long int element, long int ithread )

  /* 
     Left hand-side and right hand-side in an element.

     old_unknowns -> unknown values at time t
     new_unknowns -> unknown values at time t+dt
     old_grad -> gradient over shape at time 0 (total) or at time t (updated)
     new_grad -> gradient over shape at time t+dt 
     old_coord -> nodal coordinates at time 0 (total) or at time t (updated)
     new_coord -> nodal coordinates at time t+dt
  */

{
  long int inol=0, inod=0, ipuknwn=0, iuknwn=0, jpuknwn=0, juknwn=0, l=0,
    jnol=0, jnod=0, len_type=0, indxi=0, indxj=0,
    idim=0, type=0, swit=0, itype=0, ipoint=0, npoint=0, length=0, 
    nnol=0, name=0, icontrol=0, element_group=0, indx=0, max_node=0, 
    control_solver=0, ldum=0, 
    idum[1], types[MTYPE], el[MNOL+1], nodes[MNOL], dof_type[MUKNWN],
    dof_principal[MUKNWN], *element_matrix_unknowns=NULL;
  double dtime=0., volfac=0., tmp=0., 
    element_delete_factor=1., dens=0., fac=0., vel=0.,
    condif_density=0., materi_dens=0., materi_dens_minimum=0., cap=0., res=0.,
    control_relaxation_materi_velocity=0., control_relaxation_condif_temperature=0.,
    control_relaxation_groundflow_pressure=0., control_relaxation_wave_fscalar=0.,
    element_volume=0., ddum[1], old_coord[MNOL*MDIM], new_coord[MNOL*MDIM], 
    h[MPOINT*MNOL], coord_ip[MDIM], 
    old_dof[MNOL*MUKNWN], new_dof[MNOL*MUKNWN], 
    old_unknowns[MUKNWN], new_unknowns[MUKNWN], 
    old_grad_old_unknowns[MDIM*MUKNWN], old_grad_new_unknowns[MDIM*MUKNWN], 
    new_grad_old_unknowns[MDIM*MUKNWN], new_grad_new_unknowns[MDIM*MUKNWN], 
    volume[MPOINT], force_element_volume[MPUKNWN], tendon_element_rhside[MNOL*MPUKNWN], 
    residue_factor[MPUKNWN], element_residue[MNOL*MPUKNWN], 
    element_dof_tmp_factor[MNOL], element_dof_tmp[MNOL*MUKNWN], 
    element_lhside[MNOL*MPUKNWN], element_rhside[MNOL*MPUKNWN], 
    element_rhside_internal[MNOL*MPUKNWN], element_rhside_static[MNOL*MPUKNWN], condif_flow[MDIM], 
    *element_matrix_values=NULL, *element_matrix=NULL, 
    *element_matrix_stress_stiffness_values=NULL, *element_matrix_stress_stiffness=NULL, 
    *new_b=NULL, *new_bnl=NULL, *old_d=NULL, *new_d=NULL, 
    *cons_var_vel=NULL, *cons_var_flow=NULL, *grad_cons_var_flow=NULL;

  swit = set_swit(element,-1,"elem");
  if ( swit ) pri( "In routine ELEM" );

  db( ELEMENT, element, el, ddum, length, VERSION_NORMAL, GET );
  name = el[0]; nnol = length - 1; array_move( &el[1], nodes, nnol );
  if ( swit ) {
    pri( "element", element );
    pri( "name", name );
    pri( "nodes", nodes, nnol );
  }

  element_matrix_unknowns = get_new_int( 2*nnol*nprinc*nnol*nprinc );
  element_matrix_values = get_new_dbl( nnol*nprinc*nnol*nprinc );
  element_matrix = get_new_dbl( nnol*npuknwn*nnol*npuknwn );
  new_b = get_new_dbl( MPOINT*MSTRAIN*nnol*ndim );
  new_bnl = get_new_dbl( MPOINT*MDIM*MDIM*nnol*ndim );
  old_d = get_new_dbl( MPOINT*ndim*nnol );
  new_d = get_new_dbl( MPOINT*ndim*nnol );
  cons_var_vel = get_new_dbl( npuknwn*nnol*ndim );
  cons_var_flow = get_new_dbl( npuknwn*nnol*ndim );
  grad_cons_var_flow = get_new_dbl( npuknwn*nnol*ndim );
  if ( materi_stress ) {
    element_matrix_stress_stiffness_values = get_new_dbl( nnol*nprinc*nnol*nprinc );
    element_matrix_stress_stiffness = get_new_dbl( nnol*npuknwn*nnol*npuknwn );
  }
  else {
    element_matrix_stress_stiffness_values = get_new_dbl( 1 );
    element_matrix_stress_stiffness = get_new_dbl( 1 );
  }

    // initialize
  array_set( tendon_element_rhside, 0., nnol*npuknwn );
  array_set( element_rhside, 0., nnol*npuknwn );
  array_set( element_rhside_internal, 0., nnol*npuknwn );
  array_set( element_rhside_static, 0., nnol*npuknwn );
  array_set( element_lhside, 0., nnol*npuknwn );
  array_set( element_residue, 0., nnol*npuknwn );
  array_set( element_dof_tmp, 0., nnol*nuknwn );
  array_set( element_dof_tmp_factor, 0., nnol );
  array_set( condif_flow, 0., ndim );
  array_set( cons_var_vel, 0., npuknwn*nnol*ndim );
  array_set( cons_var_flow, 0., npuknwn*nnol*ndim );
  array_set( element_matrix, 0., nnol*npuknwn*nnol*npuknwn );
  if ( materi_stress ) 
    array_set( element_matrix_stress_stiffness, 0., nnol*npuknwn*nnol*npuknwn );

  db_max_index( NODE, max_node, VERSION_NORMAL, GET );
  db( ELEMENT_GROUP, element, &element_group, ddum, ldum, 
    VERSION_NORMAL, GET_IF_EXISTS );
  db( GROUP_TYPE, element_group, types, ddum, len_type, 
    VERSION_NORMAL, GET_IF_EXISTS );
  db( DTIME, 0, idum, &dtime, ldum, VERSION_NEW, GET );
  db( DOF_TYPE, 0, dof_type, ddum, ldum, VERSION_NORMAL, GET_IF_EXISTS );
  db( DOF_PRINCIPAL, 0, dof_principal, ddum, ldum, VERSION_NORMAL, GET );
  db( ICONTROL, 0, &icontrol, ddum, ldum, VERSION_NORMAL, GET );
  db( CONTROL_SOLVER, icontrol, &control_solver, ddum, ldum, 
    VERSION_NORMAL, GET );

    // get dof of element
  for ( inol=0; inol<nnol; inol++ ) {
    inod = nodes[inol];
    indx = inod*npuknwn;
    array_move( db_dbl(NODE_DOF,inod,VERSION_NORMAL), 
      &old_dof[inol*nuknwn], nuknwn );
    array_move( db_dbl(NODE_DOF,inod,VERSION_NEW), 
      &new_dof[inol*nuknwn], nuknwn );
  }
  if ( swit ) {
    pri( "old_dof", old_dof, nnol, nuknwn );
    pri( "new_dof", new_dof, nnol, nuknwn );
  }

  if ( materi_density ) {
    for ( materi_dens=0., inol=0; inol<nnol; inol++ )
      materi_dens += new_dof[inol*nuknwn+dens_indx]/nnol;
    db( GROUP_MATERI_DENSITY_MINIMUM, element_group, idum, &materi_dens_minimum, 
      ldum, VERSION_NORMAL, GET_IF_EXISTS );
    if ( materi_dens<materi_dens_minimum ) goto skip_element;
  }

    // get element node coordinates
  for ( inol=0; inol<nnol; inol++ ) {
    inod = nodes[inol];
    db( NODE, inod, idum, &old_coord[inol*ndim], ldum, VERSION_NORMAL, GET );
    db( NODE, inod, idum, &new_coord[inol*ndim], ldum, VERSION_NEW, GET );
    if ( materi_displacement ) {
      for ( idim=0; idim<ndim; idim++ ) new_coord[inol*ndim+idim] +=
        new_dof[inol*nuknwn+dis_indx+idim*nder];
    }
  }
  if ( swit ) {
    pri( "old_coord", old_coord, nnol, ndim );
    pri( "new_coord", new_coord, nnol, ndim );
  }

  if ( db_active_index( OPTIONS_RESIDUEFACTOR, 0, VERSION_NORMAL ) )
    db( OPTIONS_RESIDUEFACTOR, 0, idum, residue_factor, ldum, VERSION_NORMAL, GET );
  else array_set( residue_factor, 1., npuknwn );

    // lumped relaxation
  db( CONTROL_RELAXATION_MATERI_VELOCITY, icontrol, idum, 
    &control_relaxation_materi_velocity, ldum, VERSION_NORMAL, GET_IF_EXISTS );
  db( CONTROL_RELAXATION_CONDIF_TEMPERATURE, icontrol, idum, 
    &control_relaxation_condif_temperature, ldum, VERSION_NORMAL, GET_IF_EXISTS );
  db( CONTROL_RELAXATION_GROUNDFLOW_PRESSURE, icontrol, idum, 
    &control_relaxation_groundflow_pressure, ldum, VERSION_NORMAL, GET_IF_EXISTS );
  db( CONTROL_RELAXATION_WAVE_FSCALAR, icontrol, idum, 
    &control_relaxation_wave_fscalar, ldum, VERSION_NORMAL, GET_IF_EXISTS );
  for ( inol=0; inol<nnol; inol++ ) {
    for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
      iuknwn = ipuknwn*nder;
      indx = inol*npuknwn + ipuknwn;
      if      ( dof_type[iuknwn]==-MATERI_VELOCITY ) {
        element_lhside[indx] = control_relaxation_materi_velocity * dtime;
        element_matrix[indx*nnol*npuknwn+indx] = control_relaxation_materi_velocity * dtime;
      }
      else if ( dof_type[iuknwn]==-WAVE_FSCALAR ) {
        element_lhside[indx] = control_relaxation_wave_fscalar * dtime;
        element_matrix[indx*nnol*npuknwn+indx] = control_relaxation_wave_fscalar * dtime;
      }
      else if ( dof_type[iuknwn]==-CONDIF_TEMPERATURE ) {
        element_lhside[indx] = control_relaxation_condif_temperature;
        element_matrix[indx*nnol*npuknwn+indx] = control_relaxation_condif_temperature;
      }
      else if ( dof_type[iuknwn]==-GROUNDFLOW_PRESSURE ) {
        element_lhside[indx] = control_relaxation_groundflow_pressure;
        element_matrix[indx*nnol*npuknwn+indx] = control_relaxation_groundflow_pressure;
      }
    }
  }

    // conservation variables flow
  for ( inol=0; inol<nnol; inol++ ) {
    get_group_data( GROUP_CONDIF_CAPACITY, element_group, &new_dof[inol*nuknwn], 
      &cap, ldum, GET_IF_EXISTS );
    get_group_data( GROUP_CONDIF_FLOW, element_group, &new_dof[inol*nuknwn], 
      condif_flow, ldum, GET_IF_EXISTS );
    get_group_data( GROUP_CONDIF_DENSITY, element_group, &new_dof[inol*nuknwn], 
      &condif_density, ldum, GET_IF_EXISTS );
    get_group_data( GROUP_MATERI_DENSITY, element_group, &new_dof[inol*nuknwn], 
      &materi_dens, ldum, GET_IF_EXISTS );
    for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
      iuknwn = ipuknwn*nder;
      if ( dof_type[iuknwn]!=-GROUNDFLOW_VELOCITY ) {
        if ( materi_density ) 
          dens = new_dof[inol*nuknwn+dens_indx];
        else if ( dof_type[iuknwn]==-CONDIF_TEMPERATURE ) 
          dens = condif_density;
        else 
          dens = materi_dens;
        if ( dens<0. ) dens = 0.;
        if      ( dof_type[iuknwn]==-CONDIF_TEMPERATURE )
          fac = dens * cap;
        else if ( dof_type[iuknwn]==-MATERI_VELOCITY )
          fac = dens;
        else
          fac = 1.;
        for ( idim=0; idim<ndim; idim++ ) {
          if ( dof_type[iuknwn]==-CONDIF_TEMPERATURE ) {
            vel = condif_flow[idim];
            if ( groundflow_gvelocity ) 
              vel += new_dof[inol*nuknwn+gvel_indx+idim*nder];
            if ( materi_velocity )
              vel += new_dof[inol*nuknwn+vel_indx+idim*nder];
          }
          else if ( materi_velocity )
            vel = new_dof[inol*nuknwn+vel_indx+idim*nder];
          else
            vel = 0.;
          indx = ipuknwn*nnol*ndim+inol*ndim+idim;
          cons_var_vel[indx] = vel;
          cons_var_flow[indx] = fac * vel * new_dof[inol*nuknwn+iuknwn];
        }
      }
    }
  }

    // polynomials and integration point volumes
  pol( element, element_group, name, nnol, old_coord, new_coord, 
    npoint, h, old_d, new_d, new_b, new_bnl, volume );
  if ( swit ) {
    pri( "volume", volume, npoint );
    pri( "h", h, npoint, nnol );
    pri( "old_d", old_d, npoint*ndim, nnol );
    pri( "new_d", new_d, npoint*ndim, nnol );
  }

    // loop over integration points
  for ( ipoint=0; ipoint<npoint; ipoint++ ) {
    if ( swit ) pri( "ipoint", ipoint );

      // old_unknowns
    matrix_ab( &h[ipoint*nnol], old_dof, old_unknowns, 1, nnol, nuknwn );
    if ( swit ) pri( "old_unknowns", old_unknowns, nuknwn );

      // new_unknowns
    matrix_ab( &h[ipoint*nnol], new_dof, new_unknowns, 1, nnol, nuknwn );
    if ( swit ) pri( "new_unknowns", new_unknowns, nuknwn );

      // gradient of unknowns
    matrix_ab( &old_d[ipoint*ndim*nnol], old_dof, old_grad_old_unknowns,
      ndim, nnol, nuknwn );
    matrix_ab( &old_d[ipoint*ndim*nnol], new_dof, old_grad_new_unknowns,
      ndim, nnol, nuknwn );
    matrix_ab( &new_d[ipoint*ndim*nnol], old_dof, new_grad_old_unknowns,
      ndim, nnol, nuknwn );
    matrix_ab( &new_d[ipoint*ndim*nnol], new_dof, new_grad_new_unknowns,
      ndim, nnol, nuknwn );
    if ( swit ) {
      pri( "old_grad_old_unknowns", old_grad_old_unknowns, ndim, nuknwn );
      pri( "old_grad_new_unknowns", old_grad_new_unknowns, ndim, nuknwn );
      pri( "new_grad_old_unknowns", new_grad_old_unknowns, ndim, nuknwn );
      pri( "new_grad_new_unknowns", new_grad_new_unknowns, ndim, nuknwn );
    }

      // gradient of conservation variables
    for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
      matrix_ab( &new_d[ipoint*ndim*nnol], &cons_var_flow[ipuknwn*nnol*ndim], 
        &grad_cons_var_flow[ipuknwn*ndim*ndim], ndim, nnol, ndim );
    }
    if ( swit ) pri( "grad_cons_var_flow", grad_cons_var_flow, 
      npuknwn, ndim*ndim );

      // coordinate of integration point
    matrix_ab( &h[ipoint*nnol], new_coord, coord_ip, 1, nnol, ndim );
    if ( swit ) pri( "coord_ip", coord_ip, ndim );

      // volume factor
    volume_factor( element_group, coord_ip, volfac );
    if ( swit ) pri( "volfac", volfac );

      // total element volume
    element_volume += volfac*volume[ipoint];

      // element force
    force_element_volume_set( element, nnol, nodes, coord_ip, force_element_volume );
    for ( inol=0; inol<nnol; inol++ ) {
      for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
        indx = inol*npuknwn + ipuknwn;
        tmp = h[ipoint*nnol+inol] * force_element_volume[ipuknwn];
        element_rhside[indx] += volfac * volume[ipoint] * tmp;
        element_rhside_internal[indx] += volfac * volume[ipoint] * tmp;
        element_rhside_static[indx] += volfac * volume[ipoint] * tmp;
        if ( residue ) element_residue[indx] -= 
          h[ipoint*nnol+inol] * force_element_volume[ipuknwn];
      }
    }

      // loop over differential operators
    for ( itype=0; itype<len_type; itype++ ) {
      type = types[itype];
      if      ( type==-CONDIF )
        condif( element, element_group, nnol, 
          &h[ipoint*nnol], volfac*volume[ipoint], 
          new_unknowns, element_lhside, element_matrix, element_rhside, 
          element_rhside_internal, element_rhside_static, element_residue );
      else if ( type==-GROUNDFLOW )
        groundflow( element, element_group, nnol, &h[ipoint*nnol], 
          &new_d[ipoint*ndim*nnol], volfac*volume[ipoint], old_unknowns, 
          new_unknowns, new_grad_new_unknowns,
          element_matrix, element_rhside, element_rhside_internal, 
          element_rhside_static, element_residue );
      else if ( type==-MATERI )
        materi( element, element_group, nnol, npoint, coord_ip, old_coord, 
          &h[ipoint*nnol], &new_d[ipoint*ndim*nnol], 
          &new_b[ipoint*MSTRAIN*nnol*ndim], &new_bnl[ipoint*MDIM*MDIM*nnol*ndim], 
          volfac*volume[ipoint], old_unknowns, new_unknowns, old_grad_old_unknowns, 
          old_grad_new_unknowns, new_grad_new_unknowns,
          element_lhside, element_matrix, element_matrix_stress_stiffness,
          element_rhside, element_rhside_internal,
          element_rhside_static, element_residue, tendon_element_rhside );
      else if ( type==-WAVE )
          wave( element, element_group, nnol, 
          &h[ipoint*nnol], &new_d[ipoint*ndim*nnol],
          volfac*volume[ipoint], new_unknowns, new_grad_new_unknowns, 
          element_matrix, element_rhside, element_rhside_internal,
          element_rhside_static, element_residue );
      else if ( type!=-EMPTY )
        db_error( GROUP_TYPE, element_group );
      general( element, name, nnol, element_group, type, nodes, old_dof, new_dof, 
        new_unknowns, new_grad_new_unknowns, &h[ipoint*nnol], 
        &new_d[ipoint*ndim*nnol], volfac*volume[ipoint],
        element_rhside, element_rhside_internal, element_rhside_static, 
        element_residue, element_lhside, element_matrix, 
        cons_var_vel, grad_cons_var_flow );
    }

      // contribution to unknown gradients in nodes
    if ( derivatives ) {
      for ( inol=0; inol<nnol; inol++ ) {
        for ( idim=0; idim<ndim; idim++ ) {
          for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
            iuknwn = ipuknwn*nder + idim + 1;
            element_dof_tmp[inol*nuknwn+iuknwn] += h[ipoint*nnol+inol] * 
              new_grad_new_unknowns[idim*nuknwn+ipuknwn*nder];
          }
        }
        element_dof_tmp_factor[inol] += h[ipoint*nnol+inol];
      }
    }

  }
  array_multiply( tendon_element_rhside, tendon_element_rhside,
    1./npoint, nnol*npuknwn );
  array_add( tendon_element_rhside, element_rhside, 
    element_rhside, nnol*npuknwn );
  array_add( tendon_element_rhside, element_rhside_internal, 
    element_rhside_internal, nnol*npuknwn );
  array_add( tendon_element_rhside, element_rhside_static, 
    element_rhside_static, nnol*npuknwn );
  if ( derivatives ) {
    for ( inol=0; inol<nnol; inol++ ) {
      indx = inol * nuknwn;
      if ( element_dof_tmp_factor[inol]!=0. ) 
        array_multiply( &element_dof_tmp[indx], &element_dof_tmp[indx],
        1./element_dof_tmp_factor[inol], nuknwn );
    }
  }

    // area integrals
  area( name, nnol, nodes, new_coord, new_dof, 
    element_lhside, element_matrix, element_rhside, 
    element_rhside_internal, element_rhside_static );

    // residue
  if ( residue ) {
    for ( inol=0; inol<nnol; inol++ ) {
      res = 0.;
      for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
        iuknwn = ipuknwn * nder;
        if ( iuknwn!=res_indx ) {
	  res += residue_factor[ipuknwn] * 
            scalar_dabs(element_residue[inol*npuknwn+ipuknwn]);
        }
      }
      ipuknwn = res_indx/nder;
      iuknwn = ipuknwn * nder;
      indx = inol*npuknwn + ipuknwn;
      element_rhside[indx] += ( res - new_dof[inol*nuknwn+iuknwn] ) / dtime;
      element_lhside[indx] += 1. / dtime;
    }
  }

    // store volume
  length = 1;
  db( ELEMENT_VOLUME, element, idum, &element_volume, length, VERSION_NORMAL, PUT );

  db( ELEMENT_DELETE_FACTOR, element, idum, &element_delete_factor, ldum, 
    VERSION_NEW, GET_IF_EXISTS );
  if ( element_delete_factor!=1. ) {
    for ( inol=0; inol<nnol; inol++ ) {
      for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
        iuknwn = ipuknwn*nder;
        indx = inol*npuknwn + ipuknwn;
        if ( dof_principal[iuknwn]>=0 ) {
          element_rhside[indx] *= element_delete_factor;
          element_rhside_internal[indx] *= element_delete_factor;
          element_rhside_static[indx] *= element_delete_factor;
        }
      }
    }
  }

    // store element matrices sparse
  if ( control_solver==-MATRIX_DIRECT || control_solver==-MATRIX_ITERATIVE ) {
    l = 0;
    for ( inol=0; inol<nnol; inol++ ) {
      inod = nodes[inol];
      for ( jnol=0; jnol<nnol; jnol++ ) {
        jnod = nodes[jnol];
        for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
          iuknwn = ipuknwn*nder;
          for ( jpuknwn=0; jpuknwn<npuknwn; jpuknwn++ ) {
            juknwn = jpuknwn*nder;
            indxi = inol*npuknwn + ipuknwn;
            indxj = jnol*npuknwn + jpuknwn;
            if ( dof_principal[iuknwn]>=0 && dof_principal[juknwn]>=0 ) {
              element_matrix_values[l] = 
                element_delete_factor * element_matrix[indxi*nnol*npuknwn+indxj];
              if ( materi_stress ) {
                element_matrix_stress_stiffness_values[l] = element_delete_factor *
                  element_matrix_stress_stiffness[indxi*nnol*npuknwn+indxj];
              }
              element_matrix_unknowns[2*l+0] = inod*npuknwn + ipuknwn;
              element_matrix_unknowns[2*l+1] = jnod*npuknwn + jpuknwn;
              l++;
            } 
          }
        }
      }
    }
    if ( l>0 ) {
      length = 2*l;
      db( ELEMENT_MATRIX_UNKNOWNS, element, element_matrix_unknowns, ddum,
        length, VERSION_NORMAL, PUT );
      length = l;
      db( ELEMENT_MATRIX_VALUES, element, idum, element_matrix_values, 
        length, VERSION_NORMAL, PUT );
      if ( materi_stress ) {
        if ( db_active_index( ELEMENT_MATRIX_STRESS_STIFFNESS_VALUES, 
            element, VERSION_NORMAL ) ) {
          db( ELEMENT_MATRIX_STRESS_STIFFNESS_VALUES, element, idum, 
            element_matrix_stress_stiffness_values, length, VERSION_NORMAL, PUT );
        }
      }
    }
  }

    // add to system vectors
  for ( inol=0; inol<nnol; inol++ ) {
    inod = nodes[inol];
    indx = ithread*(1+max_node)+inod;
    node_nel[indx]++;
    indx = ithread*(1+max_node)*npuknwn+inod*npuknwn;
    array_add( &node_rhside[indx], &element_rhside[inol*npuknwn], 
      &node_rhside[indx], npuknwn );
    array_add( &node_rhside_internal[indx], &element_rhside_internal[inol*npuknwn], 
      &node_rhside_internal[indx], npuknwn );
    array_add( &node_rhside_static[indx], &element_rhside_static[inol*npuknwn], 
      &node_rhside_static[indx], npuknwn );
    for ( ipuknwn=0; ipuknwn<npuknwn; ipuknwn++ ) {
      iuknwn = ipuknwn*nder;
      if ( control_solver==-DIAGONAL || dof_principal[iuknwn]<0 )
        node_lhside[indx+ipuknwn] += element_lhside[inol*npuknwn+ipuknwn];
    }
    indx = ithread*(1+max_node)*nuknwn+inod*nuknwn;
    array_add( &node_dof_tmp[indx], &element_dof_tmp[inol*nuknwn], 
      &node_dof_tmp[indx], nuknwn );
  }

    // some final printing
  if ( swit ) {
    if ( control_solver==-MATRIX_DIRECT || control_solver==-MATRIX_ITERATIVE ) {
      pri( "element_matrix", element_matrix, nnol*npuknwn, nnol*npuknwn );
      if ( materi_stress ) pri( "element_matrix_stress_stiffness", 
        element_matrix_stress_stiffness, nnol*npuknwn, nnol*npuknwn );
    }
    pri( "element_lhside", element_lhside, nnol, npuknwn );
    pri( "element_rhside", element_rhside, nnol, npuknwn );
    pri( "element_rhside_internal", element_rhside_internal, nnol, npuknwn );
    pri( "element_rhside_static", element_rhside_static, nnol, npuknwn );
    pri( "element_residue", element_residue, nnol, npuknwn );
    pri( "element_dof_tmp", element_dof_tmp, nnol, nuknwn );
  }

  skip_element:

  delete[] element_matrix_unknowns;
  delete[] element_matrix_values;
  delete[] element_matrix;
  delete[] new_b;
  delete[] new_bnl;
  delete[] old_d;
  delete[] new_d;
  delete[] cons_var_vel;
  delete[] cons_var_flow;
  delete[] grad_cons_var_flow;
  delete[] element_matrix_stress_stiffness_values;
  delete[] element_matrix_stress_stiffness;

  if ( swit ) pri( "Out routine ELEM" );

}
