ply_fpt_header_module.f90 Source File


This file depends on

sourcefile~~ply_fpt_header_module.f90~~EfferentGraph sourcefile~ply_fpt_header_module.f90 ply_fpt_header_module.f90 sourcefile~ply_nodes_header_module.f90 ply_nodes_header_module.f90 sourcefile~ply_fpt_header_module.f90->sourcefile~ply_nodes_header_module.f90

Files dependent on this one

sourcefile~~ply_fpt_header_module.f90~~AfferentGraph sourcefile~ply_fpt_header_module.f90 ply_fpt_header_module.f90 sourcefile~ply_polybaseexc_module.f90 ply_polyBaseExc_module.f90 sourcefile~ply_polybaseexc_module.f90->sourcefile~ply_fpt_header_module.f90 sourcefile~ply_prj_header_module.f90 ply_prj_header_module.f90 sourcefile~ply_prj_header_module.f90->sourcefile~ply_fpt_header_module.f90 sourcefile~ply_legfpt_module.f90 ply_legFpt_module.f90 sourcefile~ply_legfpt_module.f90->sourcefile~ply_fpt_header_module.f90 sourcefile~ply_legfpt_module.f90->sourcefile~ply_polybaseexc_module.f90 sourcefile~ply_legfpt_2d_module.f90 ply_legFpt_2D_module.f90 sourcefile~ply_legfpt_2d_module.f90->sourcefile~ply_legfpt_module.f90 sourcefile~ply_dynarray_project_module.f90 ply_dynArray_project_module.f90 sourcefile~ply_dynarray_project_module.f90->sourcefile~ply_prj_header_module.f90 sourcefile~ply_poly_project_module.f90 ply_poly_project_module.f90 sourcefile~ply_poly_project_module.f90->sourcefile~ply_prj_header_module.f90 sourcefile~ply_poly_project_module.f90->sourcefile~ply_legfpt_module.f90 sourcefile~ply_legfpt_3d_module.f90 ply_legFpt_3D_module.f90 sourcefile~ply_legfpt_3d_module.f90->sourcefile~ply_legfpt_module.f90 sourcefile~atl_stabilize_module.f90 atl_stabilize_module.f90 sourcefile~atl_stabilize_module.f90->sourcefile~ply_polybaseexc_module.f90

Contents


Source Code

