text: !##############################################################################
  !# ****************************************************************************
  !# <name> blockmatassemblystdop </name>
  !# ****************************************************************************
  !#
  !# <purpose>
  !# This module defines a set of standard operators that can be used
  !# with the block matrix/vector assembly. These routines may serve as
  !# a template for more complex callback routines.
  !#
  !# The following set of callback routines realise standard operators.
  !# The "bma_fcalc_XXXX" methods can directly be used with bma_buildMatrix, 
  !# bma_buildVector and bma_buildIntegral.
  !# The "bma_docalc_XXXX" methods can be called in a callback routine for 
  !# bma_buildMatrix, bma_buildVector and bma_buildIntegral.
  !#
  !# 1.) bma_fcalc_mass / bma_fcalc_massTensor / bma_docalc_mass
  !#     -> Used with bma_buildMatrix, this calculates mass matrices 
  !#        at a specified position / into a tensor of a block matrix.
  !#
  !# 2.) bma_fcalc_laplace / bma_fcalc_laplaceTensor / bma_docalc_laplace
  !#     -> Used with bma_buildMatrix, this calculates Laplace matrices
  !#        at a specified position / into a tensor blocks of a block matrix.
  !#
  !# 3.) bma_fcalc_gradientdiv / bma_docalc_gradientdiv
  !#     -> Used with bma_buildMatrix, this calculates a gradient matrix
  !#        at a specified position / in all diagonal blocks of a block matrix.
  !#        The gradient matrix is set up after a partial integration, ( -p, div u ).
  !#
  !# 4.) bma_fcalc_divergence / bma_docalc_divergence
  !#     -> Used with bma_buildMatrix, this calculates a divergence matrix
  !#        at a specified position / in all diagonal blocks of a block matrix.
  !#
  !# 5.) bma_fcalc_convec_ugradvw / bma_docalc_convec_ugradvw / bma_docalc_convecTens_ugradvw
  !#     -> Used with bma_buildMatrix, this routine can be used to assemble
  !#        the convection operator ( (u grad) v, w) at a specified position in a block
  !#        matrix.
  !#
  !# 6.) bma_fcalc_convecTens_vugradw / bma_docalc_convecTens_vugradw
  !#     -> Used with bma_buildMatrix, this routine can be used to assemble
  !#        the convection operator ( v, (u grad) w) at a specified position in a block
  !#        matrix.
  !#
  !# 7.) bma_fcalc_convecTens_graduvw / bma_docalc_convecTens_graduvw
  !#     -> Used with bma_buildMatrix, this routine can be used to assemble
  !#        the convection operator ( (grad u) v, w) at a specified position in a block
  !#        matrix.
  !#
  !# 8.) bma_fcalc_convecTens_vgraduw / bma_docalc_convecTens_vgraduw
  !#     -> Used with bma_buildMatrix, this routine can be used to assemble
  !#        the convection operator ( v, (grad u) w) at a specified position in a block
  !#        matrix.
  !#
  !# 9.) bma_fcalc_rhsConst / bma_docalc_rhsConst
  !#     -> Calculates the RHS vector based on the function f=const(=1).
  !#
  !# 10.) bma_fcalc_rhsBubble / bma_docalc_rhsBubble
  !#      -> Calculates the RHS vector based on the function f=32*y*(1-y)+32*x*(1-x)
  !#         which is the RHS for u=16*x*(1-x)*y*(1-y) in the Laplace
  !#         equation -Laplace(u)=f.
  !#
  !# 11.) bma_fcalc_rhsBubblePlusFE / bma_docalc_rhsBubblePlusFE
  !#      -> Calculates the RHS vector based on the function 
  !#         f=32*y*(1-y)+32*x*(1-x) + v(x,y)
  !#         with v(x,y) being a finite element function passed via parameters.
  !#
  !# 12.) bma_fcalc_rhsFE / bma_docalc_rhsFE
  !#     -> Calculates the RHS vector based on the function 
  !#        f=v(x,y)
  !#        with v(x,y) being a finite element function passed via parameters.
  !#
  !# 13.) bma_fcalc_integralOne / bma_docalc_integralOne
  !#     -> Calculates the integral of the function v=1 (which results in the
  !#        size of the domain).
  !#
  !# 14.) bma_fcalc_integralFE / bma_fcalc_integralFE
  !#     -> Calculates the integral of an arbitrary FEM function.
  !#
  !# 15.) bma_fcalc_bubbleL2error / bma_docalc_bubbleL2error
  !#      -> Calculates the squared L2 error of a FEM function to a 
  !#         bubble function
  !#        
  !# 16.) bma_fcalc_bubbleH1error / bma_docalc_bubbleH1error
  !#     -> Calculates the squared H1 error of a FEM function to a 
  !#        bubble function
  !#
  !# 17.) bma_fcalc_L2norm / bma_docalc_L2norm
  !#     -> Calculates the squared L2 norm of a FEM function
  !#        
  !# 18.) bma_fcalc_H1norm / bma_docalc_H1norm
  !#     -> Calculates the squared H1 (semi-)norm of a FEM function
  !#
  !# 19.) bma_fcalc_divergenceL2norm / bma_docalc_divergenceL2norm
  !#     -> Calculates the squared L2-norm of the divergence of a vector field.
  !#
  !# 20.) bma_fcalc_MAXnorm / bma_docalc_MAXnorm
  !#     -> Calculates the MAX norm of a vector (field)
  !# </purpose>
  !##############################################################################
  
  module blockmatassemblystdop
  
    use fsystem
    use storage
    use genoutput
    use geometryaux
    use collection, only: t_collection
    use basicgeometry
    use perfconfig
  
    use basicgeometry
    use boundary
    use triangulation
    use derivatives
  
    use feevaluation2
    use blockmatassemblybase
  
    implicit none
  
    private
  
    !************************************************************************
  
    ! global performance configuration
    type(t_perfconfig), target, save :: bma_perfconfig
  
    !************************************************************************
  
    public :: bma_docalc_mass
    public :: bma_docalc_laplace
    public :: bma_docalc_gradientdiv
    public :: bma_docalc_divergence
    public :: bma_docalc_convec_ugradvw
    public :: bma_docalc_convecTens_ugradvw
    public :: bma_docalc_convecTens_vugradw
    public :: bma_docalc_convecTens_graduvw
    public :: bma_docalc_convecTens_vgraduw
  
    public :: bma_docalc_rhsConst
    public :: bma_docalc_rhsBubble
    public :: bma_docalc_rhsBubblePlusFE
    public :: bma_docalc_rhsFE
  
    public :: bma_docalc_integralOne
    public :: bma_docalc_integralFE
    public :: bma_docalc_bubbleL2error
    public :: bma_docalc_bubbleH1error
  
    public :: bma_docalc_L2norm
    public :: bma_docalc_H1norm
    public :: bma_docalc_MAXnorm
    
    public :: bma_docalc_divergenceL2norm
  
    public :: bma_fcalc_massTensor
    public :: bma_fcalc_laplaceTensor
    public :: bma_fcalc_mass
    public :: bma_fcalc_laplace
    public :: bma_fcalc_gradientdiv
    public :: bma_fcalc_divergence
    public :: bma_fcalc_convec_ugradvw
    public :: bma_fcalc_convecTens_vugradw
    public :: bma_fcalc_convecTens_graduvw
    public :: bma_fcalc_convecTens_vgraduw
    
    public :: bma_fcalc_rhsConst
    public :: bma_fcalc_rhsBubble
    public :: bma_fcalc_rhsBubblePlusFE
    public :: bma_fcalc_rhsFE
    
    public :: bma_fcalc_integralOne
    public :: bma_fcalc_integralFE
    public :: bma_fcalc_bubbleL2error
    public :: bma_fcalc_bubbleH1error
  
    public :: bma_fcalc_L2norm
    public :: bma_fcalc_H1norm
    public :: bma_fcalc_MAXnorm
    
    public :: bma_fcalc_divergenceL2norm
  
  contains
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_mass(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix)
  
  !<description>  
      ! Calculates the Mass operator at position (iy,ix) of the
      ! global matrix with a multiplier scale.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Multiplier in front of the matrix.
      real(DP), intent(in) :: dscale
      
      ! Column/row in the global matrix where to asseble the matrix to.
      integer, intent(in) :: iy,ix
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dbasJ
      integer :: iel, icubp, idofe, jdofe, ivar, nvar
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix
      real(DP), dimension(:,:,:,:), pointer :: p_DlocalMatrixIntl
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData
  
      integer :: ndimfe, idimfe
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_rmatrixData => RmatrixData(iy,ix)
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
      
      ! FE space dimension
      ndimfe = RmatrixData(iy,ix)%ndimfeTrial
      
      if (ndimfe .ne. RmatrixData(iy,ix)%ndimfeTest) then
        ! This does not make sense.
        call output_line ("Dimension of trial and test FE space different.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_mass")
        call sys_halt()
      end if
  
      ! Interleaved matrix?
      if (.not. p_rmatrixData%bisInterleaved) then
  
        ! Get the matrix data      
        p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * dbasJ*dbasI
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
        
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Loop over the dimensions of the FE space
              do idimfe = 0,ndimfe-1
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe+idimfe*p_rmatrixData%ndofTest,DER_FUNC,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe+idimfe*p_rmatrixData%ndofTrial,DER_FUNC,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJ*dbasI
  
                  end do ! jdofe
  
                end do ! idofe
                
              end do ! idimfe
  
            end do ! icubp
  
          end do ! iel
          
        end if ! ndimfe = 1
  
      else
  
        ! Get the matrix data      
        p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
        ! Interleave-data
        nvar = RmatrixData(iy,ix)%nvar
  
        if (ndimfe .eq. 1) then
          
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
  
                  do ivar = 1,nvar
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                            dscale * p_DcubWeight(icubp,iel) * dbasJ*dbasI
  
                  end do ! ivar
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Loop over the dimensions of the FE space
              do idimfe = 0,ndimfe-1
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe+idimfe*p_rmatrixData%ndofTest,DER_FUNC,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe+idimfe*p_rmatrixData%ndofTrial,DER_FUNC,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * dbasJ*dbasI
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
                
              end do ! idimfe
  
            end do ! icubp
  
          end do ! iel
  
        end if
  
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_massTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>
      ! Calculates the Mass operator as tensor into the diagonal of a block matrix
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! in all diagonal blocks with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%DquickAccess(1) = multiplier in front of the mass matrix.
      ! rcollection%IquickAccess(1) = y-position in the destination matrix
      ! rcollection%IquickAccess(2) = x-position in the destination matrix
      ! rcollection%IquickAccess(3) = size of the tensor; default is maximum size
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      integer :: i, ix, iy, isize
      real(DP) :: dscale
  
      ! First/last block, multiplier
      ix = 1
      iy = 1
      isize = min(ubound(RmatrixData,1),ubound(RmatrixData,2))
      dscale = 1.0_DP
      
      if (present(rcollection)) then
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
        dscale = rcollection%DquickAccess(1)
  
        ! Calculate (maximum) size
        isize = max(min(ubound(RmatrixData,1)-ix+1,ubound(RmatrixData,2)-iy+1),0)
        isize = min(rcollection%IquickAccess(3),isize)      
      end if
      
      ! Loop through all diagonal blocks   
      do i = 0,isize-1
      
        ! Calculate the Mass matrix at the diagonal position i.
        call bma_docalc_mass(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy+i,ix+i)
  
      end do
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_mass(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the Mass operator in all diagonal matrices.
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! at position (1,1) with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%DquickAccess(1) = multiplier in front of the mass matrix.
      ! rcollection%IquickAccess(1) = y-position in the destination matrix
      ! rcollection%IquickAccess(2) = x-position in the destination matrix
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! Local variables
      integer :: ix, iy
      real(DP) :: dscale
  
      ! Get parameters
      dscale = 1.0_DP
      iy = 1
      ix = 1
  
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
        ! Cancel if nothing to do or parameters wrong
        if (dscale .eq. 0.0_DP) return
  
        if ((ix .lt. 1) .or. (iy .lt. 1) .or. &
            (ix .gt. ubound(RmatrixData,2)) .or. (iy .gt. ubound(RmatrixData,1))) then
          call output_line ("Parameters wrong.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_mass")
          call sys_halt()
        end if
  
      end if
  
      ! Calculate the Mass matrix at the desired position
      call bma_docalc_mass(RmatrixData,rassemblyData,rmatrixAssembly,&
          npointsPerElement,nelements,dscale,iy,ix)
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_laplace(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,rviscosity)
  
  !<description>  
      ! Calculates "dscale (-Laplace)" at position (iy,ix) in a block matrix
      ! with a scaling factor dscale in front.
      !
      ! If rviscosity is specified, "dscale rviscosity (-Laplace)" is calculated.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Multiplier in front of the matrix.
      real(DP), intent(in) :: dscale
      
      ! Column/row in the global matrix where to asseble the matrix to.
      integer, intent(in) :: iy,ix
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! viscosity. Can be omitted if dviscosity is given.
      type(t_fev2VectorData), intent(in), optional :: rviscosity
  !</input>
  
  !</subroutine>
  
      real(DP) :: dbasIx, dbasJx, dbasIy, dbasJy, dbasIz, dbasJz
      integer :: iel, icubp, idofe, jdofe, ivar, nvar
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix
      real(DP), dimension(:,:,:,:), pointer :: p_DlocalMatrixIntl
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:), pointer :: p_Dnu
      type(t_bmaMatrixData), pointer :: p_rmatrixData
  
      integer :: ndimfe, idimfe
      real(DP) :: dnu
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_rmatrixData => RmatrixData(iy,ix)
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! FE space dimension
      ndimfe = RmatrixData(iy,ix)%ndimfeTrial
      
      if (ndimfe .ne. RmatrixData(iy,ix)%ndimfeTest) then
        ! This does not make sense.
        call output_line ("Dimension of trial and test FE space different.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_laplace")
        call sys_halt()
      end if
  
      ! Constant viscosity?
      if (.not. present(rviscosity)) then
      
        ! ===================================================
        ! Constant viscosity - just the scaling factor.
        ! ===================================================
        
        ! Use the scaling factor as viscosity.
        dnu = dscale
  
        ! Interleaved matrix?
        if (.not. p_rmatrixData%bisInterleaved) then
  
          ! Get the matrix data
          p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
          if (ndimfe .eq. 1) then
  
            ! -----------------------
            ! Scalar-valued FE space. 
            ! -----------------------
            ! This IF command prevents an inner IF command and speeds 
            ! up the computation for all scalar standard FE spaces.
  
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                          dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                          dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                          dnu * p_DcubWeight(icubp,iel) * &
                                  ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end select
            
          else
  
            ! -----------------------
            ! Vector-valued FE space.
            ! -----------------------
            ! This implementation works for all types of finite elements, but it
            ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
                    
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV1D_X,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV1D_X,icubp,iel)
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                            dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
                  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_Y,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_Y,icubp,iel)
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                            dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
                  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Y,icubp,iel)
                      dbasIz = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Z,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Y,icubp,iel)
                        dbasJz = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Z,icubp,iel)
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                            dnu * p_DcubWeight(icubp,iel) * &
                                    ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            end select
  
          end if
  
        else
  
          ! Get the matrix data      
          p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
          ! Interleave-data
          nvar = RmatrixData(iy,ix)%nvar
  
          if (ndimfe .eq. 1) then
  
            ! -----------------------
            ! Scalar-valued FE space. 
            ! -----------------------
            ! This IF command prevents an inner IF command and speeds 
            ! up the computation for all scalar standard FE spaces.
  
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      do ivar = 1,nvar
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                            p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                      end do ! ivar
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      do ivar = 1,nvar
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                            p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                      end do ! ivar
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      do ivar = 1,nvar
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                            p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                dnu * p_DcubWeight(icubp,iel) * &
                                        ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                      end do ! ivar
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end select
  
          else
          
            ! -----------------------
            ! Vector-valued FE space.
            ! -----------------------
            ! This implementation works for all types of finite elements, but it
            ! is slightly slower for scalar FE spaces due to an additional inner loop.
          
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV1D_X,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV1D_X,icubp,iel)
  
                        do ivar = 1,nvar
  
                          ! Multiply the values of the basis functions
                          ! (1st derivatives) by the cubature weight and sum up
                          ! into the local matrices.
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                              p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                        end do ! ivar
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_Y,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_Y,icubp,iel)
  
                        do ivar = 1,nvar
  
                          ! Multiply the values of the basis functions
                          ! (1st derivatives) by the cubature weight and sum up
                          ! into the local matrices.
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                              p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                  dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                        end do ! ivar
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Y,icubp,iel)
                      dbasIz = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Z,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Y,icubp,iel)
                        dbasJz = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Z,icubp,iel)
  
                        do ivar = 1,nvar
  
                          ! Multiply the values of the basis functions
                          ! (1st derivatives) by the cubature weight and sum up
                          ! into the local matrices.
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                              p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                  dnu * p_DcubWeight(icubp,iel) * &
                                          ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                        end do ! ivar
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            end select
  
          end if      
  
        end if
  
      else
      
        ! ===================================================
        ! Nonconstant viscosity
        ! ===================================================
      
        ! Get the viscosity
        p_Dnu => rviscosity%p_Ddata(:,:,DER_FUNC)
      
        ! Interleaved matrix?
        if (.not. p_rmatrixData%bisInterleaved) then
  
          ! Get the matrix data
          p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
          if (ndimfe .eq. 1) then
  
            ! -----------------------
            ! Scalar-valued FE space. 
            ! -----------------------
            ! This IF command prevents an inner IF command and speeds 
            ! up the computation for all scalar standard FE spaces.
  
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                          dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                          dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                          dnu * p_DcubWeight(icubp,iel) * &
                                  ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end select
            
          else
  
            ! -----------------------
            ! Vector-valued FE space.
            ! -----------------------
            ! This implementation works for all types of finite elements, but it
            ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
                    
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV1D_X,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV1D_X,icubp,iel)
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                            dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
                  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_Y,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_Y,icubp,iel)
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                            dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
                  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Y,icubp,iel)
                      dbasIz = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Z,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Y,icubp,iel)
                        dbasJz = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Z,icubp,iel)
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                            dnu * p_DcubWeight(icubp,iel) * &
                                    ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            end select
  
          end if
  
        else
  
          ! Get the matrix data      
          p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
          ! Interleave-data
          nvar = RmatrixData(iy,ix)%nvar
  
          if (ndimfe .eq. 1) then
  
            ! -----------------------
            ! Scalar-valued FE space. 
            ! -----------------------
            ! This IF command prevents an inner IF command and speeds 
            ! up the computation for all scalar standard FE spaces.
  
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      do ivar = 1,nvar
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                            p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                      end do ! ivar
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      do ivar = 1,nvar
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                            p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                      end do ! ivar
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasI
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJ
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      do ivar = 1,nvar
  
                        ! Multiply the values of the basis functions
                        ! (1st derivatives) by the cubature weight and sum up
                        ! into the local matrices.
                        p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                            p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                dnu * p_DcubWeight(icubp,iel) * &
                                        ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                      end do ! ivar
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end select
  
          else
          
            ! -----------------------
            ! Vector-valued FE space.
            ! -----------------------
            ! This implementation works for all types of finite elements, but it
            ! is slightly slower for scalar FE spaces due to an additional inner loop.
          
            ! What's the dimension?
            select case (rmatrixAssembly%p_rtriangulation%ndim)
  
            case (NDIM1D)
  
              ! *****************
              ! 1D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV1D_X,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV1D_X,icubp,iel)
  
                        do ivar = 1,nvar
  
                          ! Multiply the values of the basis functions
                          ! (1st derivatives) by the cubature weight and sum up
                          ! into the local matrices.
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                              p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                dnu * p_DcubWeight(icubp,iel) * dbasJx*dbasIx
  
                        end do ! ivar
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM2D)
  
              ! *****************
              ! 2D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV2D_Y,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV2D_Y,icubp,iel)
  
                        do ivar = 1,nvar
  
                          ! Multiply the values of the basis functions
                          ! (1st derivatives) by the cubature weight and sum up
                          ! into the local matrices.
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                              p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                  dnu * p_DcubWeight(icubp,iel) * ( dbasJx*dbasIx + dbasJy*dbasIy )
  
                        end do ! ivar
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            case (NDIM3D)
  
              ! *****************
              ! 3D Laplace matrix
              ! *****************
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Get the viscosity in this point, scaled by dscale.
                  dnu = dscale * p_Dnu(npointsPerElement,nelements)
  
                  ! Loop over the dimensions of the FE space
                  do idimfe = 0,ndimfe-1
  
                    ! Outer loop over the DOF's i=1..ndof on our current element,
                    ! which corresponds to the (test) basis functions Psi_i:
                    do idofe=1,p_rmatrixData%ndofTest
  
                      ! Fetch the contributions of the (test) basis functions Psi_i
                      ! into dbasI
                      dbasIx = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_X,icubp,iel)
                      dbasIy = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Y,icubp,iel)
                      dbasIz = p_DbasTest(&
                          idofe+idimfe*p_rmatrixData%ndofTest,DER_DERIV3D_Z,icubp,iel)
  
                      ! Inner loop over the DOF's j=1..ndof, which corresponds to
                      ! the (trial) basis function Phi_j:
                      do jdofe=1,p_rmatrixData%ndofTrial
  
                        ! Fetch the contributions of the (trial) basis function Phi_j
                        ! into dbasJ
                        dbasJx = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_X,icubp,iel)
                        dbasJy = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Y,icubp,iel)
                        dbasJz = p_DbasTrial(&
                            jdofe+idimfe*p_rmatrixData%ndofTrial,DER_DERIV3D_Z,icubp,iel)
  
                        do ivar = 1,nvar
  
                          ! Multiply the values of the basis functions
                          ! (1st derivatives) by the cubature weight and sum up
                          ! into the local matrices.
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                              p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                                  dnu * p_DcubWeight(icubp,iel) * &
                                          ( dbasJx*dbasIx + dbasJy*dbasIy + dbasJz*dbasIz )
  
                        end do ! ivar
  
                      end do ! jdofe
  
                    end do ! idofe
                    
                  end do ! idimfe
  
                end do ! icubp
  
              end do ! iel
  
            end select
  
          end if      
  
        end if
  
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_laplaceTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the Laplace operator in all diagonal matrices
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! in all diagonal blocks with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%DquickAccess(1) = multiplier in front of the mass matrix.
      ! rcollection%IquickAccess(1) = y-position in the destination matrix
      ! rcollection%IquickAccess(2) = x-position in the destination matrix
      ! rcollection%IquickAccess(3) = size of the tensor; default is maximum size
      !
      ! revalVectors(1) may specify a nonconstant coefficient in each cubature point.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      integer :: i, ix, iy, isize
      real(DP) :: dscale
  
      ! First/last block, multiplier
      ix = 1
      iy = 1
      isize = min(ubound(RmatrixData,1),ubound(RmatrixData,2))
      dscale = 1.0_DP
  
      if (present(rcollection)) then
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
        dscale = rcollection%DquickAccess(1)
  
        ! Calculate (maximum) size
        isize = max(min(ubound(RmatrixData,1)-ix+1,ubound(RmatrixData,2)-iy+1),0)
        isize = min(rcollection%IquickAccess(3),isize)      
      end if
      
      ! Loop through all diagonal blocks   
      do i = 0,isize-1
      
        ! Calculate the matrix at the diagonal position i.
        if (revalVectors%ncount .eq. 0) then
          ! Constant viscosity
          call bma_docalc_laplace(RmatrixData,rassemblyData,rmatrixAssembly,&
              npointsPerElement,nelements,dscale,iy+i,ix+i)
        else
          ! Nonconstant viscosity
          call bma_docalc_laplace(RmatrixData,rassemblyData,rmatrixAssembly,&
              npointsPerElement,nelements,dscale,iy+i,ix+i,revalVectors%p_RvectorData(1))
        end if
  
      end do
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_laplace(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the Laplace operator at position (x,y) in a block matrix.
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! at matrix position (1,1) with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%DquickAccess(1) = multiplier in front of the matrix.
      ! rcollection%IquickAccess(1) = y-position in the block matrix
      ! rcollection%IquickAccess(2) = x-position in the block matrix
      !
      ! revalVectors(1) may specify a nonconstant coefficient in each cubature point.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! local variables
      integer :: ix, iy
      real(DP) :: dscale
  
      ! Get parameters
      dscale = 1.0_DP
      iy = 1
      ix = 1
  
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
        ! Cancel if nothing to do or parameters wrong
        if (dscale .eq. 0.0_DP) return
  
        if ((ix .lt. 1) .or. (iy .lt. 1) .or. &
            (ix .gt. ubound(RmatrixData,2)) .or. (iy .gt. ubound(RmatrixData,1))) then
          call output_line ("Parameters wrong.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_laplace")
          call sys_halt()
        end if
  
      end if
  
      ! Calculate the Laplace at the desired position.
      if (revalVectors%ncount .eq. 0) then
        ! Constant viscosity
        call bma_docalc_laplace(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,1.0_DP,iy,ix)
      else
        ! Nonconstant viscosity
        call bma_docalc_laplace(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,1.0_DP,iy,ix,revalVectors%p_RvectorData(1))
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_gradientdiv(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix)
  
  !<description>  
      ! Calculates the gradient operator at position (iy,ix) in a block matrix
      ! with a scaling factor dscale in front.
      ! Uses the "transposed divergence approach", i.e., not the actual
      ! gradient is set up but the derivative is put to the test functions.
      !
      !   ( - p, div w )  ( =  ( grad(p), w )  after partial integration )
      !
      ! For scalar-valued v-spaces, the gradient operator is
      ! imposed to the matrices (iy,ix), (iy+1,ix), (iy+2,ix). It is assumed that
      ! the subspaces in v_i are all of the same FE type.
      ! For vector-valued v-spaces, the gradient operator is imposed
      ! to the matrix at position (iy,ix).
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Multiplier in front of the matrix.
      real(DP), intent(in) :: dscale
      
      ! Column/row in the global matrix where to asseble the matrix to.
      integer, intent(in) :: iy,ix
  !</input>
  
  !</subroutine>
  
      real(DP) :: dbasIx, dbasJ, dbasIy, dbasIz
      integer :: iel, icubp, idofe, jdofe, ivar, nvar
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix,p_DlocalMatrix2,p_DlocalMatrix3
      real(DP), dimension(:,:,:,:), pointer :: p_DlocalMatrixIntl,p_DlocalMatrixIntl2,p_DlocalMatrixIntl3
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData
  
      integer :: ndimfe
      real(DP) :: dscaleLocal
  
      ! Scaling factor is multiplied by -1 as we have the "divergence" formulation.
      dscaleLocal = -dscale
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_rmatrixData => RmatrixData(iy,ix)
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! FE space dimension
      ndimfe = RmatrixData(iy,ix)%ndimfeTest
      
      if (RmatrixData(iy,ix)%ndimfeTrial .ne. 1) then
        ! This does not make sense.
        call output_line ("Trial-space must be scalar-valued.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_gradientdiv")
        call sys_halt()
      end if
  
      ! Interleaved matrix?
      if (.not. p_rmatrixData%bisInterleaved) then
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D gradient matrix
            ! *****************
  
            ! Get the matrix data
            p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC1D,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ*dbasIx
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM2D)
  
            ! *****************
            ! 2D gradient matrix
            ! *****************
  
            ! Get the matrix data
            p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
            p_DlocalMatrix2 => RmatrixData(iy+1,ix)%p_Dentry
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                  dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC2D,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIx
  
                    p_DlocalMatrix2(jdofe,idofe,iel) = p_DlocalMatrix2(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIy
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D gradient matrix
            ! *****************
  
            ! Get the matrix data
            p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
            p_DlocalMatrix2 => RmatrixData(iy+1,ix)%p_Dentry
            p_DlocalMatrix3 => RmatrixData(iy+2,ix)%p_Dentry
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                  dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                  dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC3D,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIx
                        
                    p_DlocalMatrix2(jdofe,idofe,iel) = p_DlocalMatrix2(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIy
                        
                    p_DlocalMatrix3(jdofe,idofe,iel) = p_DlocalMatrix3(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIz
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          end select
          
        else
  
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
          ! Get the matrix data
          p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D gradient matrix
            ! *****************
  
            ! Does not apply. A vector-valued FE-space in 1D is scalar-valued,
            ! so this case will never be called.
  
          case (NDIM2D)
  
            ! *****************
            ! 2D gradient matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(&
                      idofe+0*p_rmatrixData%ndofTest,DER_DERIV2D_X,icubp,iel)
                  dbasIy = p_DbasTest(&
                      idofe+1*p_rmatrixData%ndofTest,DER_DERIV2D_Y,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC2D,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * ( dbasIx + dbasIy )
  
                  end do ! jdofe
  
                end do ! idofe
                  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D gradient matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(&
                      idofe+0*p_rmatrixData%ndofTest,DER_DERIV3D_X,icubp,iel)
                  dbasIy = p_DbasTest(&
                      idofe+1*p_rmatrixData%ndofTest,DER_DERIV3D_Y,icubp,iel)
                  dbasIz = p_DbasTest(&
                      idofe+2*p_rmatrixData%ndofTest,DER_DERIV3D_Z,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC3D,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * ( dbasIx + dbasIy + dbasIz )
  
                  end do ! jdofe
  
                end do ! idofe
                  
              end do ! icubp
  
            end do ! iel
  
          end select
  
        end if
  
      else
  
        ! Interleave-data
        nvar = RmatrixData(iy,ix)%nvar
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D gradient matrix
            ! *****************
  
            ! Get the matrix data      
            p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC1D,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                            dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ*dbasIx
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM2D)
  
            ! *****************
            ! 2D gradient matrix
            ! *****************
  
            ! Get the matrix data      
            p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
            p_DlocalMatrixIntl2 => RmatrixData(iy+1,ix)%p_DentryIntl
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                  dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC2D,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIx
  
                      p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIy
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D gradient matrix
            ! *****************
  
            ! Get the matrix data      
            p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
            p_DlocalMatrixIntl2 => RmatrixData(iy+1,ix)%p_DentryIntl
            p_DlocalMatrixIntl3 => RmatrixData(iy+2,ix)%p_DentryIntl
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                  dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                  dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC3D,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIx
  
                      p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIy
  
                      p_DlocalMatrixIntl3(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl3(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * dbasIz
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          end select
  
        else
        
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
        
          ! Get the matrix data      
          p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
          
            ! *****************
            ! 1D gradient matrix
            ! *****************
            
            ! Does not apply. A vector-valued FE-space in 1D is scalar-valued,
            ! so this case will never be called.
  
          case (NDIM2D)
  
            ! *****************
            ! 2D gradient matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(&
                      idofe+0*p_rmatrixData%ndofTest,DER_DERIV2D_X,icubp,iel)
                  dbasIy = p_DbasTest(&
                      idofe+1*p_rmatrixData%ndofTest,DER_DERIV2D_Y,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC2D,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * ( dbasIx + dbasIy )
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
                  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D gradient matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasIx = p_DbasTest(&
                      idofe+0*p_rmatrixData%ndofTest,DER_DERIV3D_X,icubp,iel)
                  dbasIy = p_DbasTest(&
                      idofe+1*p_rmatrixData%ndofTest,DER_DERIV3D_Y,icubp,iel)
                  dbasIz = p_DbasTest(&
                      idofe+2*p_rmatrixData%ndofTest,DER_DERIV3D_Z,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJ = p_DbasTrial(jdofe,DER_FUNC3D,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscaleLocal * p_DcubWeight(icubp,iel) * dbasJ * ( dbasIx + dbasIy + dbasIz )
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idimfe
  
              end do ! icubp
  
            end do ! iel
  
          end select
  
        end if      
  
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_gradientdiv(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the gradient operator at position (x,y) in a block matrix.
      ! Uses the "transposed divergence approach", i.e., not the actual
      ! gradient is set up but the derivative is put to the test functions.
      !
      !   ( - p, div w )  ( =  ( grad(p), w )  after partial integration )
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! at matrix position (1,1) with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      !   rcollection%DquickAccess(1) = multiplier in front of the matrix.
      !   rcollection%IquickAccess(1) = y-position in the block matrix
      !   rcollection%IquickAccess(2) = x-position in the block matrix
      ! For scalar-valued v-spaces, the gradient operator is
      ! imposed to the matrices (y,x), (y+1,x), (y+2,x). It is assumed that
      ! the subspaces in v_i are all of the same FE type.
      ! For vector-valued v-spaces, the gradient operator is imposed
      ! to the matrix at position (x,y).
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! local variables
      integer :: ix, iy
      real(DP) :: dscale
  
      ! Get parameters
      dscale = 1.0_DP
      iy = 1
      ix = 1
  
      if (present(rcollection)) then
  
        dscale = rcollection%DquickAccess(1)
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
        ! Cancel if nothing to do or parameters wrong
        if (dscale .eq. 0.0_DP) return
  
        if ((ix .lt. 1) .or. (iy .lt. 1) .or. &
            (ix .gt. ubound(RmatrixData,2)) .or. (iy .gt. ubound(RmatrixData,1))) then
          call output_line ("Parameters wrong.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_gradientdiv")
          call sys_halt()
        end if
  
      end if
      
      call bma_docalc_gradientdiv(RmatrixData,rassemblyData,rmatrixAssembly,&
          npointsPerElement,nelements,dscale,iy,ix)
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_divergence(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix)
  
  !<description>  
      ! Calculates the divergence operator at position (iy,ix) in a block matrix:
      !
      !    ( div v, q )
      !
      ! For scalar-valued v-spaces, the divergence operator is
      ! imposed to the matrices (iy,ix), (iy,ix+1), (iy,ix+2). It is assumed that
      ! the subspaces in v_i are all of the same FE type.
      ! For vector-valued v-spaces, the divergence operator is imposed
      ! to the matrix at position (iy,ix).
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Multiplier in front of the matrix.
      real(DP), intent(in) :: dscale
      
      ! Column/row in the global matrix where to asseble the matrix to.
      integer, intent(in) :: iy,ix
  !</input>
  
  !</subroutine>
  
      real(DP) :: dbasI, dbasJx, dbasJy, dbasJz
      integer :: iel, icubp, idofe, jdofe, ivar, nvar
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix,p_DlocalMatrix2,p_DlocalMatrix3
      real(DP), dimension(:,:,:,:), pointer :: p_DlocalMatrixIntl,p_DlocalMatrixIntl2,p_DlocalMatrixIntl3
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData
  
      integer :: ndimfe
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_rmatrixData => RmatrixData(iy,ix)
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! FE space dimension
      ndimfe = RmatrixData(iy,ix)%ndimfeTrial
      
      if (RmatrixData(iy,ix)%ndimfeTest .ne. 1) then
        ! This does not make sense.
        call output_line ("Test-space must be scalar-valued.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_gradientdiv")
        call sys_halt()
      end if
  
      ! Interleaved matrix?
      if (.not. p_rmatrixData%bisInterleaved) then
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D divergence matrix
            ! *****************
  
            ! Get the matrix data
            p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC1D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJx*dbasI
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM2D)
  
            ! *****************
            ! 2D divergence matrix
            ! *****************
  
            ! Get the matrix data
            p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
            p_DlocalMatrix2 => RmatrixData(iy+1,ix)%p_Dentry
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC2D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                    dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJx * dbasI
  
                    p_DlocalMatrix2(jdofe,idofe,iel) = p_DlocalMatrix2(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJy * dbasI
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D divergence matrix
            ! *****************
  
            ! Get the matrix data
            p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
            p_DlocalMatrix2 => RmatrixData(iy+1,ix)%p_Dentry
            p_DlocalMatrix3 => RmatrixData(iy+2,ix)%p_Dentry
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC3D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                    dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                    dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJx * dbasI
  
                    p_DlocalMatrix2(jdofe,idofe,iel) = p_DlocalMatrix2(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJy * dbasI
  
                    p_DlocalMatrix3(jdofe,idofe,iel) = p_DlocalMatrix3(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * dbasJz * dbasI
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          end select
          
        else
  
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
          ! Get the matrix data
          p_DlocalMatrix => RmatrixData(iy,ix)%p_Dentry
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D divergence matrix
            ! *****************
  
            ! Does not apply. A vector-valued FE-space in 1D is scalar-valued,
            ! so this case will never be called.
  
          case (NDIM2D)
  
            ! *****************
            ! 2D divergence matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC2D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(&
                        jdofe+0*p_rmatrixData%ndofTrial,DER_DERIV2D_X,icubp,iel)
                    dbasJy = p_DbasTrial(&
                        jdofe+1*p_rmatrixData%ndofTrial,DER_DERIV2D_Y,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * ( dbasJx + dbasJy ) * dbasI
  
                  end do ! jdofe
  
                end do ! idofe
                  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D divergence matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC3D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(&
                        jdofe+0*p_rmatrixData%ndofTrial,DER_DERIV3D_X,icubp,iel)
                    dbasJy = p_DbasTrial(&
                        jdofe+1*p_rmatrixData%ndofTrial,DER_DERIV3D_Y,icubp,iel)
                    dbasJz = p_DbasTrial(&
                        jdofe+2*p_rmatrixData%ndofTrial,DER_DERIV3D_Z,icubp,iel)
  
                    ! Multiply the values of the basis functions
                    ! (1st derivatives) by the cubature weight and sum up
                    ! into the local matrices.
                    p_DlocalMatrix(jdofe,idofe,iel) = p_DlocalMatrix(jdofe,idofe,iel) + &
                        dscale * p_DcubWeight(icubp,iel) * &
                                ( dbasJx + dbasJy + dbasJz ) * dbasI
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          end select
  
        end if
  
      else
  
        ! Interleave-data
        nvar = RmatrixData(iy,ix)%nvar
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D divergence matrix
            ! *****************
  
            ! Get the matrix data      
            p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC1D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                            dscale * p_DcubWeight(icubp,iel) * dbasJx * dbasI
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM2D)
  
            ! *****************
            ! 2D divergence matrix
            ! *****************
  
            ! Get the matrix data      
            p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
            p_DlocalMatrixIntl2 => RmatrixData(iy+1,ix)%p_DentryIntl
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC2D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                    dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * dbasJx * dbasI
  
                      p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * dbasJy * dbasI
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D divergence matrix
            ! *****************
  
            ! Get the matrix data      
            p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
            p_DlocalMatrixIntl2 => RmatrixData(iy+1,ix)%p_DentryIntl
            p_DlocalMatrixIntl3 => RmatrixData(iy+2,ix)%p_DentryIntl
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC3D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                    dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                    dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * dbasJx * dbasI
  
                      p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl2(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * dbasJy * dbasI
  
                      p_DlocalMatrixIntl3(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl3(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * dbasJz * dbasI
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          end select
  
        else
        
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
        
          ! Get the matrix data      
          p_DlocalMatrixIntl => RmatrixData(iy,ix)%p_DentryIntl
  
          ! What's the dimension?
          select case (rmatrixAssembly%p_rtriangulation%ndim)
  
          case (NDIM1D)
  
            ! *****************
            ! 1D divergence matrix
            ! *****************
  
            ! Does not apply. A vector-valued FE-space in 1D is scalar-valued,
            ! so this case will never be called.
  
          case (NDIM2D)
  
            ! *****************
            ! 2D divergence matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(&
                      idofe,DER_FUNC2D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(&
                        jdofe+0*p_rmatrixData%ndofTrial,DER_DERIV2D_X,icubp,iel)
                    dbasJy = p_DbasTrial(&
                        jdofe+1*p_rmatrixData%ndofTrial,DER_DERIV2D_Y,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * ( dbasJx + dbasJy ) * dbasI
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          case (NDIM3D)
  
            ! *****************
            ! 3D divergence matrix
            ! *****************
  
            ! Loop over the elements in the current set.
            do iel = 1,nelements
  
              ! Loop over all cubature points on the current element
              do icubp = 1,npointsPerElement
  
                ! Outer loop over the DOF's i=1..ndof on our current element,
                ! which corresponds to the (test) basis functions Psi_i:
                do idofe=1,p_rmatrixData%ndofTest
  
                  ! Fetch the contributions of the (test) basis functions Psi_i
                  ! into dbasI
                  dbasI = p_DbasTest(idofe,DER_FUNC3D,icubp,iel)
  
                  ! Inner loop over the DOF's j=1..ndof, which corresponds to
                  ! the (trial) basis function Phi_j:
                  do jdofe=1,p_rmatrixData%ndofTrial
  
                    ! Fetch the contributions of the (trial) basis function Phi_j
                    ! into dbasJ
                    dbasJx = p_DbasTrial(&
                        jdofe+0*p_rmatrixData%ndofTrial,DER_DERIV3D_X,icubp,iel)
                    dbasJy = p_DbasTrial(&
                        jdofe+1*p_rmatrixData%ndofTrial,DER_DERIV3D_Y,icubp,iel)
                    dbasJz = p_DbasTrial(&
                        jdofe+2*p_rmatrixData%ndofTrial,DER_DERIV3D_Z,icubp,iel)
  
                    do ivar = 1,nvar
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) = &
                          p_DlocalMatrixIntl(ivar,jdofe,idofe,iel) + &
                              dscale * p_DcubWeight(icubp,iel) * &
                              ( dbasJx + dbasJy + dbasJz ) * dbasI
  
                    end do ! ivar
  
                  end do ! jdofe
  
                end do ! idofe
  
              end do ! icubp
  
            end do ! iel
  
          end select
  
        end if      
  
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_divergence(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the divergence operator at position (x,y) in a block matrix:
      !
      !    ( div v, q )
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! at matrix position (1,1) with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      !   rcollection%DquickAccess(1) = multiplier in front of the matrix.
      !   rcollection%IquickAccess(1) = y-position in the block matrix
      !   rcollection%IquickAccess(2) = x-position in the block matrix
      ! For scalar-valued v-spaces, the divergence operator is
      ! imposed to the matrices (y,x), (y,x+1), (y,x+2). It is assumed that
      ! the subspaces in v_i are all of the same FE type.
      ! For vector-valued v-spaces, the divergence operator is imposed
      ! to the matrix at position (x,y).
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      integer :: ix, iy
      real(DP) :: dscale
  
      ! Get parameters
      dscale = 1.0_DP
      iy = 1
      ix = 1
  
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
        ! Cancel if nothing to do or parameters wrong
        if (dscale .eq. 0.0_DP) return
  
        if ((ix .lt. 1) .or. (iy .lt. 1) .or. &
            (ix .gt. ubound(RmatrixData,2)) .or. (iy .gt. ubound(RmatrixData,1))) then
          call output_line ("Parameters wrong.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_divergence")
          call sys_halt()
        end if
  
      end if
      
      ! Calculate the matrix.
      call bma_docalc_divergence(RmatrixData,rassemblyData,rmatrixAssembly,&
          npointsPerElement,nelements,dscale,iy,ix)
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_convec_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,du1,du2,du3,rvectorField)
  
  !<description>  
      ! Calculates a convection operator "( (u grad) v, w)" at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function
      ! and a scaling factor dscale in front.
      ! v is the trial and w the test basis function.
      !
      ! If rvectorField is not specified, a constant velocity du1/du2/du3
      ! is assumed, and du1/du2/du3 must be present.
      ! If rvectorField is specified, it describes the underlying vector field.
  !</description>
  
  !<remarks>
      ! Remark 1:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 3:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Scaling factor
      real(DP), intent(in) :: dscale
      
      ! Position in the global matrix where to assemble
      integer, intent(in) :: iy,ix
      
      ! OPTIONAL: Constant velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1,du2,du3
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dbasJx, dbasJy, dbasJz
      integer :: iel, icubp, idofe, jdofe
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData11
      real(DP), dimension(:,:,:,:), pointer :: p_Du
      real(DP) :: dvelX, dvelY, dvelZ
  
      integer :: ndim
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      bvelConst = present(rvectorField)
      if (bvelConst) then
        dvelX = 0.0_DP
        dvelY = 0.0_DP
        dvelZ = 0.0_DP
      
        ! Constant velocity
        if (present(du1)) dvelX = du1
        if (present(du2)) dvelY = du2
        if (present(du3)) dvelZ = du3
      else
        ! Get the velocity field from the parameters
        p_Du => rvectorField%p_DdataVec
      end if
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! Set up the local matrix of the convection.
      select case (ndim)
      case (NDIM1D)
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convec_ugradvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convec_ugradvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI )            ! ( u1 phi_x , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI )            ! ( u1 phi_x , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
        
      case (NDIM2D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convec_ugradvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convec_ugradvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI )            ! ( u2 phi_y , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              dvelY = p_Du(2,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI )            ! ( u2 phi_y , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      case (NDIM3D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
  
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convec_ugradvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convec_ugradvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                  dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              dvelY = p_Du(2,icubp,iel,DER_FUNC)
              dvelZ = p_Du(3,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                  dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_convecTens_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,du1,du2,du3,rvectorField)
  
  !<description>  
      ! Calculates a convection operator "( (u grad) v, w)" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function
      ! and a scaling factor dscale in front.
      ! v is the trial and w the test basis function.
      !
      ! If rvectorField is not specified, a constant velocity du1/du2/du3
      ! is assumed, and du1/du2/du3 must be present.
      ! If rvectorField is specified, it describes the underlying vector field.
  !</description>
  
  !<remarks>
      ! Remark 1:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 3:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Scaling factor
      real(DP), intent(in) :: dscale
      
      ! Position in the global matrix where to assemble
      integer, intent(in) :: iy,ix
      
      ! OPTIONAL: Constant velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1,du2,du3
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dbasJx, dbasJy, dbasJz
      integer :: iel, icubp, idofe, jdofe
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11,p_DlocalMatrix22,p_DlocalMatrix33
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData11,p_rmatrixData22,p_rmatrixData33
      real(DP), dimension(:,:,:,:), pointer :: p_Du
      real(DP) :: dvelX, dvelY, dvelZ
  
      integer :: ndim
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      bvelConst = present(rvectorField)
      if (bvelConst) then
        dvelX = 0.0_DP
        dvelY = 0.0_DP
        dvelZ = 0.0_DP
      
        ! Constant velocity
        if (present(du1)) dvelX = du1
        if (present(du2)) dvelY = du2
        if (present(du3)) dvelZ = du3
      else
        ! Get the velocity field from the parameters
        p_Du => rvectorField%p_DdataVec
      end if
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! Set up the local matrix of the convection.
      select case (ndim)
      case (NDIM1D)
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_ugradvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_ugradvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI )            ! ( u1 phi_x , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI )            ! ( u1 phi_x , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
        
      case (NDIM2D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. p_rmatrixData22%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_ugradvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_ugradvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI )            ! ( u2 phi_y , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI )            ! ( u2 phi_y , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              dvelY = p_Du(2,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI )            ! ( u2 phi_y , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI )            ! ( u2 phi_y , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
          
      case (NDIM3D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        p_rmatrixData33 => RmatrixData(iy+2,ix+2)
  
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
        p_DlocalMatrix33 => RmatrixData(iy+2,ix+2)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. &
            p_rmatrixData22%bisInterleaved .or. &
            p_rmatrixData33%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_ugradvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_ugradvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                  dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              dvelY = p_Du(2,icubp,iel,DER_FUNC)
              dvelZ = p_Du(3,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                  dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX * dbasJx * dbasI + &          ! ( u1 phi_x , psi )
                        dvelY * dbasJy * dbasI + &          ! ( u2 phi_y , psi )
                        dvelZ * dbasJz * dbasI )            ! ( u3 phi_z , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
          
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_convec_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a convection operator "( (u grad) v, w)" at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function.
      ! v is the trial and w the test basis function.
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! in all diagonal blocks with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      !
      ! rcollection%DquickAccess(1) = multiplier in front of the operator.
      ! rcollection%IquickAccess(1) = y-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(2) = x-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(3) = Specifies the target tensor/matrix
      !                               =0: Only apply SD to the position (iy,ix) (default)
      !                               =1: Apply SD to the full tensor (iy,ix)..(iy+dim,ix+dim)
      ! rcollection%IquickAccess(4) = 0, if the convection is a constant vector field.
      !                                  in this case:
      !                                  1D: rcollection%DquickAccess(2)   = x-velocity
      !                                  2D: rcollection%DquickAccess(2:3) = x/y-velocity
      !                                  3D: rcollection%DquickAccess(2:4) = x/y/z-velocity
      !                             = 1, if the convection is specified by a
      !                                  finite element velocity field. In this case,
      !                                  a finite element velocity field must be specified
      !                                  as parameter revalVectors to the call of 
      !                                  bma_buildMatrix.
  !</description>
  
  !<remarks>
      ! Remark 1: 
      ! Using the routines from feevaluation2, it is possible to specify
      ! a nonconstant velocity field. The corresponding code looks as follows:
      !
      ! <verb>
      !     use feevaluation2
      !
      !     ...
      !
      !     type(t_collection) :: rcollection
      !     type(t_scalarCubatureInfo) :: rcubatureInfo   ! Cubature formula
      !     type(t_matrixBlock) :: rmatrix                ! Matrix to be calculated
      !
      !     type(t_vectorBlock) :: rvelocity        ! The velocity field
      !     type(t_fev2Vectors) :: revalVectors     ! Collection of vectors to evaluate
      !
      !     ! Prepare the cubature formula
      !     call spdiscr_createDefCubStructure (..., rcubatureInfo, CUB_GEN_AUTO)
      !
      !     ...
      !
      !     rcollection%IquickAccess(1) = 1          ! y-Position in the matrix
      !     rcollection%IquickAccess(2) = 1          ! x-Position in the matrix
      !     rcollection%IquickAccess(3) = 0/1        ! Scalar or tensor target
      !     rcollection%IquickAccess(4) = 1          ! Nonconstant viscosity
      !     rcollection%DquickAccess(1) = 1.0_DP     ! Scaling
      !
      !     ! Add the X-, Y- and Z-velocity to revalVectors
      !     call fev2_addVectorFieldToEvalList(revalVectors,0,&
      !         rvelocity%RvectorBlock(1),rvelocity%RvectorBlock(2),rvelocity%RvectorBlock(3))
      !
      !     ! Set up the matrix
      !     call bma_buildMatrix (rmatrix,BMA_CALC_STANDARD, bma_fcalc_convec_ugradvw, &
      !         rcollection, revalVectors=revalVectors,rcubatureInfo=rcubatureInfo)
      !
      !     ! Release the vector structure
      !     call fev2_releaseVectorList(revalVectors)
      !
      !     ...
      !
      !     ! Release the cubature formula
      !     call spdiscr_releaseCubStructure (rcubatureInfo)
      ! </verb>
      !
      ! Remark 2: 
      ! The routine <verb>fev2_addVectorFieldToEvalList</verb> allows to define
      ! the evaluation of derivatives as well. In 3D, e.g., one may apply
      !
      ! <verb>
      !     call fev2_addVectorFieldToEvalList(revalVectors,1,&
      !         rvelocity%RvectorBlock(1),rvelocity%RvectorBlock(2),rvelocity%RvectorBlock(3))
      ! </verb>
      !
      ! which calculates function values as well as 1st derivatives of the complete
      ! vector field (due to the "1" at the end). The calculated values in the
      ! cubature points can then be found in the "p_Ddata" elements of revalVectors:
      !
      ! <verb>
      !   revalVectors%p_RvectorData(1)%p_DdataVec(1,:,:,DER_FUNC)      = u1
      !   revalVectors%p_RvectorData(1)%p_DdataVec(1,:,:,DER_DERIV3D_X) = d/dx u1
      !   revalVectors%p_RvectorData(1)%p_DdataVec(1,:,:,DER_DERIV3D_Y) = d/dy u1
      !   revalVectors%p_RvectorData(1)%p_DdataVec(1,:,:,DER_DERIV3D_Z) = d/dz u1
      !
      !   revalVectors%p_RvectorData(1)%p_DdataVec(2,:,:,DER_FUNC)      = u2
      !   revalVectors%p_RvectorData(1)%p_DdataVec(2,:,:,DER_DERIV3D_X) = d/dx u2
      !   revalVectors%p_RvectorData(1)%p_DdataVec(2,:,:,DER_DERIV3D_Y) = d/dy u2
      !   revalVectors%p_RvectorData(1)%p_DdataVec(2,:,:,DER_DERIV3D_Z) = d/dz u2
      !
      !   revalVectors%p_RvectorData(1)%p_DdataVec(3,:,:,DER_FUNC)      = u3
      !   revalVectors%p_RvectorData(1)%p_DdataVec(3,:,:,DER_DERIV3D_X) = d/dx u3
      !   revalVectors%p_RvectorData(1)%p_DdataVec(3,:,:,DER_DERIV3D_Y) = d/dy u3
      !   revalVectors%p_RvectorData(1)%p_DdataVec(3,:,:,DER_DERIV3D_Z) = d/dz u3
      ! </verb>
      !
      ! in all cubature points on all elements. The vector data in
      ! revalVectors%p_RvectorData appears exactly in the order, the vectors
      ! are added to revalVectors by fev2_addVectorFiueldToEvalList.
      !
      ! Remark 3:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 4:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 5:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! Local variables
      integer :: ndim,iy,ix
      real(DP) :: dscale
      real(DP) :: dvelX, dvelY, dvelZ
      logical :: bvelConst, btensor
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      dscale = 1.0_DP
      dvelX = 0.0_DP
      dvelY = 0.0_DP
      dvelZ = 0.0_DP
      bvelConst = .true.
      btensor = .false.
      ix = 1
      iy = 1
      
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        
        ! Tensor target
        btensor = (rcollection%IquickAccess(3) .ne. 0)
        
        ! Constant velocity?
        bvelConst = (rcollection%IquickAccess(4) .eq. 0)
        
        if (bvelConst) then
          ! Get the constant velocity
          dvelX = rcollection%DquickAccess(2)
          if (ndim .ge. NDIM2D) dvelY = rcollection%DquickAccess(3)
          if (ndim .ge. NDIM3D) dvelZ = rcollection%DquickAccess(4)
        end if
        
        ! Position
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
      end if
      
      if (.not. btensor) then
        if (bvelConst) then
          call bma_docalc_convec_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
              npointsPerElement,nelements,dscale,iy,ix,dvelX,dvelY,dvelZ)
        else
          call bma_docalc_convec_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
              npointsPerElement,nelements,dscale,iy,ix,rvectorField=revalVectors%p_RvectorData(1))
        end if
      else
        if (bvelConst) then
          call bma_docalc_convecTens_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
              npointsPerElement,nelements,dscale,iy,ix,dvelX,dvelY,dvelZ)
        else
          call bma_docalc_convecTens_ugradvw(RmatrixData,rassemblyData,rmatrixAssembly,&
              npointsPerElement,nelements,dscale,iy,ix,rvectorField=revalVectors%p_RvectorData(1))
        end if
      end if
  
    end subroutine
      
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_convecTens_vugradw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,du1,du2,du3,rvectorField)
  
  !<description>  
      ! Calculates a convection operator "( v, (u grad) w )" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function
      ! and a scaling factor dscale in front.
      ! v is the trial and w the test basis function.
      !
      ! If rvectorField is not specified, a constant velocity du1/du2/du3
      ! is assumed, and du1/du2/du3 must be present.
      ! If rvectorField is specified, it describes the underlying vector field.
  !</description>
  
  !<remarks>
      ! Remark 1:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 3:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Scaling factor
      real(DP), intent(in) :: dscale
      
      ! Position in the global matrix where to assemble
      integer, intent(in) :: iy,ix
      
      ! OPTIONAL: Constant velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1,du2,du3
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasJ, dbasIx, dbasIy, dbasIz
      integer :: iel, icubp, idofe, jdofe
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11,p_DlocalMatrix22,p_DlocalMatrix33
      type(t_bmaMatrixData), pointer :: p_rmatrixData11,p_rmatrixData22,p_rmatrixData33
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:,:,:), pointer :: p_Du
  
      integer :: ndim
      real(DP) :: dvelX,dvelY,dvelZ
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      bvelConst = present(rvectorField)
      if (bvelConst) then
        dvelX = 0.0_DP
        dvelY = 0.0_DP
        dvelZ = 0.0_DP
  
        ! Constant velocity
        if (present(du1)) dvelX = du1
        if (present(du2)) dvelY = du2
        if (present(du3)) dvelZ = du3
      else
        ! Get the velocity field from the parameters
        p_Du => rvectorField%p_DdataVec
      end if
      
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! Set up the local matrix of the convection.
      select case (ndim)
      case (NDIM1D)
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vugradw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vugradw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasIx = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx )            ! ( phi , u1 psi_x )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx )            ! ( phi , u1 psi_x )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
        
      case (NDIM2D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. p_rmatrixData22%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vugradw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vugradw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy )            ! ( phi , u2 psi_y )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy )            ! ( phi , u2 psi_y )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              dvelY = p_Du(2,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy )            ! ( phi , u2 psi_y )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy )            ! ( phi , u2 psi_y )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      case (NDIM3D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        p_rmatrixData33 => RmatrixData(iy+2,ix+2)
  
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
        p_DlocalMatrix33 => RmatrixData(iy+2,ix+2)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. &
            p_rmatrixData22%bisInterleaved .or. &
            p_rmatrixData33%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vugradw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vugradw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy + &          ! ( phi , u2 psi_y )
                        dbasJ * dvelZ * dbasIz )            ! ( phi , u3 psi_z )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy + &          ! ( phi , u2 psi_y )
                        dbasJ * dvelZ * dbasIz )            ! ( phi , u3 psi_z )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy + &          ! ( phi , u2 psi_y )
                        dbasJ * dvelZ * dbasIz )            ! ( phi , u3 psi_z )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX = p_Du(1,icubp,iel,DER_FUNC)
              dvelY = p_Du(2,icubp,iel,DER_FUNC)
              dvelZ = p_Du(3,icubp,iel,DER_FUNC)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy + &          ! ( phi , u2 psi_y )
                        dbasJ * dvelZ * dbasIz )            ! ( phi , u3 psi_z )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy + &          ! ( phi , u2 psi_y )
                        dbasJ * dvelZ * dbasIz )            ! ( phi , u3 psi_z )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX * dbasIx + &          ! ( phi , u1 psi_x )
                        dbasJ * dvelY * dbasIy + &          ! ( phi , u2 psi_y )
                        dbasJ * dvelZ * dbasIz )            ! ( phi , u3 psi_z )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_convecTens_vugradw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a convection operator "( v, (u grad) w )" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function.
      ! v is the trial and w the test basis function.
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! in all diagonal blocks with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      !
      ! rcollection%DquickAccess(1) = multiplier in front of the operator.
      ! rcollection%IquickAccess(1) = y-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(2) = x-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(3) = 0, if the convection is a constant vector field.
      !                                  in this case:
      !                                  1D: rcollection%DquickAccess(2)   = x-velocity
      !                                  2D: rcollection%DquickAccess(2:3) = x/y-velocity
      !                                  3D: rcollection%DquickAccess(2:4) = x/y/z-velocity
      !                             = 1, if the convection is specified by a
      !                                  finite element velocity field. In this case,
      !                                  a finite element velocity field must be specified
      !                                  as parameter revalVectors to the call of 
      !                                  bma_buildMatrix.
  !</description>
  
  !<remarks>
      ! Remark 1: 
      ! Using the routines from feevaluation2, it is possible to specify
      ! a nonconstant velocity field. The corresponding code looks as follows:
      !
      ! <verb>
      !     use feevaluation2
      !
      !     ...
      !
      !     type(t_collection) :: rcollection
      !     type(t_scalarCubatureInfo) :: rcubatureInfo   ! Cubature formula
      !     type(t_matrixBlock) :: rmatrix                ! Matrix to be calculated
      !
      !     type(t_vectorBlock) :: rvelocity        ! The velocity field
      !     type(t_fev2Vectors) :: revalVectors     ! Collection of vectors to evaluate
      !
      !     ! Prepare the cubature formula
      !     call spdiscr_createDefCubStructure (..., rcubatureInfo, CUB_GEN_AUTO)
      !
      !     ...
      !
      !     rcollection%IquickAccess(1) = 1          ! y-Position in the matrix
      !     rcollection%IquickAccess(2) = 1          ! x-Position in the matrix
      !     rcollection%IquickAccess(3) = 1          ! Nonconstant viscosity
      !     rcollection%DquickAccess(1) = 1.0_DP     ! Scaling
      !
      !     ! Add the X-, Y- and Z-velocity to revalVectors
      !     call fev2_addVectorFieldToEvalList(revalVectors,0,&
      !         rvelocity%RvectorBlock(1),rvelocity%RvectorBlock(2),rvelocity%RvectorBlock(3))
      !
      !     ! Set up the matrix
      !     call bma_buildMatrix (rmatrix,BMA_CALC_STANDARD, bma_fcalc_convecTens_vugradw, &
      !         rcollection, revalVectors=revalVectors,rcubatureInfo=rcubatureInfo)
      !
      !     ! Release the vector structure
      !     call fev2_releaseVectorList(revalVectors)
      !
      !     ...
      !
      !     ! Release the cubature formula
      !     call spdiscr_releaseCubStructure (rcubatureInfo)
      ! </verb>
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 3:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 4:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! Local variables
      integer :: ndim,iy,ix
      real(DP) :: dscale
      real(DP) :: dvelX, dvelY, dvelZ
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      dscale = 1.0_DP
      dvelX = 0.0_DP
      dvelY = 0.0_DP
      dvelZ = 0.0_DP
      bvelConst = .true.
      ix = 1
      iy = 1
      
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        
        ! Constant velocity?
        bvelConst = (rcollection%IquickAccess(3) .eq. 0)
        
        if (bvelConst) then
          ! Get the constant velocity
          dvelX = rcollection%DquickAccess(2)
          if (ndim .ge. NDIM2D) dvelY = rcollection%DquickAccess(3)
          if (ndim .ge. NDIM3D) dvelZ = rcollection%DquickAccess(4)
        end if
        
        ! Position
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
      end if
      
      if (bvelConst) then
        call bma_docalc_convecTens_vugradw(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy,ix,dvelX,dvelY,dvelZ)
      else
        call bma_docalc_convecTens_vugradw(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy,ix,rvectorField=revalVectors%p_RvectorData(1))
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_convecTens_graduvw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,&
        du1x,du1y,du1z,du2x,du2y,du2z,du3x,du3y,du3z,rvectorField)
  
  !<description>  
      ! Calculates a convection operator "( (grad u) v, w)" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function
      ! and a scaling factor dscale in front.
      ! v is the trial and w the test basis function.
      !
      ! If rvectorField is not specified, a constant velocity derivative
      ! du1x,du1y,du1z,du2x,du2y,du2z,du3x,du3y,du3z
      ! is assumed, and (duIJ) must be present.
      ! If rvectorField is specified, it describes the underlying vector field.
  !</description>
  
  !<remarks>
      ! Remark 1:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 3:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Scaling factor
      real(DP), intent(in) :: dscale
      
      ! Position in the global matrix where to assemble
      integer, intent(in) :: iy,ix
      
      ! OPTIONAL: Derivative of the velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1x,du1y,du1z,du2x,du2y,du2z,du3x,du3y,du3z
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dbasJ
      integer :: iel, icubp, idofe, jdofe
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11,p_DlocalMatrix12,p_DlocalMatrix13
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix21,p_DlocalMatrix22,p_DlocalMatrix23
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix31,p_DlocalMatrix32,p_DlocalMatrix33
      type(t_bmaMatrixData), pointer :: p_rmatrixData11,p_rmatrixData12,p_rmatrixData13
      type(t_bmaMatrixData), pointer :: p_rmatrixData21,p_rmatrixData22,p_rmatrixData23
      type(t_bmaMatrixData), pointer :: p_rmatrixData31,p_rmatrixData32,p_rmatrixData33
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:,:,:), pointer :: p_Du
  
      integer :: ndim
      real(DP) :: dvelX1, dvelX2, dvelX3
      real(DP) :: dvelY1, dvelY2, dvelY3
      real(DP) :: dvelZ1, dvelZ2, dvelZ3
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      bvelConst = present(rvectorField)
      if (bvelConst) then
        dvelX1 = 0.0_DP
        dvelX2 = 0.0_DP
        dvelX3 = 0.0_DP
        
        dvelY1 = 0.0_DP
        dvelY2 = 0.0_DP
        dvelY3 = 0.0_DP
        
        dvelZ1 = 0.0_DP
        dvelZ2 = 0.0_DP
        dvelZ3 = 0.0_DP
  
        ! Constant velocity derivative
        if (present(du1x)) dvelX1 = du1x
        if (present(du1y)) dvelX2 = du1y
        if (present(du1z)) dvelX3 = du1z
        if (present(du2x)) dvelY1 = du2x
        if (present(du2y)) dvelY2 = du2y
        if (present(du2z)) dvelY3 = du2z
        if (present(du3x)) dvelZ1 = du3x
        if (present(du3y)) dvelZ2 = du3y
        if (present(du3z)) dvelZ3 = du3z
      else
        ! Get the velocity field from the parameters
        p_Du => rvectorField%p_DdataVec
      end if
      
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! Set up the local matrix of the convection.
      select case (ndim)
      case (NDIM1D)
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_graduvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_graduvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX1 * dbasJ * dbasI )            ! ( u1_x phi , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX1 = p_Du(1,icubp,iel,DER_DERIV1D_X)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX1 * dbasJ * dbasI )            ! ( u1_x phi , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
        
      case (NDIM2D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData12 => RmatrixData(iy,ix+1)
        p_rmatrixData21 => RmatrixData(iy+1,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix12 => RmatrixData(iy,ix+1)%p_Dentry
        p_DlocalMatrix21 => RmatrixData(iy+1,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. &
            p_rmatrixData12%bisInterleaved .or. &
            p_rmatrixData21%bisInterleaved .or. &
            p_rmatrixData22%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_graduvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_graduvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX1 * dbasJ * dbasI )            ! ( u1_x phi , psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX2 * dbasJ * dbasI )            ! ( u1_y phi , psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY1 * dbasJ * dbasI )            ! ( u2_x phi , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY2 * dbasJ * dbasI )            ! ( u2_y phi , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX1 = p_Du(1,icubp,iel,DER_DERIV2D_X)
              dvelY1 = p_Du(2,icubp,iel,DER_DERIV2D_X)
              dvelX2 = p_Du(1,icubp,iel,DER_DERIV2D_Y)
              dvelY2 = p_Du(2,icubp,iel,DER_DERIV2D_Y)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX1 * dbasJ * dbasI )            ! ( u1_x phi , psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX2 * dbasJ * dbasI )            ! ( u1_y phi , psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY1 * dbasJ * dbasI )            ! ( u2_x phi , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY2 * dbasJ * dbasI )            ! ( u2_y phi , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      case (NDIM3D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData12 => RmatrixData(iy,ix+1)
        p_rmatrixData13 => RmatrixData(iy,ix+2)
        p_rmatrixData21 => RmatrixData(iy+1,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        p_rmatrixData23 => RmatrixData(iy+1,ix+2)
        p_rmatrixData31 => RmatrixData(iy+2,ix)
        p_rmatrixData32 => RmatrixData(iy+2,ix+1)
        p_rmatrixData33 => RmatrixData(iy+2,ix+2)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix12 => RmatrixData(iy,ix+1)%p_Dentry
        p_DlocalMatrix13 => RmatrixData(iy,ix+3)%p_Dentry
        p_DlocalMatrix21 => RmatrixData(iy+1,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
        p_DlocalMatrix23 => RmatrixData(iy+1,ix+3)%p_Dentry
        p_DlocalMatrix31 => RmatrixData(iy+2,ix)%p_Dentry
        p_DlocalMatrix32 => RmatrixData(iy+2,ix+1)%p_Dentry
        p_DlocalMatrix33 => RmatrixData(iy+2,ix+3)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if ( p_rmatrixData11%bisInterleaved .or. &
             p_rmatrixData12%bisInterleaved .or. &
             p_rmatrixData13%bisInterleaved .or. &
             p_rmatrixData21%bisInterleaved .or. &
             p_rmatrixData22%bisInterleaved .or. &
             p_rmatrixData23%bisInterleaved .or. &
             p_rmatrixData31%bisInterleaved .or. &
             p_rmatrixData32%bisInterleaved .or. &
             p_rmatrixData33%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_graduvw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_graduvw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX1 * dbasJ * dbasI )            ! ( u1_x phi , psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX2 * dbasJ * dbasI )            ! ( u1_y phi , psi )
  
                  p_DlocalMatrix13(jdofe,idofe,iel) = p_DlocalMatrix13(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX3 * dbasJ * dbasI )            ! ( u1_y phi , psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY1 * dbasJ * dbasI )            ! ( u2_x phi , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY2 * dbasJ * dbasI )            ! ( u2_y phi , psi )
  
                  p_DlocalMatrix23(jdofe,idofe,iel) = p_DlocalMatrix23(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY3 * dbasJ * dbasI )            ! ( u2_y phi , psi )
  
                  p_DlocalMatrix31(jdofe,idofe,iel) = p_DlocalMatrix31(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelZ1 * dbasJ * dbasI )            ! ( u3_x phi , psi )
  
                  p_DlocalMatrix32(jdofe,idofe,iel) = p_DlocalMatrix32(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelZ2 * dbasJ * dbasI )            ! ( u3_y phi , psi )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelZ3 * dbasJ * dbasI )            ! ( u3_y phi , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX1 = p_Du(1,icubp,iel,DER_DERIV3D_X)
              dvelY1 = p_Du(2,icubp,iel,DER_DERIV3D_X)
              dvelZ1 = p_Du(3,icubp,iel,DER_DERIV3D_X)
  
              dvelX2 = p_Du(1,icubp,iel,DER_DERIV3D_Y)
              dvelY2 = p_Du(2,icubp,iel,DER_DERIV3D_Y)
              dvelZ2 = p_Du(3,icubp,iel,DER_DERIV3D_Y)
  
              dvelX3 = p_Du(1,icubp,iel,DER_DERIV3D_Z)
              dvelY3 = p_Du(2,icubp,iel,DER_DERIV3D_Z)
              dvelZ3 = p_Du(3,icubp,iel,DER_DERIV3D_Z)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX1 * dbasJ * dbasI )            ! ( u1_x phi , psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX2 * dbasJ * dbasI )            ! ( u1_y phi , psi )
  
                  p_DlocalMatrix13(jdofe,idofe,iel) = p_DlocalMatrix13(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelX3 * dbasJ * dbasI )            ! ( u1_y phi , psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY1 * dbasJ * dbasI )            ! ( u2_x phi , psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY2 * dbasJ * dbasI )            ! ( u2_y phi , psi )
  
                  p_DlocalMatrix23(jdofe,idofe,iel) = p_DlocalMatrix23(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelY3 * dbasJ * dbasI )            ! ( u2_y phi , psi )
  
                  p_DlocalMatrix31(jdofe,idofe,iel) = p_DlocalMatrix31(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelZ1 * dbasJ * dbasI )            ! ( u3_x phi , psi )
  
                  p_DlocalMatrix32(jdofe,idofe,iel) = p_DlocalMatrix32(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelZ2 * dbasJ * dbasI )            ! ( u3_y phi , psi )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dvelZ3 * dbasJ * dbasI )            ! ( u3_y phi , psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_convecTens_graduvw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a convection operator "( (grad u) v, w)" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function.
      ! v is the trial and w the test basis function.
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! in all diagonal blocks with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      !
      ! rcollection%DquickAccess(1) = multiplier in front of the operator.
      ! rcollection%IquickAccess(1) = y-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(2) = x-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(3) = 0, if the convection is a constant vector field.
      !                                  in this case:
      !                                  1D: rcollection%DquickAccess(2)   = d/dx x-velocity
      !                                  2D: rcollection%DquickAccess(2:3) = (d/dx,d/dy) x-velocity
      !                                      rcollection%DquickAccess(4:5) = (d/dx,d/dy) y-velocity
      !                                  3D: rcollection%DquickAccess(2:4) = (d/dx,d/dy,d/dz) x-velocity
      !                                      rcollection%DquickAccess(5:7) = (d/dx,d/dy,d/dz) y-velocity
      !                                      rcollection%DquickAccess(8:10) = (d/dx,d/dy,d/dz) z-velocity
      !                             = 1, if The convection is specified by a
      !                                  finite element velocity field. In this case,
      !                                  a finite element velocity field must be specified
      !                                  as parameter revalVectors to the call of 
      !                                  bma_buildMatrix.
  !</description>
  
  !<remarks>
      ! Remark 1: 
      ! Using the routines from feevaluation2, it is possible to specify
      ! a nonconstant velocity field. The corresponding code looks as follows:
      !
      ! <verb>
      !     use feevaluation2
      !
      !     ...
      !
      !     type(t_collection) :: rcollection
      !     type(t_scalarCubatureInfo) :: rcubatureInfo   ! Cubature formula
      !     type(t_matrixBlock) :: rmatrix                ! Matrix to be calculated
      !
      !     type(t_vectorBlock) :: rvelocity        ! The velocity field
      !     type(t_fev2Vectors) :: revalVectors     ! Collection of vectors to evaluate
      !
      !     ! Prepare the cubature formula
      !     call spdiscr_createDefCubStructure (..., rcubatureInfo, CUB_GEN_AUTO)
      !
      !     ...
      !
      !     rcollection%IquickAccess(1) = 1          ! y-Position in the matrix
      !     rcollection%IquickAccess(2) = 1          ! x-Position in the matrix
      !     rcollection%IquickAccess(3) = 1          ! Nonconstant viscosity
      !     rcollection%DquickAccess(1) = 1.0_DP     ! Scaling
      !
      !     ! Add the X-, Y- and Z-velocity to revalVectors
      !     call fev2_addVectorFieldToEvalList(revalVectors,1,&
      !         rvelocity%RvectorBlock(1),rvelocity%RvectorBlock(2),rvelocity%RvectorBlock(3))
      !
      !     ! Set up the matrix
      !     call bma_buildMatrix (rmatrix,BMA_CALC_STANDARD, bma_fcalc_convecTens_graduvw, &
      !         rcollection, revalVectors=revalVectors,rcubatureInfo=rcubatureInfo)
      !
      !     ! Release the vector structure
      !     call fev2_releaseVectorList(revalVectors)
      !
      !     ...
      !
      !     ! Release the cubature formula
      !     call spdiscr_releaseCubStructure (rcubatureInfo)
      ! </verb>
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 3:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 4:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! Local variables
      integer :: ndim,iy,ix
      real(DP) :: dscale
      real(DP) :: dvelX1, dvelX2, dvelX3
      real(DP) :: dvelY1, dvelY2, dvelY3
      real(DP) :: dvelZ1, dvelZ2, dvelZ3
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      dscale = 1.0_DP
      dvelX1 = 0.0_DP
      dvelX2 = 0.0_DP
      dvelX3 = 0.0_DP
      
      dvelY1 = 0.0_DP
      dvelY2 = 0.0_DP
      dvelY3 = 0.0_DP
      
      dvelZ1 = 0.0_DP
      dvelZ2 = 0.0_DP
      dvelZ3 = 0.0_DP
      
      bvelConst = .true.
      ix = 1
      iy = 1
      
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        
        ! Constant velocity?
        bvelConst = (rcollection%IquickAccess(3) .eq. 0)
        
        if (bvelConst) then
          ! Get the constant velocity
          dvelX1 = rcollection%DquickAccess(2)
          if (ndim .ge. NDIM2D) then
            dvelX2 = rcollection%DquickAccess(3)
            
            dvelY1 = rcollection%DquickAccess(4)
            dvelY2 = rcollection%DquickAccess(5)
          end if
          if (ndim .ge. NDIM3D) then
            dvelX2 = rcollection%DquickAccess(3)
            dvelX3 = rcollection%DquickAccess(4)
            
            dvelY1 = rcollection%DquickAccess(5)
            dvelY2 = rcollection%DquickAccess(6)
            dvelY3 = rcollection%DquickAccess(7)
            
            dvelZ1 = rcollection%DquickAccess(8)
            dvelZ2 = rcollection%DquickAccess(9)
            dvelZ3 = rcollection%DquickAccess(10)
          end if
        end if
        
        ! Position
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
      end if
      
      if (bvelConst) then
        call bma_docalc_convecTens_graduvw(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy,ix,&
            dvelX1,dvelX2,dvelX3,dvelY1,dvelY2,dvelY3,dvelZ1,dvelZ2,dvelZ3)
      else
        call bma_docalc_convecTens_graduvw(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy,ix,rvectorField=revalVectors%p_RvectorData(1))
      end if
  
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_convecTens_vgraduw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,&
        du1x,du1y,du1z,du2x,du2y,du2z,du3x,du3y,du3z,rvectorField)
  
  !<description>  
      ! Calculates a convection operator "( v, (grad u) w)" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function
      ! and a scaling factor dscale in front.
      ! v is the trial and w the test basis function.
      !
      ! If rvectorField is not specified, a constant velocity derivative
      ! du1x,du1y,du1z,du2x,du2y,du2z,du3x,du3y,du3z
      ! is assumed, and (duIJ) must be present.
      ! If rvectorField is specified, it describes the underlying vector field.
  !</description>
  
  !<remarks>
      ! Remark 1:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 3:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Scaling factor
      real(DP), intent(in) :: dscale
      
      ! Position in the global matrix where to assemble
      integer, intent(in) :: iy,ix
      
      ! OPTIONAL: Derivative of the velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1x,du1y,du1z,du2x,du2y,du2z,du3x,du3y,du3z
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dbasJ
      integer :: iel, icubp, idofe, jdofe
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11,p_DlocalMatrix12,p_DlocalMatrix13
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix21,p_DlocalMatrix22,p_DlocalMatrix23
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix31,p_DlocalMatrix32,p_DlocalMatrix33
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData11,p_rmatrixData12,p_rmatrixData13
      type(t_bmaMatrixData), pointer :: p_rmatrixData21,p_rmatrixData22,p_rmatrixData23
      type(t_bmaMatrixData), pointer :: p_rmatrixData31,p_rmatrixData32,p_rmatrixData33
      real(DP), dimension(:,:,:,:), pointer :: p_Du
      
      integer :: ndim
      real(DP) :: dvelX1, dvelX2, dvelX3
      real(DP) :: dvelY1, dvelY2, dvelY3
      real(DP) :: dvelZ1, dvelZ2, dvelZ3
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      bvelConst = present(rvectorField)
      if (bvelConst) then
        dvelX1 = 0.0_DP
        dvelX2 = 0.0_DP
        dvelX3 = 0.0_DP
        
        dvelY1 = 0.0_DP
        dvelY2 = 0.0_DP
        dvelY3 = 0.0_DP
        
        dvelZ1 = 0.0_DP
        dvelZ2 = 0.0_DP
        dvelZ3 = 0.0_DP
  
        ! Constant velocity derivative
        if (present(du1x)) dvelX1 = du1x
        if (present(du1y)) dvelX2 = du1y
        if (present(du1z)) dvelX3 = du1z
        if (present(du2x)) dvelY1 = du2x
        if (present(du2y)) dvelY2 = du2y
        if (present(du2z)) dvelY3 = du2z
        if (present(du3x)) dvelZ1 = du3x
        if (present(du3y)) dvelZ2 = du3y
        if (present(du3z)) dvelZ3 = du3z
      else
        ! Get the velocity field from the parameters
        p_Du => rvectorField%p_DdataVec
      end if
      
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
  
      ! Set up the local matrix of the convection.
      select case (ndim)
      case (NDIM1D)
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vgraduw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vgraduw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX1 * dbasI )            ! ( phi , u1_x psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX1 = p_Du(1,icubp,iel,DER_DERIV1D_X)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX1 * dbasI )            ! ( phi , u1_x psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
        
      case (NDIM2D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData12 => RmatrixData(iy,ix+1)
        p_rmatrixData21 => RmatrixData(iy+1,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix12 => RmatrixData(iy,ix+1)%p_Dentry
        p_DlocalMatrix21 => RmatrixData(iy+1,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. &
            p_rmatrixData12%bisInterleaved .or. &
            p_rmatrixData21%bisInterleaved .or. &
            p_rmatrixData22%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vgraduw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vgraduw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX1 * dbasI )            ! ( phi , u1_x psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY1 * dbasI )            ! ( phi , u2_x psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX2 * dbasI )            ! ( phi , u1_y psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY2 * dbasI )            ! ( phi , u2_y psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX1 = p_Du(1,icubp,iel,DER_DERIV2D_X)
              dvelY1 = p_Du(2,icubp,iel,DER_DERIV2D_X)
  
              dvelX2 = p_Du(1,icubp,iel,DER_DERIV2D_Y)
              dvelY2 = p_Du(2,icubp,iel,DER_DERIV2D_Y)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_FUNC,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX1 * dbasI )            ! ( phi , u1_x psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY1 * dbasI )            ! ( phi , u2_x psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX2 * dbasI )            ! ( phi , u1_y psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY2 * dbasI )            ! ( phi , u2_y psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      case (NDIM3D)
  
        ! Matrices to be set up
        p_rmatrixData11 => RmatrixData(iy,ix)
        p_rmatrixData12 => RmatrixData(iy,ix+1)
        p_rmatrixData13 => RmatrixData(iy,ix+2)
        p_rmatrixData21 => RmatrixData(iy+1,ix)
        p_rmatrixData22 => RmatrixData(iy+1,ix+1)
        p_rmatrixData23 => RmatrixData(iy+1,ix+2)
        p_rmatrixData31 => RmatrixData(iy+2,ix)
        p_rmatrixData32 => RmatrixData(iy+2,ix+1)
        p_rmatrixData33 => RmatrixData(iy+2,ix+2)
        
        p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
        p_DlocalMatrix12 => RmatrixData(iy,ix+1)%p_Dentry
        p_DlocalMatrix13 => RmatrixData(iy,ix+3)%p_Dentry
        p_DlocalMatrix21 => RmatrixData(iy+1,ix)%p_Dentry
        p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
        p_DlocalMatrix23 => RmatrixData(iy+1,ix+3)%p_Dentry
        p_DlocalMatrix31 => RmatrixData(iy+2,ix)%p_Dentry
        p_DlocalMatrix32 => RmatrixData(iy+2,ix+1)%p_Dentry
        p_DlocalMatrix33 => RmatrixData(iy+2,ix+3)%p_Dentry
  
        ! Currently, interleaved matrices are not supported
        if (p_rmatrixData11%bisInterleaved .or. &
            p_rmatrixData12%bisInterleaved .or. &
            p_rmatrixData13%bisInterleaved .or. &
            p_rmatrixData21%bisInterleaved .or. &
            p_rmatrixData22%bisInterleaved .or. &
            p_rmatrixData23%bisInterleaved .or. &
            p_rmatrixData31%bisInterleaved .or. &
            p_rmatrixData32%bisInterleaved .or. &
            p_rmatrixData33%bisInterleaved) then
          call output_line ("Interleaved matrices not supported",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vgraduw")
          call sys_halt()
        end if
  
        if ((p_rmatrixData11%ndimfeTrial .ne. 1) .or. &
            (p_rmatrixData11%ndimfeTest .ne. 1)) then
          ! This does not make sense.
          call output_line ("Only scalar-valued FE spaces supported.",&
              OU_CLASS_ERROR,OU_MODE_STD,"bma_docalc_convecTens_vgraduw")
          call sys_halt()
        end if
  
        if (bvelConst) then
        
          ! Set up the matrix for constant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX1 * dbasI )            ! ( phi , u1_x psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY1 * dbasI )            ! ( phi , u2_x psi )
  
                  p_DlocalMatrix13(jdofe,idofe,iel) = p_DlocalMatrix13(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelZ1 * dbasI )            ! ( phi , u3_x psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX2 * dbasI )            ! ( phi , u1_y psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY2 * dbasI )            ! ( phi , u2_y psi )
  
                  p_DlocalMatrix23(jdofe,idofe,iel) = p_DlocalMatrix23(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelZ2 * dbasI )            ! ( phi , u3_y psi )
  
                  p_DlocalMatrix31(jdofe,idofe,iel) = p_DlocalMatrix31(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX3 * dbasI )            ! ( phi , u1_z psi )
  
                  p_DlocalMatrix32(jdofe,idofe,iel) = p_DlocalMatrix32(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY3 * dbasI )            ! ( phi , u2_z psi )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelZ3 * dbasI )            ! ( phi , u3_z psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        else
  
          ! Set up the matrix for nonconstant velocity.
        
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Velocity field in this cubature point
              dvelX1 = p_Du(1,icubp,iel,DER_DERIV3D_X)
              dvelX2 = p_Du(1,icubp,iel,DER_DERIV3D_Y)
              dvelZ1 = p_Du(3,icubp,iel,DER_DERIV3D_X)
  
              dvelY1 = p_Du(2,icubp,iel,DER_DERIV3D_X)
              dvelY2 = p_Du(2,icubp,iel,DER_DERIV3D_Y)
              dvelZ2 = p_Du(3,icubp,iel,DER_DERIV3D_Y)
  
              dvelX3 = p_Du(1,icubp,iel,DER_DERIV3D_Z)
              dvelY3 = p_Du(2,icubp,iel,DER_DERIV3D_Z)
              dvelZ3 = p_Du(3,icubp,iel,DER_DERIV3D_Z)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rmatrixData11%ndofTest
  
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe,DER_FUNC,icubp,iel)
  
                ! Inner loop over the DOF's j=1..ndof, which corresponds to
                ! the (trial) basis function Phi_j:
                do jdofe=1,p_rmatrixData11%ndofTrial
  
                  ! Fetch the contributions of the (trial) basis function Phi_j
                  ! into dbasJ
                  dbasJ = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                  
                  ! Multiply the values of the basis functions
                  ! (1st derivatives) by the cubature weight and sum up
                  ! into the local matrices.
                  p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX1 * dbasI )            ! ( phi , u1_x psi )
  
                  p_DlocalMatrix12(jdofe,idofe,iel) = p_DlocalMatrix12(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY1 * dbasI )            ! ( phi , u2_x psi )
  
                  p_DlocalMatrix13(jdofe,idofe,iel) = p_DlocalMatrix13(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelZ1 * dbasI )            ! ( phi , u3_x psi )
  
                  p_DlocalMatrix21(jdofe,idofe,iel) = p_DlocalMatrix21(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX2 * dbasI )            ! ( phi , u1_y psi )
  
                  p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY2 * dbasI )            ! ( phi , u2_y psi )
  
                  p_DlocalMatrix23(jdofe,idofe,iel) = p_DlocalMatrix23(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelZ2 * dbasI )            ! ( phi , u3_y psi )
  
                  p_DlocalMatrix31(jdofe,idofe,iel) = p_DlocalMatrix31(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelX3 * dbasI )            ! ( phi , u1_z psi )
  
                  p_DlocalMatrix32(jdofe,idofe,iel) = p_DlocalMatrix32(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelY3 * dbasI )            ! ( phi , u2_z psi )
  
                  p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                      dscale * p_DcubWeight(icubp,iel) * &
                      ( dbasJ * dvelZ3 * dbasI )            ! ( phi , u3_z psi )
  
                end do ! jdofe
  
              end do ! idofe
  
            end do ! icubp
  
          end do ! iel
          
        end if
  
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_convecTens_vgraduw(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a convection operator "( v, (grad u) w)" to a tensor at position (x,y)
      ! of a block matrix, with a convection u given as a finite element function.
      ! v is the trial and w the test basis function.
      !
      ! Note: If rcollection is not specified, the matrix is calculated
      ! in all diagonal blocks with a multiplier of 1.
      ! If rcollection is specified, the following parameters are expected:
      !
      ! rcollection%DquickAccess(1) = multiplier in front of the operator.
      ! rcollection%IquickAccess(1) = y-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(2) = x-position in the matrix where to set up the operator.
      ! rcollection%IquickAccess(3) = 0, if the convection is a constant vector field.
      !                                  in this case:
      !                                  1D: rcollection%DquickAccess(2)   = d/dx x-velocity
      !                                  2D: rcollection%DquickAccess(2:3) = (d/dx,d/dy) x-velocity
      !                                      rcollection%DquickAccess(4:5) = (d/dx,d/dy) y-velocity
      !                                  3D: rcollection%DquickAccess(2:4) = (d/dx,d/dy,d/dz) x-velocity
      !                                      rcollection%DquickAccess(5:7) = (d/dx,d/dy,d/dz) y-velocity
      !                                      rcollection%DquickAccess(8:10) = (d/dx,d/dy,d/dz) z-velocity
      !                             = 1, if The convection is specified by a
      !                                  finite element velocity field. In this case,
      !                                  a finite element velocity field must be specified
      !                                  as parameter revalVectors to the call of 
      !                                  bma_buildMatrix.
  !</description>
  
  !<remarks>
      ! Remark 1: 
      ! Using the routines from feevaluation2, it is possible to specify
      ! a nonconstant velocity field. The corresponding code looks as follows:
      !
      ! <verb>
      !     use feevaluation2
      !
      !     ...
      !
      !     type(t_collection) :: rcollection
      !     type(t_scalarCubatureInfo) :: rcubatureInfo   ! Cubature formula
      !     type(t_matrixBlock) :: rmatrix                ! Matrix to be calculated
      !
      !     type(t_vectorBlock) :: rvelocity        ! The velocity field
      !     type(t_fev2Vectors) :: revalVectors     ! Collection of vectors to evaluate
      !
      !     ! Prepare the cubature formula
      !     call spdiscr_createDefCubStructure (..., rcubatureInfo, CUB_GEN_AUTO)
      !
      !     ...
      !
      !     rcollection%IquickAccess(1) = 1          ! y-Position in the matrix
      !     rcollection%IquickAccess(2) = 1          ! x-Position in the matrix
      !     rcollection%IquickAccess(3) = 1          ! Nonconstant viscosity
      !     rcollection%DquickAccess(1) = 1.0_DP     ! Scaling
      !
      !     ! Add the X-, Y- and Z-velocity to revalVectors
      !     call fev2_addVectorFieldToEvalList(revalVectors,1,&
      !         rvelocity%RvectorBlock(1),rvelocity%RvectorBlock(2),rvelocity%RvectorBlock(3))
      !
      !     ! Set up the matrix
      !     call bma_buildMatrix (rmatrix,BMA_CALC_STANDARD, bma_fcalc_convecTens_graduvw, &
      !         rcollection, revalVectors=revalVectors,rcubatureInfo=rcubatureInfo)
      !
      !     ! Release the vector structure
      !     call fev2_releaseVectorList(revalVectors)
      !
      !     ...
      !
      !     ! Release the cubature formula
      !     call spdiscr_releaseCubStructure (rcubatureInfo)
      ! </verb>
      !
      ! Remark 2:
      ! The routine currently assumes that all velocity components are discretised
      ! with the same FEM space.
      !
      ! Remark 3:
      ! The routine currently assumes that all velocity matrices are independent.
      ! Matrices sharing data are not supported. This cound be realised by
      ! taking care of the flags RmatrixData(:,:)%bsharedMatrixData which indicate
      ! which matrix data is shared.
      !
      ! Remark 4:
      ! Interleaved matrices are currently not supported.
  !</remarks>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! Local variables
      integer :: ndim,iy,ix
      real(DP) :: dscale
      real(DP) :: dvelX1, dvelX2, dvelX3
      real(DP) :: dvelY1, dvelY2, dvelY3
      real(DP) :: dvelZ1, dvelZ2, dvelZ3
      logical :: bvelConst
  
      ! Dimension of the underlying space
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get parameters
      dscale = 1.0_DP
      dvelX1 = 0.0_DP
      dvelX2 = 0.0_DP
      dvelX3 = 0.0_DP
      
      dvelY1 = 0.0_DP
      dvelY2 = 0.0_DP
      dvelY3 = 0.0_DP
      
      dvelZ1 = 0.0_DP
      dvelZ2 = 0.0_DP
      dvelZ3 = 0.0_DP
      
      bvelConst = .true.
      ix = 1
      iy = 1
      
      if (present(rcollection)) then
        dscale = rcollection%DquickAccess(1)
        
        ! Constant velocity?
        bvelConst = (rcollection%IquickAccess(3) .eq. 0)
        
        if (bvelConst) then
          ! Get the constant velocity
          dvelX1 = rcollection%DquickAccess(2)
          if (ndim .ge. NDIM2D) then
            dvelX2 = rcollection%DquickAccess(3)
            
            dvelY1 = rcollection%DquickAccess(4)
            dvelY2 = rcollection%DquickAccess(5)
          end if
          if (ndim .ge. NDIM3D) then
            dvelX2 = rcollection%DquickAccess(3)
            dvelX3 = rcollection%DquickAccess(4)
            
            dvelY1 = rcollection%DquickAccess(5)
            dvelY2 = rcollection%DquickAccess(6)
            dvelY3 = rcollection%DquickAccess(7)
            
            dvelZ1 = rcollection%DquickAccess(8)
            dvelZ2 = rcollection%DquickAccess(9)
            dvelZ3 = rcollection%DquickAccess(10)
          end if
        end if
        
        ! Position
        iy = rcollection%IquickAccess(1)
        ix = rcollection%IquickAccess(2)
  
      end if
      
      if (bvelConst) then
        call bma_docalc_convecTens_vgraduw(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy,ix,&
            dvelX1,dvelX2,dvelX3,dvelY1,dvelY2,dvelY3,dvelZ1,dvelZ2,dvelZ3)
      else
        call bma_docalc_convecTens_vgraduw(RmatrixData,rassemblyData,rmatrixAssembly,&
            npointsPerElement,nelements,dscale,iy,ix,rvectorField=revalVectors%p_RvectorData(1))
      end if
  
    end subroutine
  
    !****************************************************************************
    !****************************************************************************
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_rhsConst(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,icomp,dval)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f=1 into a specific component.
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! ID of the component where to assemble to.
      integer, intent(in) :: icomp
      
      ! Value of the function.
      real(DP), intent(in) :: dval
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI
      integer :: iel, icubp, idofe, idimfe, ndimfe
      real(DP), dimension(:,:), pointer :: p_DlocalVector
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaVectorData), pointer :: p_rvectorData
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      ! Get the data arrays of the subvector
      p_rvectorData => RvectorData(icomp)
      p_DlocalVector => p_rvectorData%p_Dentry
      p_DbasTest => p_rvectorData%p_DbasTest
    
      ! FE space dimension
      ndimfe = p_rvectorData%ndimfe
  
      ! Loop over the elements in the current set.
      do iel = 1,nelements
  
        ! Loop over all cubature points on the current element
        do icubp = 1,npointsPerElement
  
          ! Loop over the dimensions of the FE space
          do idimfe = 0,ndimfe-1
          
            ! Outer loop over the DOF's i=1..ndof on our current element,
            ! which corresponds to the (test) basis functions Psi_i:
            do idofe=1,p_rvectorData%ndofTest
            
              ! Fetch the contributions of the (test) basis functions Psi_i
              ! into dbasI
              dbasI = p_DbasTest(idofe+idimfe*p_rvectorData%ndofTest,DER_FUNC,icubp,iel)
              
              ! Multiply the values of the basis functions
              ! (1st derivatives) by the cubature weight and sum up
              ! into the local vectors.
              p_DlocalVector(idofe,iel) = p_DlocalVector(idofe,iel) + &
                  p_DcubWeight(icubp,iel) * dval * dbasI
              
            end do ! jdofe
            
          end do ! idimfe
  
        end do ! icubp
      
      end do ! iel
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_rhsConst(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f=constant.
      !
      ! If rcollection is not specified, the rhs is calculated
      ! in all components using the constant value f=constant=1.
      !
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%IquickAccess(1) = Number of the component that should
      !                               receive the RHS.
      ! rcollection%DquickAccess(1) = Value of the function.
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
      
  !</subroutine>
  
      ! Local variables
      integer :: icomp,istartcomp,iendcomp
      real(DP) :: dval
    
      ! Either compute to all components or to a specified one.
      if (present(rcollection)) then
        istartcomp = rcollection%IquickAccess(1)
        iendcomp = rcollection%IquickAccess(1)
        dval = rcollection%DquickAccess(1)
      else
        istartcomp = 1
        iendcomp = size(rvectorData)
        dval = 1.0_DP
      end if
      
      ! Loop over the components
      do icomp = istartcomp,iendcomp
  
        call bma_docalc_rhsConst(rvectorData,rassemblyData,rvectorAssembly,&
            npointsPerElement,nelements,icomp,dval)
        
      end do ! icomp
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_rhsBubble(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,icomp,dscale)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f=dscale*32*y*(1-y)+32*x*(1-x).
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! ID of the component where to assemble to.
      integer, intent(in) :: icomp
      
      ! Scaling factor
      real(DP), intent(in) :: dscale
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dval, dx, dy
      integer :: iel, icubp, idofe, idimfe, ndimfe
      real(DP), dimension(:,:), pointer :: p_DlocalVector
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaVectorData), pointer :: p_rvectorData
      real(DP), dimension(:,:,:), pointer :: p_Dpoints
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get the coordinates of the cubature points
      p_Dpoints => rassemblyData%revalElementSet%p_DpointsReal
      
      ! Get the data arrays of the subvector
      p_rvectorData => RvectorData(icomp)
      p_DlocalVector => p_rvectorData%p_Dentry
      p_DbasTest => p_rvectorData%p_DbasTest
    
      ! FE space dimension
      ndimfe = p_rvectorData%ndimfe
  
      ! Loop over the elements in the current set.
      do iel = 1,nelements
  
        ! Loop over all cubature points on the current element
        do icubp = 1,npointsPerElement
        
          ! Get the coordinates of the cubature point.
          dx = p_Dpoints(1,icubp,iel)
          dy = p_Dpoints(2,icubp,iel)
  
          ! Calculate the values of the RHS using the coordinates
          ! of the cubature points.
          dval = dscale*32.0_DP*dy*(1.0_DP-dy) + 32_DP*dx*(1.0_DP-dx)
          
          ! Loop over the dimensions of the FE space
          do idimfe = 0,ndimfe-1
  
            ! Outer loop over the DOF's i=1..ndof on our current element,
            ! which corresponds to the (test) basis functions Psi_i:
            do idofe=1,p_rvectorData%ndofTest
            
              ! Fetch the contributions of the (test) basis functions Psi_i
              ! into dbasI
              dbasI = p_DbasTest(idofe+idimfe*p_rvectorData%ndofTest,DER_FUNC,icubp,iel)
              
              ! Multiply the values of the basis functions
              ! (1st derivatives) by the cubature weight and sum up
              ! into the local vectors.
              p_DlocalVector(idofe,iel) = p_DlocalVector(idofe,iel) + &
                  p_DcubWeight(icubp,iel) * dval * dbasI
              
            end do ! idofe
            
          end do ! idimfe
  
        end do ! icubp
      
      end do ! iel
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_rhsBubble(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f=dscale*32*y*(1-y)+32*x*(1-x).
      !
      ! If rcollection is not specified, the rhs is calculated
      ! in all components.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%IquickAccess(1) = Number of the component that should
      !                               receive the RHS.
      ! rcollection%DquickAccess(1) = Scaling factor dscale
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dscale
      integer :: icomp,istartcomp,iendcomp
    
      ! Either compute to all components or to a specified one.
      if (present(rcollection)) then
        istartcomp = rcollection%IquickAccess(1)
        iendcomp = rcollection%IquickAccess(1)
        dscale = rcollection%DquickAccess(1)
      else
        istartcomp = 1
        iendcomp = size(rvectorData)
        dscale = 1.0_DP
      end if
      
      ! Loop over the components
      do icomp = istartcomp,iendcomp
        
        call bma_docalc_rhsBubble(rvectorData,rassemblyData,rvectorAssembly,&
            npointsPerElement,nelements,icomp,dscale)
        
      end do ! icomp
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_rhsBubblePlusFE(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,icomp,dscale,rcoefficient)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f = dscale * 32*y*(1-y)+32*x*(1-x) + v(x,y)
      ! with v being a FEM function.
      !
      ! The FEM function v(x,y) must be provided in rcoefficient.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! ID of the component where to assemble to.
      integer, intent(in) :: icomp
      
      ! Scaling factor
      real(DP), intent(in) :: dscale
  
      ! Evaluation structure that describes an underlying nonconstant coefficient.
      type(t_fev2VectorData), intent(in), optional :: rcoefficient
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dval, dx, dy
      integer :: iel, icubp, idofe, idimfe, ndimfe
      real(DP), dimension(:,:), pointer :: p_DlocalVector
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaVectorData), pointer :: p_rvectorData
      real(DP), dimension(:,:,:), pointer :: p_Dpoints
      real(DP), dimension(:,:), pointer :: p_Dfunc
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get the coordinates of the cubature points
      p_Dpoints => rassemblyData%revalElementSet%p_DpointsReal
      
      ! Get the data array with the values of the FEM function
      ! in the cubature points
      p_Dfunc => rcoefficient%p_Ddata(:,:,DER_FUNC2D)
      
      ! Get the data arrays of the subvector
      p_rvectorData => RvectorData(icomp)
      p_DlocalVector => p_rvectorData%p_Dentry
      p_DbasTest => p_rvectorData%p_DbasTest
  
      ! FE space dimension
      ndimfe = p_rvectorData%ndimfe
    
      ! Loop over the elements in the current set.
      do iel = 1,nelements
  
        ! Loop over all cubature points on the current element
        do icubp = 1,npointsPerElement
        
          ! Get the coordinates of the cubature point.
          dx = p_Dpoints(1,icubp,iel)
          dy = p_Dpoints(2,icubp,iel)
  
          ! Calculate the values of the RHS in the cubature point:
          !     f = 32*y*(1-y)+32*x*(1-x) + v(x,y)
          dval = dscale * (32.0_DP*dy*(1.0_DP-dy) + 32_DP*dx*(1.0_DP-dx)) + p_Dfunc(icubp,iel)
          
          ! Loop over the dimensions of the FE space
          do idimfe = 0,ndimfe-1
  
            ! Outer loop over the DOF's i=1..ndof on our current element,
            ! which corresponds to the (test) basis functions Psi_i:
            do idofe=1,p_rvectorData%ndofTest
            
              ! Fetch the contributions of the (test) basis functions Psi_i
              ! into dbasI
              dbasI = p_DbasTest(idofe+idimfe*p_rvectorData%ndofTest,DER_FUNC,icubp,iel)
              
              ! Multiply the values of the basis functions
              ! (1st derivatives) by the cubature weight and sum up
              ! into the local vectors.
              p_DlocalVector(idofe,iel) = p_DlocalVector(idofe,iel) + &
                  p_DcubWeight(icubp,iel) * dval * dbasI
              
            end do ! idofe
            
          end do ! idimfe
  
        end do ! icubp
      
      end do ! iel
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_rhsBubblePlusFE(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f = dscale * (32*y*(1-y)+32*x*(1-x)) + v(x,y)
      ! with v being a FEM function.
      !
      ! The FEM function v(x,y) must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
      !
      ! If rcollection is not specified, the rhs is calculated
      ! in all components.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%IquickAccess(1) = Number of the component that should
      !                               receive the RHS.
      ! rcollection%DquickAccess(1) = Scaling factor dscale
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dscale
      integer :: icomp,istartcomp,iendcomp
  
      if (revalVectors%ncount .eq. 0) then
        call output_line ("FEM function missing.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_rhsBubblePlusFE")
        call sys_halt()
      end if
      
      ! Either compute to all components or to a specified one.
      if (present(rcollection)) then
        istartcomp = rcollection%IquickAccess(1)
        iendcomp = rcollection%IquickAccess(1)
        dscale = rcollection%DquickAccess(1)
      else
        istartcomp = 1
        iendcomp = size(rvectorData)
        dscale = 1.0_DP
      end if
      
      ! Loop over the components
      do icomp = istartcomp,iendcomp
  
        call bma_docalc_rhsBubblePlusFE(rvectorData,rassemblyData,rvectorAssembly,&
            npointsPerElement,nelements,icomp,dscale,&
            revalVectors%p_RvectorData(icomp-istartcomp+1))
  
      end do ! icomp
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_rhsFE(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,icomp,dscale,rcoefficient)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f = v(x,y)
      ! with v being a FEM function.
      !
      ! The FEM function v(x,y) must be provided in revalVectors.
      ! It must have as many components as the right hand side f,
      ! f_i is computed from v_i.
      !
      ! The routine only supports non-interleaved vectors.
      !
      ! This routine is typically used in L2 projections for setting up the
      ! RHS based on a FEM function.
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! ID of the component where to assemble to.
      integer, intent(in) :: icomp
      
      ! Scaling factor
      real(DP), intent(in) :: dscale
  
      ! Evaluation structure that describes an underlying nonconstant coefficient.
      type(t_fev2VectorData), intent(in), optional :: rcoefficient
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasI, dval
      integer :: ndimfe, idimfe
      integer :: iel, icubp, idofe
      real(DP), dimension(:,:), pointer :: p_DlocalVector
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaVectorData), pointer :: p_rvectorData
      real(DP), dimension(:,:), pointer :: p_Dfunc
      real(DP), dimension(:,:,:), pointer :: p_DfuncVec
    
      ! Get the data arrays of the subvector
      p_rvectorData => RvectorData(icomp)
      p_DlocalVector => p_rvectorData%p_Dentry
      p_DbasTest => p_rvectorData%p_DbasTest
      
      ! FE space dimension
      ndimfe = p_rvectorData%ndimfe
    
      if (ndimfe .eq. 1) then
  
        ! -----------------------
        ! Scalar-valued FE space.
        ! -----------------------
  
        ! Get the data array with the values of the FEM function v_i
        ! in the cubature points.
        p_Dfunc => rcoefficient%p_Ddata(:,:,DER_FUNC2D)
        
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
          
            ! Calculate the values of the RHS in the cubature point:
            !     f_i = dscale * v_i(x,y)
            dval = p_Dfunc(icubp,iel)
            
            ! Outer loop over the DOF's i=1..ndof on our current element,
            ! which corresponds to the (test) basis functions Psi_i:
            do idofe=1,p_rvectorData%ndofTest
            
              ! Fetch the contributions of the (test) basis functions Psi_i
              ! into dbasI
              dbasI = dscale * p_DbasTest(idofe,DER_FUNC,icubp,iel)
              
              ! Multiply the values of the basis functions
              ! (1st derivatives) by the cubature weight and sum up
              ! into the local vectors.
              p_DlocalVector(idofe,iel) = p_DlocalVector(idofe,iel) + &
                  p_DcubWeight(icubp,iel) * dval * dbasI
              
            end do ! jdofe
  
          end do ! icubp
        
        end do ! iel
        
      else
  
        ! -----------------------
        ! Vector-valued FE space.
        ! -----------------------
      
        ! Get the data array with the values of the FEM function v_i
        ! in the cubature points.
        p_DfuncVec => rcoefficient%p_DdataVec(:,:,:,DER_FUNC2D)
        
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
          
            ! Loop over the dimensions of the FE space
            do idimfe = 0,ndimfe-1
  
              ! Calculate the values of the RHS in the cubature point
              ! for component (1+idimfe):
              !     f_i = dscale * v_i(x,y)
              dval = dscale * p_DfuncVec(1+idimfe,icubp,iel)
              
              ! Outer loop over the DOF's i=1..ndof on our current element,
              ! which corresponds to the (test) basis functions Psi_i:
              do idofe=1,p_rvectorData%ndofTest
              
                ! Fetch the contributions of the (test) basis functions Psi_i
                ! into dbasI
                dbasI = p_DbasTest(idofe+idimfe*p_rvectorData%ndofTest,DER_FUNC,icubp,iel)
                
                ! Multiply the values of the basis functions
                ! (1st derivatives) by the cubature weight and sum up
                ! into the local vectors.
                p_DlocalVector(idofe,iel) = p_DlocalVector(idofe,iel) + &
                    p_DcubWeight(icubp,iel) * dval * dbasI
                
              end do ! idofe
            
            end do ! idimfe
  
          end do ! icubp
        
        end do ! iel
      
      end if
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_rhsFE(rvectorData,rassemblyData,rvectorAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates a right-hand side vector according to the right-hand
      ! side function f = dscale * v(x,y)
      ! with v being a FEM function with as many components as f.
      !
      ! The FEM function v(x,y) must be provided in revalVectors.
      ! It must have as many components as the right hand side f,
      ! f_i is computed from v_i.
      !
      ! The routine only supports non-interleaved vectors.
      !
      ! This routine is typically used in L2 projections for setting up the
      ! RHS based on a FEM function.
      !
      ! If rcollection is not specified, the rhs is calculated
      ! in all components.
      ! If rcollection is specified, the following parameters are expected:
      ! rcollection%IquickAccess(1) = Number of the component that should
      !                               receive the RHS.
      ! rcollection%DquickAccess(1) = Scaling factor dscale
  !</description>
  
  !<inputoutput>
      ! Vector data of all subvectors. The arrays p_Dentry of all subvectors
      ! have to be filled with data.
      type(t_bmaVectorData), dimension(:), intent(inout), target :: RvectorData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaVectorAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaVectorAssembly), intent(in) :: rvectorAssembly
      
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
      
      ! Number of elements
      integer, intent(in) :: nelements
      
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
      
  !</subroutine>
  
      ! Local variables
      real(DP) :: dscale
      integer :: icomp,istartcomp,iendcomp
      
      if (revalVectors%ncount .ne. size(rvectorData)) then
        call output_line ("FEM function missing or wrong length.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_rhsFE")
        call sys_halt()
      end if
      
      ! Either compute to all components or to a specified one.
      if (present(rcollection)) then
        istartcomp = rcollection%IquickAccess(1)
        iendcomp = rcollection%IquickAccess(1)
        dscale = rcollection%DquickAccess(1)
      else
        istartcomp = 1
        iendcomp = size(rvectorData)
        dscale = 1.0_DP
      end if
      
      ! Loop over the components
      do icomp = istartcomp,iendcomp
  
        call bma_docalc_rhsFE(rvectorData,rassemblyData,rvectorAssembly,&
            npointsPerElement,nelements,icomp,dscale,&
            revalVectors%p_RvectorData(icomp-istartcomp+1))
  
      end do ! icomp
      
    end subroutine
  
    !****************************************************************************
    !****************************************************************************
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_integralOne(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements)
  
  !<description>  
      ! Calculates the integral of the function v=1.
      ! The result is the size of the domain.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dval
      integer :: iel, icubp
      real(DP), dimension(:,:), pointer :: p_DcubWeight
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      Dintvalues(1) = 0.0_DP
      
      ! Loop over the elements in the current set.
      do iel = 1,nelements
  
        ! Loop over all cubature points on the current element
        do icubp = 1,npointsPerElement
  
          ! The value of the function v is just the 1.0-function here
          dval = 1.0_DP
          
          ! Multiply the values by the cubature weight and sum up
          ! into the integral value
          Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dval
            
        end do ! icubp
      
      end do ! iel
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_integralOne(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the integral of the function v=1.
      ! The result is the size of the domain.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      call bma_docalc_integralOne(Dintvalues,rassemblyData,rintAssembly,&
          npointsPerElement,nelements)
      
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_integralFE(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,rfunction,icomp)
  
  !<description>  
      ! Calculates the integral of an arbitrary finite element function v.
      !
      ! If v is vector valued components, the sum of the integrals of all
      ! components is returned. If v is vector valued and icomp is specified,
      ! only the integral of component icomp is returned.
      !
      ! The FEM function(s) must be provided in rfunction.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to integrate.
      type(t_fev2VectorData), intent(in) :: rfunction
      
      ! OPTIONAL: Number of the component.
      ! Only applies for vector valued FE functions.
      integer, intent(in), optional :: icomp
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dval
      integer :: iel, icubp
      integer :: icomponent,istart,iend
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:), pointer :: p_Dfunc
      real(DP), dimension(:,:,:), pointer :: p_DfuncVec
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      Dintvalues(1) = 0.0_DP
  
      ! Skip interleaved vectors.
      if (rfunction%bisInterleaved) return
      
      ! Skip vector-valued FE functions
      if (.not. rfunction%bisVectorField) then
  
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_Dfunc => rfunction%p_Ddata(:,:,DER_FUNC2D)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Get the value of the FEM function
            dval = p_Dfunc(icubp,iel)
            
            ! Multiply the values by the cubature weight and sum up
            ! into the integral value
            Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dval
              
          end do ! icubp
        
        end do ! iel
      
      else
      
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_DfuncVec => rfunction%p_DdataVec(:,:,:,DER_FUNC2D)
  
        ! Loop through the components
        istart = 1
        iend = ubound(p_DfuncVec,1)
        if (present(icomp)) then
          istart = icomp
          iend = icomp
        end if
        
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            do icomponent = istart,iend
  
              ! Get the value of the FEM function
              dval = p_DfuncVec(icomponent,icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dval
              
            end do
              
          end do ! icubp
        
        end do ! iel
      
      end if
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_integralFE(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the integral of an arbitrary finite element function v.
      ! If v has is a vector field, the sum of the integrals of all
      ! components is returned.
      !
      ! The FEM function(s) must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      integer :: ivec
      real(DP), dimension(1) :: Dint
    
      Dintvalues(1) = 0.0_DP
  
      ! Loop through all provided FEM functions
      do ivec = 1,revalVectors%ncount
      
        ! Calculate the integral, sum up
        call bma_docalc_integralFE(Dint,rassemblyData,rintAssembly,&
            npointsPerElement,nelements,revalVectors%p_RvectorData(ivec))
            
        Dintvalues(1) = Dintvalues(1) + Dint(1)
        
      end do ! ivec
      
    end subroutine
  
    !****************************************************************************
  
  !<--
  ! The L2-norm of a vector field "rvector" can be calculated, e.g., as follows:
  !
  !    ! Declare an evaluation structure for the subvectors
  !    type(t_fev2Vectors) :: revalVectors
  !    ...
  !    real(DP) :: dresult
  !
  !    ! Add the vector field
  !    call fev2_addVectorFieldToEvalList(revalVectors,0,&
  !        rvector%RvectorBlock(1),rvector%RvectorBlock(2))
  !
  !    ! Evaluate the norm to "dresult"
  !    call bma_buildIntegral(dresult,BMA_CALC_STANDARD,bma_fcalc_L2norm,&
  !        revalVectors=revalVectors,rcubatureInfo=rcubatureInfo)
  !
  !    ! Clean up
  !    call fev2_releaseVectorList(revalVectors)
  !-->
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_L2norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,rfunction)
  
  !<description>  
      ! Calculates the squared L2-norm of an arbitrary finite element 
      ! function: <tex> $ |||v||^2 $ </tex>.
      ! If v is a vector field, the sum of the integrals of all
      ! components is returned.
      !
      ! The FEM function(s) must be provided in rfunction.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to compute the L2 norm from.
      type(t_fev2VectorData), intent(in) :: rfunction
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dval
      integer :: iel, icubp, idimfe
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:), pointer :: p_Dfunc
      real(DP), dimension(:,:,:), pointer :: p_DfuncVec
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      Dintvalues(1) = 0.0_DP
  
      ! Skip interleaved vectors.
      if (rfunction%bisInterleaved) return
  
      if (.not. rfunction%bisVectorField) then
      
        ! -----------------------
        ! Scalar-valued FE space. 
        ! -----------------------
      
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_Dfunc => rfunction%p_Ddata(:,:,DER_FUNC)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Get the value of the FEM function
            dval = p_Dfunc(icubp,iel)
            
            ! Multiply the values by the cubature weight and sum up
            ! into the integral value
            Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dval**2
              
          end do ! icubp
        
        end do ! iel
        
      else
      
        ! -----------------------
        ! Vector-valued FE space.
        ! -----------------------
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_DfuncVec => rfunction%p_DdataVec(:,:,:,DER_FUNC)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Loop over the dimensions of the FE space
            do idimfe = 1,rfunction%ndimVectorField
  
              ! Get the value of the FEM function
              dval = p_DfuncVec(idimfe,icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dval**2
              
            end do
              
          end do ! icubp
        
        end do ! iel
        
      end if
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_L2norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the squared L2-norm of an arbitrary finite element 
      ! function: <tex> $ ||v||^2 $ </tex>.
      ! If v has multiple components, the sum of the integrals of all
      ! components is returned.
      !
      ! The FEM function(s) must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      integer :: ivec
      real(DP), dimension(size(Dintvalues)) :: DintVals
    
      Dintvalues(:) = 0.0_DP
  
      ! Loop through all provided FEM functions
      do ivec = 1,revalVectors%ncount
      
        ! Calculate the integral, sum up
        call bma_docalc_L2norm(DintVals,rassemblyData,rintAssembly,&
            npointsPerElement,nelements,revalVectors%p_RvectorData(ivec))
            
        Dintvalues(:) = Dintvalues(:) + DintVals(:)
        
      end do ! ivec
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_H1norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,rfunction)
  
  !<description>  
      ! Calculates the squared H1 (semi-)norm of an arbitrary finite element 
      ! function <tex> $ ||v||^2_{H^1} $ </tex>.
      ! If v is vector valued, the sum of the integrals of all
      ! components is returned.
      !
      ! The FEM function(s) must be provided in rfunction.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to compute the H1 norm from.
      type(t_fev2VectorData), intent(in) :: rfunction
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dderivX,dderivY,dderivZ
      integer :: iel, icubp, ndim, idimfe
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:), pointer :: p_DderivX,p_DderivY,p_DderivZ
      real(DP), dimension(:,:,:), pointer :: p_DderivXVec,p_DderivYVec,p_DderivZVec
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      Dintvalues(1) = 0.0_DP
  
      ! Skip interleaved vectors.
      if (rfunction%bisInterleaved) return
  
      ! Dimension?
      ndim = rintAssembly%p_rtriangulation%ndim
  
      if (.not. rfunction%bisVectorField) then
      
        ! -----------------------
        ! Scalar-valued FE space. 
        ! -----------------------
  
        select case (ndim)
        
        ! ----------------
        ! 1D
        ! ----------------
        case (NDIM1D)
        
          ! Get the data array with the values of the FEM function
          ! in the cubature points
          p_DderivX => rfunction%p_Ddata(:,:,DER_DERIV1D_X)
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Get the value of the FEM function
              dderivX = p_DderivX(icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dderivX**2
                
            end do ! icubp
          
          end do ! iel
  
        ! ----------------
        ! 2D
        ! ----------------
        case (NDIM2D)
        
          ! Get the data array with the values of the FEM function
          ! in the cubature points
          p_DderivX => rfunction%p_Ddata(:,:,DER_DERIV2D_X)
          p_DderivY => rfunction%p_Ddata(:,:,DER_DERIV2D_Y)
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Get the value of the FEM function
              dderivX = p_DderivX(icubp,iel)
              dderivY = p_DderivY(icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
                  ( dderivX**2 + dderivY**2 )
                
            end do ! icubp
          
          end do ! iel
  
        ! ----------------
        ! 3D
        ! ----------------
        case (NDIM3D)
        
          ! Get the data array with the values of the FEM function
          ! in the cubature points
          p_DderivX => rfunction%p_Ddata(:,:,DER_DERIV3D_X)
          p_DderivY => rfunction%p_Ddata(:,:,DER_DERIV3D_Y)
          p_DderivZ => rfunction%p_Ddata(:,:,DER_DERIV3D_Z)
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Get the value of the FEM function
              dderivX = p_DderivX(icubp,iel)
              dderivY = p_DderivY(icubp,iel)
              dderivZ = p_DderivZ(icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
                  ( dderivX**2 + dderivY**2 + dderivZ**2 )
                
            end do ! icubp
          
          end do ! iel
          
        end select
  
      else
      
        ! -----------------------
        ! Vector-valued FE space. 
        ! -----------------------
  
        select case (ndim)
        
        ! ----------------
        ! 1D
        ! ----------------
        case (NDIM1D)
        
          ! Get the data array with the values of the FEM function
          ! in the cubature points
          p_DderivXVec => rfunction%p_DdataVec(:,:,:,DER_DERIV1D_X)
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Loop over the dimensions of the FE space
              do idimfe = 1,rfunction%ndimVectorField
                
                ! Get the value of the FEM function
                dderivX = p_DderivXVec(idimfe,icubp,iel)
                
                ! Multiply the values by the cubature weight and sum up
                ! into the integral value
                Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dderivX**2
                
              end do ! idimfe
                
            end do ! icubp
          
          end do ! iel
  
        ! ----------------
        ! 2D
        ! ----------------
        case (NDIM2D)
        
          ! Get the data array with the values of the FEM function
          ! in the cubature points
          p_DderivXVec => rfunction%p_DdataVec(:,:,:,DER_DERIV2D_X)
          p_DderivYVec => rfunction%p_DdataVec(:,:,:,DER_DERIV2D_Y)
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Loop over the dimensions of the FE space
              do idimfe = 1,rfunction%ndimVectorField
                
                ! Get the value of the FEM function
                dderivX = p_DderivXVec(idimfe,icubp,iel)
                dderivY = p_DderivYVec(idimfe,icubp,iel)
                
                ! Multiply the values by the cubature weight and sum up
                ! into the integral value
                Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
                    ( dderivX**2 + dderivY**2 )
                    
              end do ! idimfe
                
            end do ! icubp
          
          end do ! iel
  
        ! ----------------
        ! 3D
        ! ----------------
        case (NDIM3D)
        
          ! Get the data array with the values of the FEM function
          ! in the cubature points
          p_DderivXVec => rfunction%p_DdataVec(:,:,:,DER_DERIV3D_X)
          p_DderivYVec => rfunction%p_DdataVec(:,:,:,DER_DERIV3D_Y)
          p_DderivZVec => rfunction%p_DdataVec(:,:,:,DER_DERIV3D_Z)
  
          ! Loop over the elements in the current set.
          do iel = 1,nelements
  
            ! Loop over all cubature points on the current element
            do icubp = 1,npointsPerElement
  
              ! Loop over the dimensions of the FE space
              do idimfe = 1,rfunction%ndimVectorField
              
                ! Get the value of the FEM function
                dderivX = p_DderivXVec(idimfe,icubp,iel)
                dderivY = p_DderivYVec(idimfe,icubp,iel)
                dderivZ = p_DderivZVec(idimfe,icubp,iel)
                
                ! Multiply the values by the cubature weight and sum up
                ! into the integral value
                Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
                    ( dderivX**2 + dderivY**2 + dderivZ**2 )
              
              end do
                
            end do ! icubp
          
          end do ! iel
          
        end select
  
      end if
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_H1norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the squared H1 (semi-)norm of an arbitrary finite element 
      ! function <tex> $ ||v||^2_{H^1} $ </tex>.
      ! If v has multiple components, the sum of the integrals of all
      ! components is returned.
      !
      ! The FEM function(s) must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      integer :: ivec
      real(DP), dimension(size(Dintvalues)) :: DintVals
    
      Dintvalues(:) = 0.0_DP
  
      ! Loop through all provided FEM functions
      do ivec = 1,revalVectors%ncount
      
        ! Calculate the integral, sum up
        call bma_docalc_H1norm(DintVals,rassemblyData,rintAssembly,&
            npointsPerElement,nelements,revalVectors%p_RvectorData(ivec))
            
        Dintvalues(:) = Dintvalues(:) + DintVals(:)
        
      end do ! ivec
  
    end subroutine
  
    !****************************************************************************
  
  !<--
  ! The L2-norm of a vector field "rvector" can be calculated, e.g., as follows:
  !
  !    ! Declare an evaluation structure for the subvectors
  !    type(t_fev2Vectors) :: revalVectors
  !    ...
  !    real(DP) :: dresult
  !
  !    ! Add the vector field
  !    call fev2_addVectorFieldToEvalList(revalVectors,0,&
  !        rvector%RvectorBlock(1),rvector%RvectorBlock(2))
  !
  !    ! Evaluate the norm to "dresult". Specify coperation=BMA_INT_MAX
  !    ! to calculate the maximum norm.
  !    call bma_buildIntegral(dresult,BMA_CALC_STANDARD,bma_fcalc_L2norm,&
  !        revalVectors=revalVectors,rcubatureInfo=rcubatureInfo,&
  !        coperation=BMA_INT_MAX)
  !
  !    ! Clean up
  !    call fev2_releaseVectorList(revalVectors)
  !-->
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_MAXnorm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,rfunction)
  
  !<description>  
      ! Calculates the MAX-norm of an arbitrary finite element 
      ! function: <tex> $ |||v||_{max} $ </tex>.
      ! If v is a vector field, the sum of the maximum norm of all
      ! components is returned.
      !
      ! The FEM function(s) must be provided in rfunction.
      ! The routine only supports non-interleaved vectors.
      !
      ! WARNING: This routine only works if "coperation=BMA_INT_MAX" is
      ! specified in bma_buildIntegral(s)!
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to compute the L2 norm from.
      type(t_fev2VectorData), intent(in) :: rfunction
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dval, dvaltemp
      integer :: iel, icubp, idimfe
      real(DP), dimension(:,:), pointer :: p_Dfunc
      real(DP), dimension(:,:,:), pointer :: p_DfuncVec
    
      Dintvalues(1) = 0.0_DP
  
      ! Skip interleaved vectors.
      if (rfunction%bisInterleaved) return
  
      if (.not. rfunction%bisVectorField) then
      
        ! -----------------------
        ! Scalar-valued FE space. 
        ! -----------------------
      
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_Dfunc => rfunction%p_Ddata(:,:,DER_FUNC)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Get the value of the FEM function
            dval = p_Dfunc(icubp,iel)
            
            ! Set up the maximum norm
            Dintvalues(1) = max(Dintvalues(1),abs(dval))
              
          end do ! icubp
        
        end do ! iel
        
      else
      
        ! -----------------------
        ! Vector-valued FE space/Vector field
        ! -----------------------
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_DfuncVec => rfunction%p_DdataVec(:,:,:,DER_FUNC)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            dval = 0.0_DP
            
            ! Loop over the dimensions of the FE space
            do idimfe = 1,rfunction%ndimVectorField
  
              ! Get the value of the FEM function
              dvaltemp = p_DfuncVec(idimfe,icubp,iel)
              
              ! Get the norm of the vector field
              dval = dval + dvaltemp**2
              
            end do
  
            ! Set up the maximum norm
            Dintvalues(1) = max(Dintvalues(1),sqrt(dval))
            
          end do ! icubp
        
        end do ! iel
        
      end if
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_MAXnorm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the squared MAX-norm of an arbitrary finite element 
      ! function: <tex> $ |||v||_{max} $ </tex>.
      ! If v is a vector field, the maximum norm of the vector field
      ! is returned.
      ! If multiple finite element functions are provided, DintValues
      ! returns for each specified function the corresponding
      ! maximum norm.
      !
      ! The FEM function(s) must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
      !
      ! WARNING: This routine only works if "coperation=BMA_INT_MAX" is
      ! specified in bma_buildIntegral(s)!
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      integer :: ivec
      real(DP), dimension(size(Dintvalues)) :: DintVals
    
      Dintvalues(:) = 0.0_DP
  
      ! Loop through all provided FEM functions
      do ivec = 1,revalVectors%ncount
      
        ! Calculate the max norm
        call bma_docalc_MAXnorm(DintVals,rassemblyData,rintAssembly,&
            npointsPerElement,nelements,revalVectors%p_RvectorData(ivec))
            
        ! Maximum of maximum norms
        Dintvalues(ivec) = max(Dintvalues(ivec),DintVals(1))
        
      end do ! ivec
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_bubbleL2error(Dintvalues,rassemblyData,rintegralAssembly,&
        npointsPerElement,nelements,rfunction)
  
  !<description>  
      ! Calculates the (squared) L2 error of an arbitrary FEM function v
      ! to the bubble function u=16x(1-x)y(1-y):
      !
      !  <tex> $$ || v - u ||^2_{L2} $$ </tex>
      !
      ! The FEM function(s) must be provided in rfunction.
      ! The routine only supports scalar non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintegralAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to compute the error from.
      type(t_fev2VectorData), intent(in) :: rfunction
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dval1,dval2,dx,dy
      integer :: iel, icubp
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:), pointer :: p_Dfunc
      real(DP), dimension(:,:,:), pointer :: p_Dpoints
    
      ! Skip interleaved vectors.
      if (rfunction%bisInterleaved) return
  
      ! Skip vector-valued FE functions
      if (rfunction%bisVectorField) return
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      ! Get the coordinates of the cubature points
      p_Dpoints => rassemblyData%revalElementSet%p_DpointsReal
      
      ! Get the data array with the values of the FEM function
      ! in the cubature points
      p_Dfunc => rfunction%p_Ddata(:,:,DER_FUNC2D)
  
      Dintvalues(1) = 0.0_DP
      
      ! Loop over the elements in the current set.
      do iel = 1,nelements
  
        ! Loop over all cubature points on the current element
        do icubp = 1,npointsPerElement
  
          ! Get the value of the bubble function
          dx = p_Dpoints(1,icubp,iel)
          dy = p_Dpoints(2,icubp,iel)
          
          dval1 = 16.0_DP * dx * (1.0_DP-dx) * dy * (1.0_DP-dy)
  
          ! Get the error of the FEM function to the bubble function
          dval2 = p_Dfunc(icubp,iel)
          
          ! Multiply the values by the cubature weight and sum up
          ! into the (squared) L2 error:
          Dintvalues(1) = Dintvalues(1) + &
              p_DcubWeight(icubp,iel) * (dval1 - dval2)**2
            
        end do ! icubp
      
      end do ! iel
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_bubbleL2error(Dintvalues,rassemblyData,rintegralAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the (squared) L2 error of an arbitrary FEM function v
      ! to the bubble function u=16x(1-x)y(1-y):
      !
      !  <tex> $$ || v - u ||^2_{L2} $$ </tex>
      !
      ! The FEM function must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintegralAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      call bma_docalc_bubbleL2error(Dintvalues,rassemblyData,rintegralAssembly,&
          npointsPerElement,nelements,revalVectors%p_RvectorData(1))
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_bubbleH1error(Dintvalues,rassemblyData,rintegralAssembly,&
        npointsPerElement,nelements,rfunction)
  
  !<description>  
      ! Calculates the (squared) H1 error of an arbitrary FEM function v
      ! to the bubble function u=16x(1-x)y(1-y)
      ! (based on the H1 semi-norm).
      !
      !  <tex> $$ | v - u |^2_{H1} $$ </tex>
      !
      ! The FEM function must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintegralAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to compute the error from.
      type(t_fev2VectorData), intent(in) :: rfunction
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dderivX1,dderivY1,dderivX2,dderivY2,dx,dy
      integer :: iel, icubp
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:), pointer :: p_DderivX,p_DderivY
      real(DP), dimension(:,:,:), pointer :: p_Dpoints
    
      ! Skip interleaved vectors.
      if (rfunction%bisInterleaved) return
  
      ! Skip vector-valued FE functions
      if (rfunction%bisVectorField) return
  
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      ! Get the coordinates of the cubature points
      p_Dpoints => rassemblyData%revalElementSet%p_DpointsReal
      
      ! Get the data array with the values of the FEM function
      ! in the cubature points
      p_DderivX => rfunction%p_Ddata(:,:,DER_DERIV2D_X)
      p_DderivY => rfunction%p_Ddata(:,:,DER_DERIV2D_Y)
  
      Dintvalues(1) = 0.0_DP
      
      ! Loop over the elements in the current set.
      do iel = 1,nelements
  
        ! Loop over all cubature points on the current element
        do icubp = 1,npointsPerElement
  
          ! Get the derivatives of the bubble function in the cubature point
          dx = p_Dpoints(1,icubp,iel)
          dy = p_Dpoints(2,icubp,iel)
          
          dderivX1 = 16.0_DP*dy*(dy-1.0_DP)*(2.0_DP*dx-1.0_DP)
          dderivY1 = 16.0_DP*dx*(dx-1.0_DP)*(2.0_DP*dy-1.0_DP)
  
          ! Get the error of the FEM function derivatives of the bubble function
          ! in the cubature point
          dderivX2 = p_DderivX(icubp,iel)
          dderivY2 = p_DderivY(icubp,iel)
          
          ! Multiply the values by the cubature weight and sum up
          ! into the (squared) H1 error:
          Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
              ( (dderivX1 - dderivX2)**2 + (dderivY1 - dderivY2)**2 )
            
        end do ! icubp
      
      end do ! iel
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_bubbleH1error(Dintvalues,rassemblyData,rintegralAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the (squared) H1 error of an arbitrary FEM function v
      ! to the bubble function u=16x(1-x)y(1-y)
      ! (based on the H1 semi-norm).
      !
      !  <tex> $$ | v - u |^2_{H1} $$ </tex>
      !
      ! The FEM function must be provided in revalVectors.
      ! The routine only supports non-interleaved vectors.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintegralAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      call bma_docalc_bubbleH1error(Dintvalues,rassemblyData,rintegralAssembly,&
          npointsPerElement,nelements,revalVectors%p_RvectorData(1))
        
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_divergenceL2norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,rfunction)
  
  !<description>  
      ! Calculates the (squared) L2-norm of the divergence of an arbitrary finite 
      ! element vector field <tex> $ ||div v||^2_{L_2} $ </tex>.
      !
      ! The vector field including first derivatives must be provided in 
      ! revalVectors. The routine only supports non-interleaved vectors.
      !
      ! If the FEM-space is scalar valued, exactly as many components must be
      ! specified as there are dimensions.
      !
      ! If the FEM-space is vector valued, exactly one function must be
      ! provided which must have exactly as many components as dimensions.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Function to compute the divergence from.
      type(t_fev2VectorData), intent(in) :: rfunction
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dderivX,dderivY,dderivZ
      integer :: iel, icubp, ndim, idimfe
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      real(DP), dimension(:,:,:), pointer :: p_DderivXVec,p_DderivYVec,p_DderivZVec
    
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
      
      Dintvalues(1) = 0.0_DP
      
      ! Dimension of the spaces
      ndim = rintAssembly%p_rtriangulation%ndim
  
      ! Must be vector-valued.
      if (.not. rfunction%bisVectorField) return
  
      ! -----------------------
      ! Vector-valued function.
      ! FE space or multiple components.
      ! -----------------------
  
      ! Cancel if the number of vectors does not match the dimension.
      ! Each vector corresponds to one dimension.
      if (rfunction%ndimVectorField .ne. ndim) then
        call output_line ("Parameters wrong.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_divergenceL2norm")
        call sys_halt()
      end if
  
      select case (ndim)
      
      ! ----------------
      ! 1D
      ! ----------------
      case (NDIM1D)
      
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_DderivXVec => rfunction%p_DdataVec(:,:,:,DER_DERIV1D_X)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Get the value of the FEM function
            dderivX = p_DderivXVec(1,icubp,iel)
            
            ! Multiply the values by the cubature weight and sum up
            ! into the integral value
            Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * dderivX**2
              
          end do ! icubp
        
        end do ! iel
  
      ! ----------------
      ! 2D
      ! ----------------
      case (NDIM2D)
      
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_DderivXVec => rfunction%p_DdataVec(:,:,:,DER_DERIV2D_X)
        p_DderivYVec => rfunction%p_DdataVec(:,:,:,DER_DERIV2D_Y)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Loop over the dimensions of the FE space
            do idimfe = 1,rfunction%ndimVectorField
              
              ! Get the value of the FEM function
              dderivX = p_DderivXVec(1,icubp,iel)
              dderivY = p_DderivYVec(2,icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
                  ( dderivX + dderivY )**2
                  
            end do ! idimfe
              
          end do ! icubp
        
        end do ! iel
  
      ! ----------------
      ! 3D
      ! ----------------
      case (NDIM3D)
      
        ! Get the data array with the values of the FEM function
        ! in the cubature points
        p_DderivXVec => rfunction%p_DdataVec(:,:,:,DER_DERIV3D_X)
        p_DderivYVec => rfunction%p_DdataVec(:,:,:,DER_DERIV3D_Y)
        p_DderivZVec => rfunction%p_DdataVec(:,:,:,DER_DERIV3D_Z)
  
        ! Loop over the elements in the current set.
        do iel = 1,nelements
  
          ! Loop over all cubature points on the current element
          do icubp = 1,npointsPerElement
  
            ! Loop over the dimensions of the FE space
            do idimfe = 1,rfunction%ndimVectorField
            
              ! Get the value of the FEM function
              dderivX = p_DderivXVec(1,icubp,iel)
              dderivY = p_DderivYVec(2,icubp,iel)
              dderivZ = p_DderivZVec(3,icubp,iel)
              
              ! Multiply the values by the cubature weight and sum up
              ! into the integral value
              Dintvalues(1) = Dintvalues(1) + p_DcubWeight(icubp,iel) * &
                  ( dderivX + dderivY + dderivZ )**2
            
            end do
              
          end do ! icubp
        
        end do ! iel
        
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_divergenceL2norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the (squared) L2-norm of the divergence of an arbitrary finite 
      ! element vector field <tex> $ ||div v||^2_{L_2} $ </tex>.
      !
      ! The vector field including first derivatives must be provided in 
      ! revalVectors. The routine only supports vector-valued, non-interleaved vectors:
      ! - If the FEM space is scalar-valued, revalVectors must be set up
      !   using fev2_addVectorToEvalList.
      ! - If the FEM space is vector-valued, revalVectors must be set up
      !   using fev2_addVectorFieldToEvalList providing the complete vector field
      !   in one FE function.
  !</description>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaIntegralAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaIntegralAssembly), intent(in) :: rintAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !<output>
      ! Returns the value of the integral(s)
      real(DP), dimension(:), intent(out) :: Dintvalues
  !</output>    
  
  !</subroutine>
  
      call bma_docalc_divergenceL2norm(Dintvalues,rassemblyData,rintAssembly,&
        npointsPerElement,nelements,revalVectors%p_RvectorData(1))
        
    end subroutine
  
    ! ***************************************************************************
    ! ***************************************************************************
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxGetLocalMeshWidth_area (Ielements,rtriangulation,DmeshWidth)
  
  !<description>
    ! For a set of elements Ielements, this routine calculates a local mesh width
    ! using the area of the cells. Area/Volume-based approach.
    !
    ! Note: All elements must be of the same type (triangular, quad,...).
  !</description>
  
  !<input>
    ! List of elements.
    integer, dimension(:), intent(in) :: Ielements
    
    ! Underlying triangulation
    type(t_triangulation), intent(in) :: rtriangulation
  !</input>
  
  !<output>
    ! Mesh with of all elements Ielements.
    real(DP), dimension(:), intent(out) :: DmeshWidth
  !</output>
  
  !</subroutine>
  
      ! local variables
      integer, dimension(:,:), pointer :: p_IverticesAtElement
      real(DP), dimension(:), pointer :: p_DelementVolume
      integer :: nve,iel
      
      if (size(Ielements) .eq. 0) return
      
      ! Get some information about the mesh.
      call storage_getbase_int2d(rtriangulation%h_IverticesAtElement,p_IverticesAtElement)
      call storage_getbase_double(rtriangulation%h_DelementVolume,p_DelementVolume)
      
      ! Get the number of vertices on the element.
      do nve = ubound(p_IverticesAtElement,1),1,-1
        if (p_IverticesAtElement(nve,Ielements(1)) .ne. 0) exit
      end do
  
      ! What is the current dimension
      select case (rtriangulation%ndim)
      case (NDIM1D)
        do iel = 1,size(Ielements)
          ! Length of the interval
          DmeshWidth(iel) = p_DelementVolume(iel)
        end do
        
      case (NDIM2D)
        
        ! Type of the element
        select case (nve)
        
        ! Triangular cell
        case (3)
          
          do iel = 1,size(Ielements)
            ! Calculate the local h from the area of the element.
            ! As the element is a tri, multiply the volume by 2.
            DmeshWidth(iel) = sqrt(2.0_DP*p_DelementVolume(iel))
          end do
        
        ! Quadrilateral cell
        case (4)
        
          do iel = 1,size(Ielements)
            ! Calculate the local h from the area of the element.
            DmeshWidth(iel) = sqrt(p_DelementVolume(iel))
          end do
  
        end select
  
      case (NDIM3D)
        
        ! Type of the element
        select case (nve)
        
        ! Tetrahedral cell
        case (6)
          
          do iel = 1,size(Ielements)
            ! Calculate the local h from the area of the element.
            ! As the element is a tetra, multiply the volume by 3.
            DmeshWidth(iel) = sqrt(3.0_DP*p_DelementVolume(iel))
          end do
        
        ! Hexahedral cell
        case (7)
        
          do iel = 1,size(Ielements)
            ! Calculate the local h from the area of the element.
            DmeshWidth(iel) = sqrt(p_DelementVolume(iel))
          end do
  
        end select
  
      end select
      
    end subroutine
  
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxGetLocalMeshWidth_ray (&
        Ielements,Ddirection,rtriangulation,DmeshWidth)
  
  !<description>
    ! For a set of elements Ielements, this routine calculates a local mesh width
    ! using the area of the cells. Ray-shooting approach.
    !
    ! Note: All elements must be of the same type (triangular, quad,...).
  !</description>
  
  !<input>
    ! List of elements.
    integer, dimension(:), intent(in) :: Ielements
    
    ! Underlying triangulation
    type(t_triangulation), intent(in) :: rtriangulation
  
    ! For every cubature point and element, the shooting direction 
    ! by which the element size is calculated. The direction does not have
    ! to be normalised.
    real(DP), dimension(:,:), intent(in) :: Ddirection
  !</input>
  
  !<output>
    ! Mesh with of all elements Ielements.
    real(DP), dimension(:), intent(out) :: DmeshWidth
  !</output>
  
  !</subroutine>
  
      ! local variables
      integer, dimension(:,:), pointer :: p_IverticesAtElement
      real(DP), dimension(:,:), pointer :: p_DvertexCoords
      integer :: nve,iel,i,ielement,ivt
      real(DP) :: dlen
      real(DP), dimension(2,4) :: Dcorners2D
      
      if (size(Ielements) .eq. 0) return
      
      ! Get some information about the mesh.
      call storage_getbase_int2d(rtriangulation%h_IverticesAtElement,p_IverticesAtElement)
      call storage_getbase_double2d(rtriangulation%h_DvertexCoords,p_DvertexCoords)
      
      ! Get the number of vertices on the element.
      do nve = ubound(p_IverticesAtElement,1),1,-1
        if (p_IverticesAtElement(nve,Ielements(1)) .ne. 0) exit
      end do
  
      ! What is the current dimension
      select case (rtriangulation%ndim)
        
      case (NDIM2D)
        
        ! Type of the element
        select case (nve)
       
        ! Quadrilateral cell
        case (4)
        
          do iel = 1,size(Ielements)
            ! Get the element corners.
            ielement = Ielements(iel)
            do i=1,4
              ivt = p_IverticesAtElement(i,ielement)
              Dcorners2D(1,i) = p_DvertexCoords(1,ivt)
              Dcorners2D(2,i) = p_DvertexCoords(2,ivt)
            end do
            
            ! Length of the shoting direction
            dlen = 1.0_DP/(sqrt(Ddirection(1,iel)**2 + Ddirection(2,iel)**2))
          
            ! Shoot the ray.
            call gaux_getDirectedExtentQuad2D (Dcorners2D,&
                Ddirection(1,iel)*dlen,Ddirection(2,iel)*dlen,DmeshWidth(iel))
          end do
          
        ! Fallback.
        case default
          call bma_auxGetLocalMeshWidth_area (Ielements,rtriangulation,DmeshWidth)
  
        end select
  
      case (NDIM3D)
        
        ! Type of the element
        select case (nve)
        
        ! Fallback.
        case default
          call bma_auxGetLocalMeshWidth_area (Ielements,rtriangulation,DmeshWidth)
  
        end select
  
      ! Fallback.
      case default
        call bma_auxGetLocalMeshWidth_area (Ielements,rtriangulation,DmeshWidth)
  
      end select
      
    end subroutine
  
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxGetMeanVector (DmeanVector,&
        DcubWeights,npointsPerElement,nelements,du1,du2,du3,Dvector)
  
  !<description>
    ! Calculates the mean vector in every element.
  !</description>
  
  !<input>
    ! For every cubature point and every element, a cubature weight
    ! to calculate integrals on the element.
    real(DP), dimension(:,:), intent(in) :: DcubWeights
    
    ! Number of points per element
    integer, intent(in) :: npointsPerElement
  
    ! Number of elements
    integer, intent(in) :: nelements
    
    ! OPTIONAL: A constant velocity field. Can be omitted if Dvector is specified.
    real(DP), intent(in), optional :: du1,du2,du3
    
    ! OPTIONAL: Array with the values of the velocity field. Specifies for all points on
    ! all elements velocity.
    ! dimension(#dim, npointsPerElement,nelements)
    real(DP), dimension(:,:,:), intent(in), optional :: Dvector
  !</input>
  
  !<output>
    ! Out: The mean velocity in every element.
    real(DP), dimension(:,:), intent(out) :: DmeanVector
  !</output>
  
  !</subroutine>
  
      ! local variables
      integer :: iel,icubp,ndim
      real(DP) :: dvelX,dvelY,dvelZ,dvolume,domega
      
      dvelX = 0.0_DP
      dvelY = 0.0_DP
      dvelZ = 0.0_DP
      if (present(du1)) dvelX = du1
      if (present(du2)) dvelX = du2
      if (present(du3)) dvelX = du3
      
      ! Dimension
      ndim = ubound(Dvector,1)
      
      if (.not. present (Dvector)) then
      
        ! Constant velocity. Nothing to calculate.
      
        select case (ndim)
        case (NDIM1D)
      
          ! Loop over the elements
          do iel=1,nelements
  
            ! Calculate the mean velocity
            DmeanVector(1,iel) = dvelX
  
          end do
            
        case (NDIM2D)
      
          ! Loop over the elements
          do iel=1,nelements
          
            DmeanVector(1,iel) = dvelX
            DmeanVector(2,iel) = dvelY
            
          end do
  
        case (NDIM3D)
      
          ! Loop over the elements
          do iel=1,nelements
          
            DmeanVector(1,iel) = dvelX
            DmeanVector(2,iel) = dvelY
            DmeanVector(3,iel) = dvelZ
  
          end do
              
        end select
        
      else          
  
        select case (ndim)
        case (NDIM1D)
      
          ! Loop over the elements
          do iel=1,nelements
          
            dvelX = 0.0_DP
            dvolume = 0.0_DP
            
            ! Loop over the cubature points, calculate the element size and
            ! the integral of the velocity.
            do icubp = 1,npointsPerElement
              domega = DcubWeights(icubp,iel)
              dvolume = dvolume + domega
              dvelX = dvelX + domega*Dvector(1,icubp,iel)
            end do
            
            ! Calculate the mean velocity
            DmeanVector(1,iel) = dvelX/dvolume
  
          end do
            
        case (NDIM2D)
      
          ! Loop over the elements
          do iel=1,nelements
          
            dvelX = 0.0_DP
            dvelY = 0.0_DP
            dvolume = 0.0_DP
            
            ! Loop over the cubature points, calculate the element size and
            ! the integral of the velocity.
            do icubp = 1,npointsPerElement
              domega = DcubWeights(icubp,iel)
              dvolume = dvolume + domega
              dvelX = dvelX + domega*Dvector(1,icubp,iel)
              dvelY = dvelZ + domega*Dvector(2,icubp,iel)
            end do
            
            ! Calculate the mean velocity
            DmeanVector(1,iel) = dvelX/dvolume
            DmeanVector(2,iel) = dvelY/dvolume
  
          end do
  
        case (NDIM3D)
      
          ! Loop over the elements
          do iel=1,nelements
          
            dvelX = 0.0_DP
            dvelY = 0.0_DP
            dvelZ = 0.0_DP
            dvolume = 0.0_DP
            
            ! Loop over the cubature points, calculate the element size and
            ! the integral of the velocity.
            do icubp = 1,npointsPerElement
              domega = DcubWeights(icubp,iel)
              dvolume = dvolume + domega
              dvelX = dvelX + domega*Dvector(1,icubp,iel)
              dvelY = dvelZ + domega*Dvector(2,icubp,iel)
              dvelZ = dvelY + domega*Dvector(3,icubp,iel)
            end do
            
            ! Calculate the mean velocity
            DmeanVector(1,iel) = dvelX/dvolume
            DmeanVector(2,iel) = dvelY/dvolume
            DmeanVector(3,iel) = dvelZ/dvolume
  
          end do
              
        end select
  
      end if
      
    end subroutine
  
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxGetMeanScalar (DmeanScalar,&
        DcubWeights,npointsPerElement,nelements,ddata,Dscalar)
  
  !<description>
    ! Calculates the mean data in every element.
  !</description>
  
  !<input>
    ! For every cubature point and every element, a cubature weight
    ! to calculate integrals on the element.
    real(DP), dimension(:,:), intent(in) :: DcubWeights
    
    ! Number of points per element
    integer, intent(in) :: npointsPerElement
  
    ! Number of elements
    integer, intent(in) :: nelements
    
    ! OPTIONAL: A constant data field. Can be omitted if Dscalar is specified.
    real(DP), intent(in), optional :: ddata
    
    ! OPTIONAL: Array with the values of the velocity field. Specifies for all points on
    ! all elements velocity.
    ! dimension(npointsPerElement,nelements)
    real(DP), dimension(:,:), intent(in), optional :: Dscalar
  !</input>
  
  !<output>
    ! Out: The mean velocity in every element.
    real(DP), dimension(:), intent(out) :: DmeanScalar
  !</output>
  
  !</subroutine>
  
      ! local variables
      integer :: iel,icubp
      real(DP) :: da,dvolume,domega
      
      if (.not. present (Dscalar)) then
      
        ! Constant data. Nothing to calculate.
      
        ! Loop over the elements
        do iel=1,nelements
  
          ! Calculate the mean velocity
          DmeanScalar(iel) = ddata
  
        end do
            
      else          
  
        ! Loop over the elements
        do iel=1,nelements
        
          da = 0.0_DP
          dvolume = 0.0_DP
          
          ! Loop over the cubature points, calculate the element size and
          ! the integral of the velocity.
          do icubp = 1,npointsPerElement
            domega = DcubWeights(icubp,iel)
            dvolume = dvolume + domega
            da = da + domega*Dscalar(icubp,iel)
          end do
          
          ! Calculate the mean velocity
          DmeanScalar(iel) = da/dvolume
  
        end do
        
      end if
          
    end subroutine
  
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxGetLDelta (Ddelta,&
        cstabiltype,dupsam,duMaxR,DcubWeights,DmeshWidth,npointsPerElement,nelements,&
        DvelocityMean,dnuConst,Dnu,duMin)
  
  !<description>
    ! This routine calculates a local ddelta=DELTA_T for a set of finite
    ! elements. This can be used by the streamline diffusion
    ! stabilisation technique as a multiplier of the (local) bilinear form.
    !
    ! Element independent version which uses the volume of the elements
    ! for the computation.
    !
    ! Used for vector-valued elements.
  !</description>
  
  !<input>
    ! Reciprocal of the maximum norm of velocity in the domain:
    ! 1/duMaxR = 1/||u||_max(Omega)
    real(DP), intent(in) :: duMaxR
  
    ! For every cubature point and every element, a cubature weight
    ! to calculate integrals on the element.
    real(DP), dimension(:,:), intent(in) :: DcubWeights
  
    ! Local h (mesh width) of each element
    real(DP), dimension(:), intent(in) :: DmeshWidth
  
    ! Type of SD method to apply.
    ! = 0: Use simple SD stabilisation:
    !      ddelta = dupsam * h_T.
    ! = 1: Use Samarskji SD stabilisation; usually dupsam = 0.1 .. 2.
    !      ddelta = dupsam * h_t/||u||_T * 2*Re_T/(1+Re_T)
    integer, intent(in) :: cstabilType
  
    ! User defined parameter for configuring the streamline diffusion.
    real(DP), intent(in) :: dupsam
  
    ! Number of points per element
    integer, intent(in) :: npointsPerElement
  
    ! Number of elements
    integer, intent(in) :: nelements
    
    ! Array with the values of the velocity field. Specifies for all elements
    ! the mean velocity in that element.
    ! dimension(#dim,#elements)
    real(DP), dimension(:,:), intent(in) :: DvelocityMean
  
    ! OPTIONAL: Viscosity coefficient. Can be omitted if Dnu is specified.
    real(DP), intent(in), optional :: dnuConst
  
    ! OPTIONAL: Viscosity coefficient in all cubature points on all selement
    real(DP), dimension(:,:), intent(in), optional :: Dnu
  
    ! OPTIONAL: Minimum velocity from which stabilisation is applied.
    ! For a velocity smaller than this, no stabilisation is applied
    ! on the corresponding element. Default = 1E-8.
    real(DP), intent(in), optional :: duMin
  !</input>
  
  !<output>
    ! Out: local Ddelta on all elements
    real(DP), dimension(:), intent(out) :: Ddelta
  !</output>
  
  !</subroutine>
  
    ! local variables
    real(DP) :: dlocalH,dunorm,dreLoc,dnuRec
    integer :: iel,icubp
    real(DP) :: domega,dminVelo,dvolume
    logical :: bconstNu
    integer :: ndim
    
      ndim = ubound (DvelocityMean,1)
    
      ! Minimum velocity
      dminVelo = 1E-8_DP
      if (present(duMin)) dminVelo = duMin
      
      ! Some preparations if some things are constant.
      bconstNu = .not. present (Dnu)
      
      if (bconstNu) then
      
        ! =================================================
        ! Nonconstant velocity, constant viscosity
        ! =================================================
  
        ! Calculate the mean viscosity coefficient -- or more precisely,
        ! its reciprocal.
        dnuRec = 1.0_DP/dnuConst
  
        ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
        select case (cstabiltype)
        
        ! =====================================================
        ! Simple calculation of ddelta.
        ! Viscosity not used.
        case (0)
        
          select case (ndim)
          
          case (NDIM1D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = abs(DvelocityMean(1,iel))
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
                Ddelta(iel) = dupsam*DmeshWidth(iel)
  
              end if
  
            end do
  
          case (NDIM2D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + DvelocityMean(2,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
                Ddelta(iel) = dupsam*DmeshWidth(iel)
  
              end if
  
            end do
            
          case (NDIM3D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + &
                            DvelocityMean(2,iel)**2 + DvelocityMean(3,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
                Ddelta(iel) = dupsam*dlocalH
  
              end if
  
            end do
  
          end select
  
        ! =====================================================
        ! Standard Samarskji-like calculation
        case (1)
  
          select case (ndim)
          case (NDIM1D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = abs(DvelocityMean(1,iel))
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! At first calculate the local Reynolds number
                ! RELOC = Re_T = ||u||_T * h_T / NU
  
                dreLoc = dunorm*DmeshWidth(iel)*dnuRec
  
                ! and then the ddelta = UPSAM * h_t/||u|| * 2*Re_T/(1+Re_T)
  
                Ddelta(iel) = dupsam * dlocalH*duMaxR * 2.0_DP*(dreLoc/(1.0_DP+dreLoc))
  
              end if
  
            end do
  
          case (NDIM2D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + DvelocityMean(2,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! At first calculate the local Reynolds number
                ! RELOC = Re_T = ||u||_T * h_T / NU
  
                dreLoc = dunorm*DmeshWidth(iel)*dnuRec
  
                ! and then the ddelta = UPSAM * h_t/||u|| * 2*Re_T/(1+Re_T)
  
                Ddelta(iel) = dupsam * dlocalH*duMaxR * 2.0_DP*(dreLoc/(1.0_DP+dreLoc))
  
              end if
  
            end do
            
          case (NDIM3D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + &
                            DvelocityMean(2,iel)**2 + DvelocityMean(3,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! At first calculate the local Reynolds number
                ! RELOC = Re_T = ||u||_T * h_T / NU
  
                dreLoc = dunorm*DmeshWidth(iel)*dnuRec
  
                ! and then the ddelta = UPSAM * h_t/||u|| * 2*Re_T/(1+Re_T)
  
                Ddelta(iel) = dupsam * dlocalH*duMaxR * 2.0_DP*(dreLoc/(1.0_DP+dreLoc))
  
              end if
  
            end do
            
          end select
  
        end select
  
      else
      
        ! =================================================
        ! Nonconstant velocity, nonconstant viscosity
        ! =================================================
  
        ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
        select case (cstabiltype)
        
        ! =====================================================
        ! Simple calculation of ddelta
        case (0)
        
          select case (ndim)
          
          case (NDIM1D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = abs(DvelocityMean(1,iel))
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
                Ddelta(iel) = dupsam*DmeshWidth(iel)
  
              end if
  
            end do
  
          case (NDIM2D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + DvelocityMean(2,iel)**2)
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
                Ddelta(iel) = dupsam*DmeshWidth(iel)
  
              end if
  
            end do
            
          case (NDIM3D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + &
                            DvelocityMean(2,iel)**2 + DvelocityMean(3,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! Calculate ddelta... (cf. p. 121 in Turek`s CFD book)
                Ddelta(iel) = dupsam*dlocalH
  
              end if
  
            end do
  
          end select
  
        ! =====================================================
        ! Standard Samarskji-like calculation
        case (1)
  
          select case (ndim)
          case (NDIM1D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Loop through the cubature points on the current element
              ! and calculate the mean velocity there.
              dnuRec = 0.0_DP
              do icubp = 1,npointsPerElement
                domega = DcubWeights(icubp,iel)
                dvolume = dvolume + domega
                dnuRec = dnuRec + domega*Dnu(icubp,iel)
              end do
  
              ! Calculate the mean viscosity coefficient -- or more precisely,
              ! its reciprocal.
              dnuRec = dvolume / dnuRec
  
              ! Calculate the norm of the mean local velocity.
              dunorm = abs(DvelocityMean(1,iel))
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! At first calculate the local Reynolds number
                ! RELOC = Re_T = ||u||_T * h_T / NU
  
                dreLoc = dunorm*DmeshWidth(iel)*dnuRec
  
                ! and then the ddelta = UPSAM * h_t/||u|| * 2*Re_T/(1+Re_T)
  
                Ddelta(iel) = dupsam * dlocalH*duMaxR * 2.0_DP*(dreLoc/(1.0_DP+dreLoc))
  
              end if
  
            end do
  
          case (NDIM2D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Loop through the cubature points on the current element
              ! and calculate the mean velocity there.
              dnuRec = 0.0_DP
              do icubp = 1,npointsPerElement
                domega = DcubWeights(icubp,iel)
                dvolume = dvolume + domega
                dnuRec = dnuRec + domega*Dnu(icubp,iel)
              end do
  
              ! Calculate the mean viscosity coefficient -- or more precisely,
              ! its reciprocal.
              dnuRec = dvolume / dnuRec
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + DvelocityMean(2,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! At first calculate the local Reynolds number
                ! RELOC = Re_T = ||u||_T * h_T / NU
  
                dreLoc = dunorm*DmeshWidth(iel)*dnuRec
  
                ! and then the ddelta = UPSAM * h_t/||u|| * 2*Re_T/(1+Re_T)
  
                Ddelta(iel) = dupsam * dlocalH*duMaxR * 2.0_DP*(dreLoc/(1.0_DP+dreLoc))
  
              end if
  
            end do
            
          case (NDIM3D)
  
            ! Loop through all elements
            do iel = 1,nelements
  
              ! Loop through the cubature points on the current element
              ! and calculate the mean velocity there.
              dnuRec = 0.0_DP
              do icubp = 1,npointsPerElement
                domega = DcubWeights(icubp,iel)
                dvolume = dvolume + domega
                dnuRec = dnuRec + domega*Dnu(icubp,iel)
              end do
  
              ! Calculate the mean viscosity coefficient -- or more precisely,
              ! its reciprocal.
              dnuRec = dvolume / dnuRec
  
              ! Calculate the norm of the mean local velocity.
              dunorm = sqrt(DvelocityMean(1,iel)**2 + &
                            DvelocityMean(2,iel)**2 + DvelocityMean(3,iel)**2)
  
              ! Now we have:   dunorm = ||u||_T
              ! and:           u_T = a1*u1_T + a2*u2_T
  
              ! If the norm of the velocity is small, we choose ddelta = 0,
              ! which results in central difference in the streamline diffusion
              ! matrix assembling:
  
              if (dunorm .le. dminVelo) then
  
                Ddelta(iel) = 0.0_DP
  
              else
  
                ! At first calculate the local Reynolds number
                ! RELOC = Re_T = ||u||_T * h_T / NU
  
                dreLoc = dunorm*DmeshWidth(iel)*dnuRec
  
                ! and then the ddelta = UPSAM * h_t/||u|| * 2*Re_T/(1+Re_T)
  
                Ddelta(iel) = dupsam * dlocalH*duMaxR * 2.0_DP*(dreLoc/(1.0_DP+dreLoc))
  
              end if
  
            end do
            
          end select
  
        end select
  
      end if
      
    end subroutine
  
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxViscosityTensorNorm2D (cviscoTensorType, DviscoTensorNorm, &
        Du1x, Du1y, Du2x, Du2y)
  
  !<description>
    ! Calculates the norm of a viscosity tensor,
    !    z := D(u):D(u) = ||D(u)||^2
    ! The calculation takes place in every cubature point on every element.
    ! ctensorType defines the type of the tensor.
  !</description>
  
  !<input>
    ! Type of the viscosity tensor:
    ! =0:  D(u)=grad(u)
    ! =1:  D(u)=1/2 ( grad(u) + grad(u)^T )
    integer, intent(in) :: cviscoTensorType
    
    ! The x/y derivative of the u1 and u2 in every cubature point on every
    ! element.
    real(DP), dimension(:,:), intent(in) :: Du1x
    real(DP), dimension(:,:), intent(in) :: Du1y
    real(DP), dimension(:,:), intent(in) :: Du2x
    real(DP), dimension(:,:), intent(in) :: Du2y
  !</input>
  
  !<output>
    ! Output array. Receives for every point on every element the norm of
    ! the tensor.
    real(DP), dimension(:,:), intent(out) :: DviscoTensorNorm
  !</output>
  
  !</subroutine>
  
      ! local variables
      integer :: npointsPerElement, nelements, i, j
      
      npointsPerElement = ubound (DviscoTensorNorm,1)
      nelements = ubound(DviscoTensorNorm,2)
      
      ! Calculate ||D(u)||^2 to p_Ddata(:,:)
      select case (cviscoTensorType)
      case (0)
        ! D(u) = grad(u)
        do i=1,nelements
          do j=1,npointsPerElement
            DviscoTensorNorm(j,i) = Du1x(j,i)**2 + Du1y(j,i)**2 + &
                Du2x(j,i)**2 + Du2y(j,i)**2
          end do
        end do
        
      case (1)
        ! D(u) = 1/2 ( grad(u) + grad(u)^T )
        do i=1,nelements
          do j=1,npointsPerElement
            DviscoTensorNorm(j,i) = (Du1x(j,i)**2 + &
                0.5_DP * (Du1y(j,i) + Du2x(j,i))**2 + &
                Du2y(j,i)**2)
          end do
        end do
        
      case default
      
        DviscoTensorNorm(:,:) = 0.0_DP
        
      end select
          
    end subroutine
  
    ! ***************************************************************************
  
  !<subroutine>
  
    subroutine bma_auxFluidViscosity (cviscoModel, Dviscosity, &
        dnu,dviscoYield,dviscoEps,dviscoExponent,DviscoTensorNorm)
  
  !<description>
    ! Calculates a nonlinear viscosity.
  !</description>
  
  !<input>
    ! Type of the viscosity model:
    ! =0:  Constant viscosity:
    !        nu(x) = dnu 
    ! =1:  Power law:
    !         nu(x) = dnu * z^(dviscoexponent/2 - 1),
    !         z = ||D(u)||^2+dviscoEps
    ! =2:  Bingham fluid:
    !         nu(x) = dnu + sqrt(2)/2 * dviscoyield / sqrt(|D(u)||^2+dviscoEps^2),
    ! =3:  General viscoplastic fluid:
    !         nu(x) = dnu + sqrt(2)/2 * dviscoyield * z^(dviscoexponent/2 - 1),
    !         z = ||D(u)||^2 + dviscoEps^2
    integer, intent(in) :: cviscoModel
    
    ! Viscosity constant
    real(DP), intent(in) :: dnu
    
    ! Additional parameters for the viscosity.
    real(DP), intent(in) :: dviscoYield
    real(DP), intent(in) :: dviscoEps
    real(DP), intent(in) :: dviscoExponent
    
    ! Norm of the viscosity tensor. Must be specified if cviscoModel<>0.
    real(DP), dimension(:,:), intent(in) :: DviscoTensorNorm
  !</input>
  
  !<output>
    ! Output array. Receives for every point on every element the viscosity.
    real(DP), dimension(:,:), intent(out) :: Dviscosity
  !</output>
  
  !</subroutine>
  
      ! local variables
      integer :: npointsPerElement, nelements, i, j
      
      npointsPerElement = ubound (Dviscosity,1)
      nelements = ubound(Dviscosity,2)
  
      ! Calculate the viscosity.
      select case (cviscoModel)
      case (0)
        ! Constant:
        !   nu = dnu
        do i=1,nelements
          do j = 1,npointsPerElement
            Dviscosity(j,i) = dnu
          end do
        end do
      case (1)
        ! Power law:
        !   nu = dnu * z^(dviscoexponent/2 - 1),
        !   z = ||D(u)||^2+dviscoEps
        do i=1,nelements
          do j = 1,npointsPerElement
            Dviscosity(j,i) = &
              dnu * (DviscoTensorNorm(j,i)+dviscoEps)**(0.5_DP*dviscoExponent - 1.0_DP)
          end do
        end do
  
      case (2)
        ! Bingham fluid:
        !   nu = dnu + sqrt(2)/2 * dviscoyield / sqrt(|D(u)||^2+dviscoEps^2),
        do i=1,nelements
          do j = 1,npointsPerElement
            Dviscosity(j,i) = dnu + 0.5_DP * sqrt(2.0_DP) * &
                dviscoyield / sqrt(DviscoTensorNorm(j,i) + dviscoEps**2)
          end do
        end do
        
      case (3)
        ! General viscoplastic fluid:
        !   nu = dnu + sqrt(2)/2 * dviscoyield * z^(dviscoexponent/2 - 1),
        !   z = ||D(u)||^2 + dviscoEps^2
        do i=1,nelements
          do j = 1,npointsPerElement
            Dviscosity(j,i) = dnu + 0.5_DP * sqrt(2.0_DP) * dviscoyield * &
                ( DviscoTensorNorm(j,i) + dviscoEps**2 )**( 0.5_DP * dviscoExponent - 1.0_DP)
          end do
        end do
  
      end select
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_streamlinediff(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
        relemTempVectors,relemTempVectorsVec,du1,du2,du3,dviscosity,rvectorField,rviscosity)
  
  !<description>  
      ! Calculates the Streamline diffusion stabilisation at position (iy,ix)
      ! of the global matrix.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Scaling factor of the SD term
      real(DP), intent(in) :: dscale
      
      ! Position of the matrix where to assemble the operator to
      integer, intent(in) :: iy,ix
      
      ! Type of SD method to apply.
      ! = 0: Use simple SD stabilisation:
      !      ddelta = dupsam * h_T.
      ! = 1: Use Samarskji SD stabilisation; usually dupsam = 0.1 .. 2.
      !      ddelta = dupsam * h_t/||u||_T * 2*Re_T/(1+Re_T)
      integer, intent(in) :: cstabilType
      
      ! Method how to compute the local mesh width.
      ! = 0: Element volume based.
      ! = 1: Ray shooting method.
      integer, intent(in) :: clocalh
      
      ! Stabilisation parameter
      real(DP), intent(in) :: dupsam
      
      ! Maximum notm of the velocity over the complete domain.
      real(DP), intent(in) :: dumax
  
      ! Temporary vector structures. This structure must provide 2 temporary
      ! element-based vector buffers.
      type(t_fev2VectorData), intent(in) :: relemTempVectors
  
      ! Temporary vector structures. This structure must provide 1 temporary
      ! vector-valued element-based buffer. The buffer must have as many
      ! components as the underlying dimension of the space.
      type(t_fev2VectorData), intent(in) :: relemTempVectorsVec
  
      ! OPTIONAL: Constant velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1,du2,du3
  
      ! OPTIONAL: Constant viscosity. Must be specified if rviscosity is not
      ! present. Ignored if rviscosity is present.
      real(DP), intent(in), optional :: dviscosity
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! viscosity. Can be omitted if dviscosity is given.
      type(t_fev2VectorData), intent(in), optional :: rviscosity
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasIx, dbasIy, dbasIz, dbasJx, dbasJy, dbasJz
      integer :: iel, icubp, idofe, jdofe, ndim
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData
      real(DP), dimension(:,:), pointer :: p_Dnu
      real(DP), dimension(:), pointer :: p_DlocalDelta,p_DmeshWidth
  
      logical :: bconstNu, bconstVel
      real(DP), dimension(:,:,:), pointer :: p_Du
      real(DP), dimension(:,:), pointer :: p_DuMean
      real(DP) :: dnu,dvelX,dvelY,dvelZ, dsumI, dsumJ
  
      integer :: ndimfe
      real(DP) :: dumaxR
  
      ! Dimension of the underlying space.
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get Dnu and the temp array for the computation of the local Delta.
      p_DlocalDelta => relemTempVectors%p_DcellData(:,1)
      p_DmeshWidth => relemTempVectors%p_DcellData(:,2)
      p_DuMean => relemTempVectorsVec%p_DcellDataVec(:,:,1)
      
      dumaxR = 1.0_DP/duMax
      
      bconstVel = present(rvectorField)
      bconstNu = present(rviscosity)
      
      if (bconstNu) then
        dnu = dviscosity
      else
        p_Dnu => rviscosity%p_Ddata(:,:,DER_FUNC)
      end if
      
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_rmatrixData => RmatrixData(iy,ix)
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
      
      ! FE space dimension. We check only the first matrix.
      ndimfe = RmatrixData(iy,ix)%ndimfeTrial
      
      if (ndimfe .ne. RmatrixData(iy,ix)%ndimfeTest) then
        ! This does not make sense.
        call output_line ("Dimension of trial and test FE space different.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_mass")
        call sys_halt()
      end if
      
      ! Interleaved matrix?
      if (.not. p_rmatrixData%bisInterleaved) then
  
        ! ---------------------------------------------------
        ! Compute the mean velocity in each element
        if (bconstVel) then
  
          dvelX = 0.0_DP
          dvelY = 0.0_DP
          dvelZ = 0.0_DP
  
          ! Constant velocity
          if (present(du1)) dvelX = du1
          if (present(du2)) dvelY = du2
          if (present(du3)) dvelZ = du3
          
          ! Calculate the mean velocity in every element
          call bma_auxGetMeanVector (p_DuMean,&
              p_DcubWeight,npointsPerElement,nelements,dvelX,dvelY,dvelZ)
          
        else
          p_Du => rvectorField%p_DdataVec(:,:,:,DER_FUNC)
  
          ! Calculate the mean velocity in every element
          call bma_auxGetMeanVector (p_DuMean,&
              p_DcubWeight,npointsPerElement,nelements,Dvector=p_Du)
          
        end if
        
        ! ---------------------------------------------------
        ! Calculate the local mesh width.
        select case (clocalh)
        case (0)
          call bma_auxGetLocalMeshWidth_area (&
              rassemblyData%p_IelementList,rmatrixAssembly%p_rtriangulation,p_DmeshWidth)
              
        case (1)
          select case (ndim)
          case (NDIM2D)
            ! Only exists in 2D.
            call bma_auxGetLocalMeshWidth_ray (&
                rassemblyData%p_IelementList,p_DuMean,rmatrixAssembly%p_rtriangulation,p_DmeshWidth)
  
          case default
            ! Fallback
            call bma_auxGetLocalMeshWidth_area (&
                rassemblyData%p_IelementList,rmatrixAssembly%p_rtriangulation,p_DmeshWidth)
          end select
        end select
  
        ! ---------------------------------------------------
        ! Compute the local delta
        if (bconstNu) then
          call bma_auxGetLDelta (p_DlocalDelta,cstabiltype,dupsam,duMaxR,p_DcubWeight,&
                p_DmeshWidth,npointsPerElement,nelements,p_DuMean,dnu)
        else
          call bma_auxGetLDelta (p_DlocalDelta,cstabiltype,dupsam,duMaxR,p_DcubWeight,&
                p_DmeshWidth,npointsPerElement,nelements,p_DuMean,Dnu=p_Dnu)
        end if
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
          
          ! Set up the operator
          !
          ! n~_h (u_h, phi_i, phi_j)
          !
          ! =   ( u_h*grad Phi_j, u_h*grad Phi_i )_T
          !
          ! =   ( < (DU1) , (grad(Phi_j)_1) > , < (DU1) , (grad(Phi_i)_1) > )_T
          !         (DU2) , (grad(Phi_j)_2)       (DU2) , (grad(Phi_i)_2)
          !
          ! =   < (DU1) , (grad(Phi_j)_1) >  *  < (DU1) , (grad(Phi_j)_1) >
          !       (DU2) , (grad(Phi_j)_2)         (DU2) , (grad(Phi_j)_2)
          !
          ! =   dsumJ * dsumI
          !
          ! weighted with dlocalDelta, which is computed depending
          ! on the viscosity, velocity etc.
          
          select case (ndim)
          ! ===========================================================
          ! 1D, scalar valued FEM space
          ! ===========================================================
          case (NDIM1D)
  
            ! -------------------------------------------------------
            ! Scalar target matrix and tensor target, no difference
            ! -------------------------------------------------------
            
            ! Get the matrix data
            p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
  
            if (bconstVel) then
            
              ! -------------------------------------------------------
              ! Constant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
              
            else
            
              ! -------------------------------------------------------
              ! Nonconstant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the velocity in that point.
                  dvelX = p_Du(1,icubp,iel)
                  dvelY = p_Du(2,icubp,iel)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end if
  
          ! ===========================================================
          ! 2D, scalar valued FEM space
          ! ===========================================================
          case (NDIM2D)
  
            ! -------------------------------------------------------
            ! Scalar target matrix
            ! -------------------------------------------------------
            
            ! Get the matrix data
            p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
  
            if (bconstVel) then
            
              ! -------------------------------------------------------
              ! Constant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
              
            else
            
              ! -------------------------------------------------------
              ! Nonconstant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the velocity in that point.
                  dvelX = p_Du(1,icubp,iel)
                  dvelY = p_Du(2,icubp,iel)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end if
              
          ! ===========================================================
          ! 3D, scalar valued FEM space
          ! ===========================================================
          case (NDIM3D)
  
            ! -------------------------------------------------------
            ! Scalar target matrix
            ! -------------------------------------------------------
            
            ! Get the matrix data
            p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
  
            if (bconstVel) then
            
              ! -------------------------------------------------------
              ! Constant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy + dvelZ*dbasIz)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy + dvelZ*dbasJz
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
              
            else
            
              ! -------------------------------------------------------
              ! Nonconstant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the velocity in that point.
                  dvelX = p_Du(1,icubp,iel)
                  dvelY = p_Du(2,icubp,iel)
                  dvelZ = p_Du(3,icubp,iel)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy + dvelZ*dbasIz)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy + dvelZ*dbasJz
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end if
              
          end select
          
        else
        
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
        end if ! ndimfe = 1
  
      else
  
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_docalc_streamlinediffTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
        relemTempVectors,relemTempVectorsVec,du1,du2,du3,dviscosity,rvectorField,rviscosity)
  
  !<description>  
      ! Calculates the Streamline diffusion stabilisation to a tensor at position (iy,ix)
      ! of the global matrix.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Scaling factor of the SD term
      real(DP), intent(in) :: dscale
      
      ! Position of the matrix where to assemble the operator to
      integer, intent(in) :: iy,ix
      
      ! Type of SD method to apply.
      ! = 0: Use simple SD stabilisation:
      !      ddelta = dupsam * h_T.
      ! = 1: Use Samarskji SD stabilisation; usually dupsam = 0.1 .. 2.
      !      ddelta = dupsam * h_t/||u||_T * 2*Re_T/(1+Re_T)
      integer, intent(in) :: cstabilType
      
      ! Method how to compute the local mesh width.
      ! = 0: Element volume based.
      ! = 1: Ray shooting method.
      integer, intent(in) :: clocalh
      
      ! Stabilisation parameter
      real(DP), intent(in) :: dupsam
      
      ! Maximum notm of the velocity over the complete domain.
      real(DP), intent(in) :: dumax
  
      ! Temporary vector structures. This structure must provide 2 temporary
      ! element-based vector buffers.
      type(t_fev2VectorData), intent(in) :: relemTempVectors
  
      ! Temporary vector structures. This structure must provide 1 temporary
      ! vector-valued element-based buffer. The buffer must have as many
      ! components as the underlying dimension of the space.
      type(t_fev2VectorData), intent(in) :: relemTempVectorsVec
  
      ! OPTIONAL: Constant velocity. Must be specified if rvectorField is not
      ! present. Ignored if rvectorField is present.
      real(DP), intent(in), optional :: du1,du2,du3
  
      ! OPTIONAL: Constant viscosity. Must be specified if rviscosity is not
      ! present. Ignored if rviscosity is present.
      real(DP), intent(in), optional :: dviscosity
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! velocity field. Can be omitted if du1/du2/du3 is given.
      type(t_fev2VectorData), intent(in), optional :: rvectorField
  
      ! OPTIONAL: Evaluation structure that describes an underlying nonconstant
      ! viscosity. Can be omitted if dviscosity is given.
      type(t_fev2VectorData), intent(in), optional :: rviscosity
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dbasIx, dbasIy, dbasIz, dbasJx, dbasJy, dbasJz
      integer :: iel, icubp, idofe, jdofe, ndim
      real(DP), dimension(:,:,:), pointer :: p_DlocalMatrix11,p_DlocalMatrix22,p_DlocalMatrix33
      real(DP), dimension(:,:,:,:), pointer :: p_DbasTrial,p_DbasTest
      real(DP), dimension(:,:), pointer :: p_DcubWeight
      type(t_bmaMatrixData), pointer :: p_rmatrixData
      real(DP), dimension(:,:), pointer :: p_Dnu
      real(DP), dimension(:), pointer :: p_DlocalDelta,p_DmeshWidth
  
      logical :: bconstNu, bconstVel
      real(DP), dimension(:,:,:), pointer :: p_Du
      real(DP), dimension(:,:), pointer :: p_DuMean
      real(DP) :: dnu,dvelX,dvelY,dvelZ, dsumI, dsumJ
  
      integer :: ndimfe
      real(DP) :: dumaxR
  
      ! Dimension of the underlying space.
      ndim = rmatrixAssembly%p_rtriangulation%ndim
      
      ! Get Dnu and the temp array for the computation of the local Delta.
      p_DlocalDelta => relemTempVectors%p_DcellData(:,1)
      p_DmeshWidth => relemTempVectors%p_DcellData(:,2)
      p_DuMean => relemTempVectorsVec%p_DcellDataVec(:,:,1)
      
      dumaxR = 1.0_DP/duMax
      
      bconstNu = present(rviscosity)
      bconstVel = present(rvectorField)
      
      if (bconstNu) then
        dnu = dviscosity
      else
        p_Dnu => rviscosity%p_Ddata(:,:,DER_FUNC)
      end if
      
      ! Get cubature weights data
      p_DcubWeight => rassemblyData%p_DcubWeight
  
      ! Get local data
      p_rmatrixData => RmatrixData(iy,ix)
      p_DbasTrial => RmatrixData(iy,ix)%p_DbasTrial
      p_DbasTest => RmatrixData(iy,ix)%p_DbasTest
      
      ! FE space dimension. We check only the first matrix.
      ndimfe = RmatrixData(iy,ix)%ndimfeTrial
      
      if (ndimfe .ne. RmatrixData(iy,ix)%ndimfeTest) then
        ! This does not make sense.
        call output_line ("Dimension of trial and test FE space different.",&
            OU_CLASS_ERROR,OU_MODE_STD,"bma_fcalc_mass")
        call sys_halt()
      end if
      
      ! Interleaved matrix?
      if (.not. p_rmatrixData%bisInterleaved) then
  
        ! ---------------------------------------------------
        ! Compute the mean velocity in each element
        if (bconstVel) then
  
          dvelX = 0.0_DP
          dvelY = 0.0_DP
          dvelZ = 0.0_DP
  
          ! Constant velocity
          if (present(du1)) dvelX = du1
          if (present(du2)) dvelY = du2
          if (present(du3)) dvelZ = du3
          
          ! Calculate the mean velocity in every element
          call bma_auxGetMeanVector (p_DuMean,&
              p_DcubWeight,npointsPerElement,nelements,dvelX,dvelY,dvelZ)
          
        else
          p_Du => rvectorField%p_DdataVec(:,:,:,DER_FUNC)
  
          ! Calculate the mean velocity in every element
          call bma_auxGetMeanVector (p_DuMean,&
              p_DcubWeight,npointsPerElement,nelements,Dvector=p_Du)
          
        end if
        
        ! ---------------------------------------------------
        ! Calculate the local mesh width.
        select case (clocalh)
        case (0)
          call bma_auxGetLocalMeshWidth_area (&
              rassemblyData%p_IelementList,rmatrixAssembly%p_rtriangulation,p_DmeshWidth)
              
        case (1)
          select case (ndim)
          case (NDIM2D)
            ! Only exists in 2D.
            call bma_auxGetLocalMeshWidth_ray (&
                rassemblyData%p_IelementList,p_DuMean,rmatrixAssembly%p_rtriangulation,p_DmeshWidth)
  
          case default
            ! Fallback
            call bma_auxGetLocalMeshWidth_area (&
                rassemblyData%p_IelementList,rmatrixAssembly%p_rtriangulation,p_DmeshWidth)
          end select
        end select
  
        ! ---------------------------------------------------
        ! Compute the local delta
        if (bconstNu) then
          call bma_auxGetLDelta (p_DlocalDelta,cstabiltype,dupsam,duMaxR,p_DcubWeight,&
                p_DmeshWidth,npointsPerElement,nelements,p_DuMean,dnu)
        else
          call bma_auxGetLDelta (p_DlocalDelta,cstabiltype,dupsam,duMaxR,p_DcubWeight,&
                p_DmeshWidth,npointsPerElement,nelements,p_DuMean,Dnu=p_Dnu)
        end if
  
        if (ndimfe .eq. 1) then
  
          ! -----------------------
          ! Scalar-valued FE space. 
          ! -----------------------
          ! This IF command prevents an inner IF command and speeds 
          ! up the computation for all scalar standard FE spaces.
          
          ! Set up the operator
          !
          ! n~_h (u_h, phi_i, phi_j)
          !
          ! =   ( u_h*grad Phi_j, u_h*grad Phi_i )_T
          !
          ! =   ( < (DU1) , (grad(Phi_j)_1) > , < (DU1) , (grad(Phi_i)_1) > )_T
          !         (DU2) , (grad(Phi_j)_2)       (DU2) , (grad(Phi_i)_2)
          !
          ! =   < (DU1) , (grad(Phi_j)_1) >  *  < (DU1) , (grad(Phi_j)_1) >
          !       (DU2) , (grad(Phi_j)_2)         (DU2) , (grad(Phi_j)_2)
          !
          ! =   dsumJ * dsumI
          !
          ! weighted with dlocalDelta, which is computed depending
          ! on the viscosity, velocity etc.
          
          select case (ndim)
          ! ===========================================================
          ! 1D, scalar valued FEM space
          ! ===========================================================
          case (NDIM1D)
  
            ! -------------------------------------------------------
            ! Scalar target matrix and tensor target, no difference
            ! -------------------------------------------------------
            
            ! Get the matrix data
            p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
  
            if (bconstVel) then
            
              ! -------------------------------------------------------
              ! Constant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
              
            else
            
              ! -------------------------------------------------------
              ! Nonconstant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the velocity in that point.
                  dvelX = p_Du(1,icubp,iel)
                  dvelY = p_Du(2,icubp,iel)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV1D_X,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV1D_X,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end if
  
          ! ===========================================================
          ! 2D, scalar valued FEM space
          ! ===========================================================
          case (NDIM2D)
  
            ! -------------------------------------------------------
            ! Tensor target
            ! -------------------------------------------------------
  
            ! Get the matrix data
            p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
            p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
  
            if (bconstVel) then
            
              ! -------------------------------------------------------
              ! Constant velocity
              ! -------------------------------------------------------
              
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
                      p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
              
            else
            
              ! -------------------------------------------------------
              ! Nonconstant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the velocity in that point.
                  dvelX = p_Du(1,icubp,iel)
                  dvelY = p_Du(2,icubp,iel)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV2D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV2D_Y,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV2D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV2D_Y,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
                      p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end if
    
          ! ===========================================================
          ! 3D, scalar valued FEM space
          ! ===========================================================
          case (NDIM3D)
  
            ! -------------------------------------------------------
            ! Tensor target
            ! -------------------------------------------------------
  
            ! Get the matrix data
            p_DlocalMatrix11 => RmatrixData(iy,ix)%p_Dentry
            p_DlocalMatrix22 => RmatrixData(iy+1,ix+1)%p_Dentry
            p_DlocalMatrix33 => RmatrixData(iy+2,ix+2)%p_Dentry
  
            if (bconstVel) then
            
              ! -------------------------------------------------------
              ! Constant velocity
              ! -------------------------------------------------------
              
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy + dvelZ*dbasIz)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy + dvelZ*dbasJz
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
                      p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                          dsumJ*dsumI
                      p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
              
            else
            
              ! -------------------------------------------------------
              ! Nonconstant velocity
              ! -------------------------------------------------------
  
              ! Loop over the elements in the current set.
              do iel = 1,nelements
  
                ! Loop over all cubature points on the current element
                do icubp = 1,npointsPerElement
                
                  ! Get the velocity in that point.
                  dvelX = p_Du(1,icubp,iel)
                  dvelY = p_Du(2,icubp,iel)
                  dvelZ = p_Du(3,icubp,iel)
  
                  ! Outer loop over the DOF's i=1..ndof on our current element,
                  ! which corresponds to the (test) basis functions Psi_i:
                  do idofe=1,p_rmatrixData%ndofTest
  
                    ! Fetch the contributions of the (test) basis functions Psi_i
                    ! into dbasIx/y
                    dbasIx = p_DbasTest(idofe,DER_DERIV3D_X,icubp,iel)
                    dbasIy = p_DbasTest(idofe,DER_DERIV3D_Y,icubp,iel)
                    dbasIz = p_DbasTest(idofe,DER_DERIV3D_Z,icubp,iel)
                    
                    ! Calculate dsumI, multiply with dscale, the local delta
                    ! and the cubature weight. Saves some multiplications.
                    dsumI = dscale * p_DcubWeight(icubp,iel) * p_DlocalDelta(iel) * &
                            (dvelX*dbasIx + dvelY*dbasIy + dvelZ*dbasIz)
  
                    ! Inner loop over the DOF's j=1..ndof, which corresponds to
                    ! the (trial) basis function Phi_j:
                    do jdofe=1,p_rmatrixData%ndofTrial
  
                      ! Fetch the contributions of the (trial) basis function Phi_j
                      ! into dbasJx/y
                      dbasJx = p_DbasTrial(jdofe,DER_DERIV3D_X,icubp,iel)
                      dbasJy = p_DbasTrial(jdofe,DER_DERIV3D_Y,icubp,iel)
                      dbasJz = p_DbasTrial(jdofe,DER_DERIV3D_Z,icubp,iel)
  
                      ! Calculate dsumJ
                      dsumJ = dvelX*dbasJx + dvelY*dbasJy + dvelZ*dbasJz
  
                      ! Multiply the values of the basis functions
                      ! (1st derivatives) by the cubature weight and sum up
                      ! into the local matrices.
                      p_DlocalMatrix11(jdofe,idofe,iel) = p_DlocalMatrix11(jdofe,idofe,iel) + &
                          dsumJ*dsumI
                      p_DlocalMatrix22(jdofe,idofe,iel) = p_DlocalMatrix22(jdofe,idofe,iel) + &
                          dsumJ*dsumI
                      p_DlocalMatrix33(jdofe,idofe,iel) = p_DlocalMatrix33(jdofe,idofe,iel) + &
                          dsumJ*dsumI
  
                    end do ! jdofe
  
                  end do ! idofe
  
                end do ! icubp
  
              end do ! iel
  
            end if
  
          end select
          
        else
        
          ! -----------------------
          ! Vector-valued FE space.
          ! -----------------------
          ! This implementation works for all types of finite elements, but it
          ! is slightly slower for scalar FE spaces due to an additional inner loop.
  
        end if ! ndimfe = 1
  
      else
  
      end if
  
    end subroutine
  
    !****************************************************************************
  
  !<subroutine>
  
    subroutine bma_fcalc_streamlinediff(RmatrixData,rassemblyData,rmatrixAssembly,&
        npointsPerElement,nelements,revalVectors,rcollection)
  
  !<description>  
      ! Calculates the Streamline diffusion stabilisation.
      !
      ! If rcollection must be specified, the following parameters are expected:
      !
      ! rcollection%DquickAccess(1) = scaling factor
      ! rcollection%DquickAccess(2) = stabilisation parameter dupsam
      ! rcollection%DquickAccess(3) = maximum norm of the velocity vector
      ! rcollection%DquickAccess(4) = constant viscosity (if constant)
      ! rcollection%DquickAccess(5:7) = constant velocity (if constant)
      !
      ! rcollection%IquickAccess(1) = y-position in the destination matrix
      ! rcollection%IquickAccess(2) = x-position in the destination matrix
      ! rcollection%IquickAccess(3) = Specifies the target tensor/matrix
      !                               =0: Only apply SD to the position (iy,ix)
      !                               =1: Apply SD to the full tensor (iy,ix)..(iy+dim,ix+dim)
      ! rcollection%IquickAccess(4) = Type of SD method to apply.
      !                               = 0: Use simple SD stabilisation:
      !                                    ddelta = dupsam * h_T.
      !                               = 1: Use Samarskji SD stabilisation; usually dupsam = 0.1 .. 2.
      !                                    ddelta = dupsam * h_t/||u||_T * 2*Re_T/(1+Re_T)
      ! rcollection%IquickAccess(5) = Method how to compute the local mesh width.
      !                               = 0: Element volume based.
      !                               = 1: Ray shooting method.
      ! rcollection%IquickAccess(6) = Specifies the velocity field.
      !                               =0: Use a constant velocity field du1,du2,du3
      !                                   given in DquickAccess
      !                               =1: Use a nonconstant velocity field, given in
      !                                   revalVectors
      ! rcollection%IquickAccess(7) = Specifies the viscosity.
      !                               =0: Use a constant velocity field dnu
      !                                   given in DquickAccess
      !                               =1: Use a nonconstant velocity field, given in
      !                                   revalVectors
      !
      ! Furthermore, the following vectors must be provided in revalVectors:
      !
      !   revalVectors(1) = Element-based temporary vector
      !   revalVectors(2) = Element-based temporary vector
      !   revalVectors(3) = Vector-valued element based temporary vector, as many components
      !                     as the velocity
      !   revalVectors(4) = velocity field, n-dimensional, including 1st derivative if nonconstant.
      !   revalVectors(5/4) = nonconstant viscosity coefficient if nonconstant.
  !</description>
  
  !<inputoutput>
      ! Matrix data of all matrices. The arrays p_Dentry of all submatrices
      ! have to be filled with data.
      type(t_bmaMatrixData), dimension(:,:), intent(inout), target :: RmatrixData
  !</inputoutput>
  
  !<input>
      ! Data necessary for the assembly. Contains determinants and
      ! cubature weights for the cubature,...
      type(t_bmaMatrixAssemblyData), intent(in) :: rassemblyData
  
      ! Structure with all data about the assembly
      type(t_bmaMatrixAssembly), intent(in) :: rmatrixAssembly
  
      ! Number of points per element
      integer, intent(in) :: npointsPerElement
  
      ! Number of elements
      integer, intent(in) :: nelements
  
      ! Values of FEM functions automatically evaluated in the
      ! cubature points.
      type(t_fev2Vectors), intent(in) :: revalVectors
  
      ! User defined collection structure
      type(t_collection), intent(inout), target, optional :: rcollection
  !</input>
  
  !</subroutine>
  
      ! Local variables
      real(DP) :: dscale,dupsam,dumax,du1,du2,du3,dviscosity
      integer :: iy,ix,cstabiltype,clocalh
      logical :: btensor,bconstVel,bconstNu
      
      ! Fetch parameters from the collection
      dscale                = rcollection%DquickAccess(1)
      dupsam                = rcollection%DquickAccess(2)
      dumax                 = rcollection%DquickAccess(3)
      dviscosity            = rcollection%DquickAccess(4)
      du1                   = rcollection%DquickAccess(5)
      du2                   = rcollection%DquickAccess(6)
      du3                   = rcollection%DquickAccess(7)
  
      iy                    = rcollection%IquickAccess(1)
      ix                    = rcollection%IquickAccess(2)
      btensor               = rcollection%IquickAccess(3) .ne. 0
      cstabiltype           = rcollection%IquickAccess(4)
      clocalh               = rcollection%IquickAccess(5)
      bconstVel             = rcollection%IquickAccess(6) .eq. 0
      bconstNu              = rcollection%IquickAccess(7) .eq. 0
  
      ! Invoke the SD operator.
      if (.not. btensor) then
       
        if (bconstNu) then
          if (bconstVel) then
            call bma_docalc_streamlinediff(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity)
          else
            call bma_docalc_streamlinediff(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity,&
                revalVectors%p_RvectorData(4))
          end if
        else
          if (bconstVel) then
            call bma_docalc_streamlinediff(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity,&
                rviscosity=revalVectors%p_RvectorData(4))
          else
            call bma_docalc_streamlinediff(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity,&
                revalVectors%p_RvectorData(4),revalVectors%p_RvectorData(5))
          end if
        end if
        
      else
  
        if (bconstNu) then
          if (bconstVel) then
            call bma_docalc_streamlinediffTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity)
          else
            call bma_docalc_streamlinediffTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity,&
                revalVectors%p_RvectorData(4))
          end if
        else
          if (bconstVel) then
            call bma_docalc_streamlinediffTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity,&
                rviscosity=revalVectors%p_RvectorData(4))
          else
            call bma_docalc_streamlinediffTensor(RmatrixData,rassemblyData,rmatrixAssembly,&
                npointsPerElement,nelements,dscale,iy,ix,cstabiltype,clocalh,dupsam,dumax,&
                revalVectors%p_RvectorData(1),revalVectors%p_RvectorData(2),du1,du2,du3,dviscosity,&
                revalVectors%p_RvectorData(4),revalVectors%p_RvectorData(5))
          end if
        end if
      
      end if
    
    end subroutine
  
  end module
  