! Copyright (c) 2013-2014 Verena Krupp
! Copyright (c) 2013-2014, 2016, 2020 Harald Klimach <harald.klimach@uni-siegen.de>
! Copyright (c) 2013-2014, 2016-2017, 2020 Peter Vitt <peter.vitt2@uni-siegen.de>
! Copyright (c) 2014 Nikhil Anand <nikhil.anand@uni-siegen.de>
! Copyright (c) 2017 Daniel Petró <daniel.petro@student.uni-siegen.de>
! Copyright (c) 2019 Neda Ebrahimi Pour <neda.epour@uni-siegen.de>
!
! Parts of this file were written by Verena Krupp, Harald Klimach, Peter Vitt,
! Nikhil Anand, Daniel Petró and Neda Ebrahimi Pour for University of Siegen.
!
! Permission to use, copy, modify, and distribute this software for any
! purpose with or without fee is hereby granted, provided that the above
! copyright notice and this permission notice appear in all copies.
!
! THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES
! WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
! MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR
! ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
! WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
! ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
! OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
! **************************************************************************** !
!
!> Parameters for the FPT method
!!
!! The Fast Polynomial Transformation implements the approach described in
!! B. K. Alpert und V. Rokhlin, „A Fast Algorithm for the Evaluation of
!! Legendre Expansions“, SIAM Journal on Scientific and Statistical Computing,
!! Vol. 12, Nr. 1, pp. 158–179, Jan. 1991, doi: 10.1137/0912009.
!!
!! It utilizes the Fast Fourier Transformation by first converting the
!! Legendre modes into Chebyshev modes.
!! The conversion between Legendre and Chebyshev modes is done approximately
!! by approximating increasingly larger blocks away from the diagonal.
!! This method is only available if the executable is linked against the
!! [FFTW](http://fftw.org/).
!!
!! As with the other projection methods, a `factor` can be specified to
!! use more points in the nodal representation and achieve some de-aliasing.
!! Because the FFT works especially well for powers of two, it is possible to
!! choose the oversampling such, that the oversampled modes have count of the
!! next larger power of 2.
!! To achieve this, the option `adapt_factor_pow2` has to be set to `true`,
!! by default it is assumed to be `false`.
!! Further it is possible to make use of `lobattoPoints` with this
!! transformation method.
!! If `lobattoPoints = true`, the points on the interval boundary will be
!! included in the set of points in the nodal representation. This is for
!! example necessary when positivity is to be preserved for the numerical
!! fluxes.
!! By default this setting is `false`.
!!
!! All other options tune the transformation algorithm:
!!
!! * `blocksize` defines the minimal block size that is to be approximated in
!!   the transformation matrix. It defaults to 64, which is the recommendation
!!   for double precision computations, but requires high polynomial degrees to
!!   attain any approximation at all. The (oversampled) number of nodes needs to
!!   be larger than two times the blocksize, to have at least one approximated
!!   block. As long as the number modes is below this threshold the method is
!!   not "fast" and a computational complexity of number of modes squared is
!!   required for the operation. Smaller values push the approximation closer
!!   to the diagonal. This can speed up the computation for smaller number of
!!   modes but also detoriates the accuracy of the transformation.
!! * `approx_terms` number of terms to use in the approximation of blocks,
!!   defaults to 18, which is recommended for double precision computations.
!!   In each block only `approx_terms` will be used to represent rows in the
!!   block. Smaller values make the transformation faster, but less accurate
!!   (if blocks are actually approximated).
!! * `implementation` selects the implementation for the transformation. There
!!   are two variants of the implementation: `'scalar'` this is the default
!!   and treats the transformations with an outer loop over the independent
!!   operations. The `'vector'` implementation on the other hand gathers
!!   multiple independent operations together and performs them all at once
!!   with an inner loop over blocks length `striplen`. While the `'vector'`
!!   variant may exploit vector instructions, it utilizes a larger amount of
!!   temporary memory. The default setting for this option is `'scalar'`.
!! * `striplen` determines the length for vectorized loops to be used in the
!!   matrix operation. It defaults to the `vlen` setting defined in
!!   [[tem_compileconf_module]] during compilation.
!!   Depending on the computing architecture, different values may provide
!!   more efficient computations.
!! * `subblockingWidth` defines striding in the multiplication of the diagonal
!!   elements in the transformation matrix. The default for this setting is 8.
!!
!! The configuration table for the FPT table may, for example, look as follows:
!!
!!```lua
!!  projection = {
!!    kind              = 'fpt',
!!    factor            = 1.5,
!!    adapt_factor_pow2 = true,
!!    lobattoPoints     = false,
!!    blocksize         = 16,
!!    approx_terms      = 12,
!!    implementation    = 'scalar',
!!    striplen          = 256,
!!    subblockingWidth  = 8
!!  }
!!```
module ply_fpt_header_module

  use env_module,              only: rk, labelLen
  use aotus_module,            only: flu_State, aot_get_val
  use aot_out_module,          only: aot_out_type, aot_out_val

  use tem_aux_module,          only: tem_abort
  use tem_tools_module,        only: upper_to_lower
  use tem_logging_module,      only: logUnit
  use tem_compileconf_module,  only: vlen
  use tem_float_module
  use ply_nodes_header_module

  implicit none

  private

  !> The recommended minimal blocksize for double precision.
  integer, public, parameter :: ply_fpt_default_blocksize = 64

  !> The default width of the subblocking of the diagonal calculation of the
  !! fpt projection
  integer, public, parameter :: ply_fpt_default_subblockingWidth = 8

  !> Default number of terms to use in FPT blocks. 18 is recommended for
  !! double precision.
  integer, public, parameter :: ply_fpt_default_approx_terms = 18

  !> Value to signify the use of the scalar FPT implementation.
  integer, public, parameter :: ply_fpt_scalar = 1

  !> Value to signify the use of the vector FPT implementation.
  integer, public, parameter :: ply_fpt_vector = 2

  !> Type for the fpt header, stores all information needed to initialize the
  !! fpt method later on
  type ply_fpt_header_type
    type(ply_nodes_header_type) :: nodes_header
    !> In case of nonlinear equations, aliasing occurs if the projections
    !! of the nonlinear terms on the testfunctions are not calculated
    !! accurately enough. To avoid these errors it is possible to
    !! extend the transformation vectors of the FPT with zeros. This
    !! factor determines by how many zeros the modal vector is extended
    !! before transformation. This factor has to be chosen properly with
    !! respect of the type of nonlinearity of your equation.
    real(kind=rk) :: factor = 1.0_rk

    !> The blockisze of the fast bases exchange algorithm from
    !! Legendre to Chebyshev polynomials.
    !! A negative number indicates to use the default blocksize of the
    !! algorithm.
    integer :: blocksize = ply_fpt_default_blocksize

    !> The number of approximation terms to use for blocks apart from the
    !! diagonal.
    !!
    !! This defaults to 18, which is recommended for double precision.
    integer :: approx_terms = ply_fpt_default_approx_terms

    !> The implementation variant to use for the transformation computation.
    !!
    !! The computation can be done either by a `'vector'` implementation or
    !! by a `'scalar'` implementation.
    !! We indicate the respective implementations by the integers
    !! [[ply_fpt_header_module:ply_fpt_scalar]] or
    !! [[ply_fpt_header_module:ply_fpt_vector]].
    integer :: implementation

    !> The striplen, that should be used for vectorized simultaneous
    !! computations of the matrix operation.
    !!
    !! This defaults to the vlen from the TEM_compileconf_module, it might
    !! be set differently here, as we are dealing with a twodimensional
    !! problem here, and the optimal setting might be different from the code
    !! parts.
    integer :: striplen = vlen

    !> The width of the subblocks used during the unrolled base exchange to
    !! ensure a better cache usage.
    !!
    !! The default is a subblocking width of 8.
    integer :: subblockingWidth = ply_fpt_default_subblockingWidth

    !> Should the oversampling factor be adapted to ensure a power of 2
    !! in the oversampled polynomial?
    !!
    !! If this is true, the factor will be increased to ensure
    !! an oversampled representation with a power of 2.
    !! Default is false.
    logical :: adapt_factor_pow2 = .false.
  end type ply_fpt_header_type

  interface assignment(=)
    module procedure Copy_fpt_header
  end interface

  interface operator(==)
    module procedure isEqual
  end interface

  interface operator(/=)
    module procedure isUnequal
  end interface

  interface operator(<)
    module procedure isSmaller
  end interface

  interface operator(<=)
    module procedure isSmallerOrEqual
  end interface

  interface operator(>)
    module procedure isGreater
  end interface

  interface operator(>=)
    module procedure isGreaterOrEqual
  end interface

  public :: operator(==), operator(/=), operator(<), operator(<=)
  public :: operator(>), operator(>=)

  public :: ply_fpt_header_load, ply_fpt_header_display
  public :: ply_fpt_header_define
  public :: ply_fpt_header_type
  public :: ply_fpt_header_out

  public :: assignment(=)


contains


  ! ------------------------------------------------------------------------ !
  !> Copy the FPT header information.
  pure subroutine Copy_fpt_header(left,right)
    ! -------------------------------------------------------------------- !
    !> fpt to copy to
    type(ply_Fpt_header_type), intent(out) :: left
    !> fpt to copy from
    type(ply_Fpt_header_type), intent(in) :: right
    ! -------------------------------------------------------------------- !

    left%nodes_header = right%nodes_header
    left%factor = right%factor
    left%blocksize = right%blocksize
    left%adapt_factor_pow2 = right%adapt_factor_pow2
    left%approx_terms = right%approx_terms
    left%implementation = right%implementation
    left%striplen = right%striplen
    left%subblockingWidth = right%subblockingWidth

  end subroutine Copy_fpt_header
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> Read the FPT configuration options from the provided Lua script in
  !! `conf`.
  subroutine ply_fpt_header_load(me, conf, thandle)
    ! -------------------------------------------------------------------- !
    type(ply_fpt_header_type), intent(out) :: me
    type(flu_State), intent(inout) :: conf
    integer, intent(in) :: thandle
    ! -------------------------------------------------------------------- !
    integer :: iError
    character(len=labelLen) :: impl_variant
    ! -------------------------------------------------------------------- !
    ! check for fpt lib

    ! for fpt chebyshev nodes are used
    me%nodes_header%nodes_kind = 'chebyshev'

    ! fill up the fpt_header
    call aot_get_val( L       = conf,                      &
      &               thandle = thandle,                   &
      &               key     = 'blocksize',               &
      &               val     = me%blocksize ,             &
      &               default = ply_fpt_default_blocksize, &
      &               ErrCode = iError                     )

    if (me%blocksize <= 0) then
      write(logUnit(1),*) 'ERROR in loading projection: blocksize for FPT has' &
        & // ' to be larger than 0!'
      write(logUnit(1),*) 'But it is set to ', me%blocksize
      call tem_abort()
    end if

    call aot_get_val( L       = conf,      &
      &               thandle = thandle,   &
      &               key     = 'factor',  &
      &               val     = me%factor, &
      &               default = 1.0_rk,    &
      &               ErrCode = iError     )

    if (me%factor <= 0) then
      write(logUnit(1),*) 'ERROR in loading projection: factor for projection' &
        & // ' has to be larger than 0!'
      write(logUnit(1),*) 'But it is set to ', me%factor
      call tem_abort()
    end if

    call aot_get_val( L       = conf,                        &
      &               thandle = thandle,                     &
      &               key     = 'approx_terms',              &
      &               val     = me%approx_terms,             &
      &               ErrCode = iError,                      &
      &               default = ply_fpt_default_approx_terms )

    call aot_get_val( L       = conf,             &
      &               thandle = thandle,          &
      &               key     = 'implementation', &
      &               val     = impl_variant,     &
      &               ErrCode = iError,           &
      &               default = 'scalar'          )
    impl_variant = upper_to_lower(impl_variant)
    impl_variant = adjustl(impl_variant)
    select case(trim(impl_variant))
    case('scalar')
      me%implementation = ply_fpt_scalar
    case('vector')
      me%implementation = ply_fpt_vector
    case default
      write(logUnit(1),*) 'ERROR in loading projection: implementation' &
        & // ' has to be either "scalar" or "vector"!'
      write(logUnit(1),*) 'But it is set to ', trim(impl_variant)
      call tem_abort()
    end select

    call aot_get_val( L       = conf,        &
      &               thandle = thandle,     &
      &               key     = 'striplen',  &
      &               val     = me%striplen, &
      &               ErrCode = iError,      &
      &               default = vlen         )

    call aot_get_val( L       = conf,                            &
      &               thandle = thandle,                         &
      &               key     = 'subblockingWidth',              &
      &               val     = me%subblockingWidth,             &
      &               ErrCode = iError,                          &
      &               default = ply_fpt_default_subblockingWidth )

    write(logUnit(1), *) 'subblockingWidth = ', me%subblockingWidth

    call aot_get_val( L       = conf,                 &
      &               thandle = thandle,              &
      &               key     = 'adapt_factor_pow2',  &
      &               val     = me%adapt_factor_pow2, &
      &               ErrCode = iError,               &
      &               default = .false.               )

    ! check for lobatto Points
    call aot_get_val( L       = conf,                          &
      &               thandle = thandle,                       &
      &               key     = 'lobattoPoints',               &
      &               val     = me%nodes_header%lobattoPoints, &
      &               ErrCode = iError,                        &
      &               default = .false.                        )

  end subroutine ply_fpt_header_load
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> Define settings for the Fast Polynomial Transformation.
  subroutine ply_fpt_header_define(                                           &
    &          me, blocksize, factor, approx_terms, implementation, striplen, &
    &          subBlockingWidth, adapt_factor_pow2, lobattoPoints             )
    ! -------------------------------------------------------------------- !
    !> FPT header to hold the defined settings.
    type(ply_fpt_header_type), intent(out) :: me

    !> Blocksize to use in approximation algorithm. Defaults to
    !! [[ply_fpt_header_module:ply_fpt_default_blocksize]].
    integer, optional, intent(in) :: blocksize

    !> Oversampling factor to use.
    !!
    !! This can be used to reduce aliasing when projecting functions that
    !! will be truncated in the polynomial series expansion.
    !! Default is a factor of 1, so no oversampling.
    real(kind=rk), optional, intent(in) :: factor

    !> Number of approximation terms to use for the representation of the
    !! blocks in the Legendre to Chebyshev transformation algorithm.
    !! Defaults to [[ply_fpt_header_module:ply_fpt_default_approx_terms]].
    integer, optional, intent(in) :: approx_terms

    !> Implementation to use in the computation.
    !!
    !! Select the implementation variant to use. Either scalar
    !! ([[ply_fpt_header_module:ply_fpt_scalar]]) or vectorized
    !! ([[ply_fpt_header_module:ply_fpt_vector]]).
    !! Default is [[ply_fpt_header_module:ply_fpt_scalar]].
    integer, optional, intent(in) :: implementation

    !> Length of strips to use in the transformation implementation.
    !! Defaults to [[tem_compileconf_module:vlen]].
    integer, optional, intent(in) :: striplen

    !> Width for subblocks in unrolling the approximate Legendre to
    !! Chebyshev transformation. Defaults to
    !! [[ply_fpt_header_module:ply_fpt_default_subblockingWidth]].
    integer, optional, intent(in) :: subBlockingWidth

    !> Adapt the oversampling factor such, that oversampled space has a
    !! number of degrees of freedoms in one direction that is a power of 2.
    !! Default is .false..
    logical, optional, intent(in) :: adapt_factor_pow2

    !> Wether to use Chebyshev-Lobatto points (include boundary points) or
    !! not. Defaults to .false..
    logical, optional, intent(in) :: lobattoPoints
    ! -------------------------------------------------------------------- !
    ! -------------------------------------------------------------------- !

    ! for fpt chebyshev nodes are used
    me%nodes_header%nodes_kind = 'chebyshev'

    ! Defaults
    me%blocksize         = ply_fpt_default_blocksize
    me%factor            = 1.0_rk
    me%approx_terms      = ply_fpt_default_approx_terms
    me%implementation    = ply_fpt_scalar
    me%striplen          = vlen
    me%subBlockingWidth  = ply_fpt_default_subblockingWidth
    me%adapt_factor_pow2 = .false.

    me%nodes_header%lobattoPoints = .false.

    ! Overwrite defaults if set by caller.
    if (present(blocksize)) me%blocksize = blocksize
    if (present(factor)) me%factor = factor
    if (present(approx_terms)) me%approx_terms = approx_terms
    if (present(implementation)) me%implementation = implementation
    if (present(striplen)) me%striplen = striplen
    if (present(subBlockingWidth)) me%subBlockingWidth = subBlockingWidth
    if (present(adapt_factor_pow2)) me%adapt_factor_pow2 = adapt_factor_pow2

    if (present(lobattoPoints)) me%nodes_header%lobattoPoints = lobattoPoints

    if (me%factor <= 0) then
      write(logUnit(1),*) 'ERROR in defining projection: factor for projection' &
        & // ' has to be larger than 0!'
      write(logUnit(1),*) 'But it is set to ', me%factor
      call tem_abort()
    end if

    if ( me%implementation /=  ply_fpt_scalar &
      &  .and. me%implementation /= ply_fpt_vector ) then
      write(logUnit(1),*) 'ERROR in defining projection: implementation' &
        & // ' has to be either "scalar" or "vector"!'
      write(logUnit(1),*) 'But it is set to unknown value ', me%implementation
      call tem_abort()
    end if

  end subroutine ply_fpt_header_define
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> Write FPT settings into a Lua table.
  subroutine ply_fpt_header_out(me, conf)
    ! -------------------------------------------------------------------- !
    type(ply_fpt_header_type), intent(in) :: me
    type(aot_out_type), intent(inout) :: conf
    ! -------------------------------------------------------------------- !
    ! -------------------------------------------------------------------- !

    ! fill up the fpt_header
    call aot_out_val( put_conf = conf,        &
       &              vname    = 'blocksize', &
       &              val      = me%blocksize )

    call aot_out_val( put_conf = conf,     &
       &              vname    = 'factor', &
       &              val      = me%factor )

    call aot_out_val( put_conf = conf,           &
       &              vname    = 'approx_terms', &
       &              val      = me%approx_terms )

    select case(me%implementation)
    case(ply_fpt_scalar)
      call aot_out_val( put_conf = conf,             &
         &              vname    = 'implementation', &
         &              val      = 'scalar'          )
    case(ply_fpt_vector)
      call aot_out_val( put_conf = conf,             &
         &              vname    = 'implementation', &
         &              val      = 'vector'          )
    end select

    call aot_out_val( put_conf = conf,       &
       &              vname    = 'striplen', &
       &              val      = me%striplen )

    call aot_out_val( put_conf = conf,               &
       &              vname    = 'subblockingWidth', &
       &              val      = me%subblockingWidth )

    call aot_out_val( put_conf = conf,                &
       &              vname    = 'adapt_factor_pow2', &
       &              val      = me%adapt_factor_pow2 )

    call aot_out_val( put_conf = conf,                         &
       &              vname    = 'lobattoPoints',              &
       &              val      = me%nodes_header%lobattoPoints )

  end subroutine ply_fpt_header_out
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> Print the FPT settings to the log output.
  subroutine ply_fpt_header_display (me)
    ! -------------------------------------------------------------------- !
    type(ply_fpt_header_type), intent(in) :: me
    ! -------------------------------------------------------------------- !
    ! -------------------------------------------------------------------- !

    write(logUnit(1),*) ' Using fast polynomial transforms for projection.'
    write(logUnit(1),*)
    write(logUnit(1),*) ' * Kind of projection method = fpt'
    write(logUnit(1),*) ' * Dealising factor to use in projection = ', &
      &                 me%factor
    write(logUnit(1),*) ' * Adapt factor to ensure power of 2 order = ', &
      &                 me%adapt_factor_pow2
    write(logUnit(3),*) '     This setting is only relevant for' &
      &                 //' polynomial degrees < 2*blocksize.'
    write(logUnit(1),*) ' * using LobattoPoints =', &
      &                 me%nodes_header%lobattoPoints
    if (me%implementation == ply_fpt_scalar) then
      write(logUnit(1),*) ' * Using scalar implementation'
    else
      write(logUnit(1),*) ' * Using VECTOR implementation'
    end if
    write(logUnit(1),*) ' * Block approximation:'
    write(logUnit(1),*) '   * Blocksize for FPT =', me%blocksize
    write(logUnit(1),*) '   * Number of approximation terms = ', me%approx_terms
    write(logUnit(1),*) '   * Strip length = ', me%striplen
    write(logUnit(1),*) '   * Subblocking width = ', me%subblockingWidth
    write(logUnit(1),*) ''
  end subroutine ply_fpt_header_display
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> This function provides the test for equality of two projections.
  !!
  !! Two fpt header are considered to be equal, if their  node_header,
  !! fpt_blocksize or the factor are equal.
  pure function isEqual(left, right) result(equality)
    ! -------------------------------------------------------------------- !
    !> projection to compare
    type(ply_fpt_header_type), intent(in) :: left
    !> projection to compare against
    type(ply_fpt_header_type), intent(in) :: right
    !> is equal??
    logical :: equality
    ! -------------------------------------------------------------------- !
    ! -------------------------------------------------------------------- !

    equality = ( left%nodes_header == right%nodes_header )           &
      & .and. ( left%factor .feq. right%factor )                     &
      & .and. ( left%blocksize == right%blocksize )                  &
      & .and. ( left%approx_terms == right%approx_terms )            &
      & .and. ( left%striplen == right%striplen )                    &
      & .and. ( left%subblockingWidth == right%subblockingWidth )    &
      & .and. ( left%adapt_factor_pow2 .eqv. right%adapt_factor_pow2 )

  end function isEqual
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> This function provides the test for unequality of two projections.
  !!
  !! Two fpt header are considered to be unequal, if their  node_header,
  !! fpt_blocksize or the factor are not equal.
  pure function isUnequal(left, right) result(unequality)
    ! -------------------------------------------------------------------- !
    !> projection to compare
    type(ply_fpt_header_type), intent(in) :: left
    !> projection to compare against
    type(ply_fpt_header_type), intent(in) :: right
    !> is unequal??
    logical :: unequality
    ! -------------------------------------------------------------------- !
    ! -------------------------------------------------------------------- !

    unequality = ( left%nodes_header /= right%nodes_header )         &
      & .or. ( left%factor .fne. right%factor )                      &
      & .or. ( left%blocksize /= right%blocksize )                   &
      & .or. ( left%approx_terms /= right%approx_terms )             &
      & .or. ( left%striplen /= right%striplen )                     &
      & .or. ( left%subblockingWidth /= right%subblockingWidth )     &
      & .or. ( left%adapt_factor_pow2 .neqv. right%adapt_factor_pow2 )

  end function isUnequal
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> This function provides a < comparison of two projections.
  !!
  !! Sorting of fpt header is given by node_header, fpt_blocksize and
  !! last by factor.
  pure function isSmaller(left, right) result(small)
    ! -------------------------------------------------------------------- !
    !> projection to compare
    type(ply_fpt_header_type), intent(in) :: left
    !> projection to compare against
    type(ply_fpt_header_type), intent(in) :: right
    !> is smaller??
    logical :: small
    ! -------------------------------------------------------------------- !
    !> help variables
    integer :: left_log, right_log
    ! -------------------------------------------------------------------- !

    small = .false.

    if (left%adapt_factor_pow2) then
      left_log = 1
    else
      left_log = 0
    end if
    if (right%adapt_factor_pow2) then
      right_log = 1
    else
      right_log = 0
    end if

    small = left%nodes_header < right%nodes_header
    if (left%nodes_header == right%nodes_header) then
      small = left%factor < right%factor
      if (left%factor .feq. right%factor) then
        small = left%blocksize < right%blocksize
        if (left%blocksize == right%blocksize) then
          small = left%approx_terms < right%approx_terms
          if ( left%approx_terms ==right%approx_terms) then
            small = left%striplen < right%striplen
            if (left%striplen == right%striplen) then
              small = left%subblockingWidth < right%subblockingWidth
              if (left%subblockingWidth == right%subblockingWidth) then
                small = (left_log < right_log)
              end if
            end if
          end if
        end if
      end if
    end if

  end function isSmaller
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> This function provides a <= comparison of two projections.
  !!
  !! Sorting of fpt header is given by node_header, fpt_blocksize and
  !! last by factor.
  pure function isSmallerOrEqual(left, right) result(small)
    ! -------------------------------------------------------------------- !
    !> projection to compare
    type(ply_fpt_header_type), intent(in) :: left
    !> projection to compare against
    type(ply_fpt_header_type), intent(in) :: right
    !> is smaller??
    logical :: small
    ! -------------------------------------------------------------------- !
    !> help variables
    integer :: left_log, right_log
    ! -------------------------------------------------------------------- !

    small = .false.

    if (left%adapt_factor_pow2) then
      left_log=1
    else
      left_log=0
    end if
    if (right%adapt_factor_pow2) then
      right_log=1
    else
      right_log=0
    end if

    small = left%nodes_header < right%nodes_header
    if (left%nodes_header == right%nodes_header) then
      small = left%factor < right%factor
      if (left%factor .feq. right%factor) then
        small = left%blocksize < right%blocksize
        if (left%blocksize == right%blocksize) then
          small = left%approx_terms < right%approx_terms
          if ( left%approx_terms ==right%approx_terms) then
            small = left%striplen < right%striplen
            if (left%striplen == right%striplen) then
              small = left%subblockingWidth < right%subblockingWidth
              if (left%subblockingWidth == right%subblockingWidth) then
                small = (left_log <= right_log)
              end if
            end if
          end if
        end if
      end if
    end if

  end function isSmallerOrEqual
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> This function provides a > comparison of two projections.
  !!
  !! Sorting of fpt header is given by node_header, fpt_blocksize and
  !! last by factor.
  pure function isGreater(left, right) result(great)
    ! -------------------------------------------------------------------- !
    !> projection to compare
    type(ply_fpt_header_type), intent(in) :: left
    !> projection to compare against
    type(ply_fpt_header_type), intent(in) :: right
    !> is greater??
    logical :: great
    ! -------------------------------------------------------------------- !
    !> help variables
    integer :: left_log, right_log
    ! -------------------------------------------------------------------- !

    great = .false.

    if (left%adapt_factor_pow2) then
      left_log=1
    else
      left_log=0
    end if
    if (right%adapt_factor_pow2) then
      right_log=1
    else
      right_log=0
    end if

    great = left%nodes_header > right%nodes_header
    if (left%nodes_header == right%nodes_header) then
      great = left%factor > right%factor
      if (left%factor .feq. right%factor) then
        great = left%blocksize > right%blocksize
        if (left%blocksize == right%blocksize) then
          great = left%approx_terms > right%approx_terms
          if ( left%approx_terms ==right%approx_terms) then
            great = left%striplen > right%striplen
            if (left%striplen == right%striplen) then
              great = left%subblockingWidth > right%subblockingWidth
              if (left%subblockingWidth == right%subblockingWidth) then
                great = (left_log > right_log)
              end if
            end if
          end if
        end if
      end if
    end if

  end function isGreater
  ! ------------------------------------------------------------------------ !


  ! ------------------------------------------------------------------------ !
  !> This function provides a >= comparison of two projections.
  !!
  !! Sorting of fpt header is given by node_header, fpt_blocksize and
  !! last by factor.
  pure function isGreaterOrEqual(left, right) result(great)
    ! -------------------------------------------------------------------- !
    !> projection to compare
    type(ply_fpt_header_type), intent(in) :: left
    !> projection to compare against
    type(ply_fpt_header_type), intent(in) :: right
    !> is greater??
    logical :: great
    ! -------------------------------------------------------------------- !
    !> help variables
    integer :: left_log, right_log
    ! -------------------------------------------------------------------- !

    great = .false.

    if (left%adapt_factor_pow2) then
      left_log=1
    else
      left_log=0
    end if
    if (right%adapt_factor_pow2) then
      right_log=1
    else
      right_log=0
    end if

    great = left%nodes_header > right%nodes_header
    if (left%nodes_header == right%nodes_header) then
      great = left%factor > right%factor
      if (left%factor .feq. right%factor) then
        great = left%blocksize > right%blocksize
        if (left%blocksize == right%blocksize) then
          great = left%approx_terms > right%approx_terms
          if ( left%approx_terms ==right%approx_terms) then
            great = left%striplen > right%striplen
            if (left%striplen == right%striplen) then
              great = left%subblockingWidth > right%subblockingWidth
              if (left%subblockingWidth == right%subblockingWidth) then
                great = (left_log >= right_log)
              end if
            end if
          end if
        end if
      end if
    end if
  end function isGreaterOrEqual
  ! ------------------------------------------------------------------------ !

end module ply_fpt_header_module