tem_spacetime_fun_test.f90 Source File


This file depends on

sourcefile~~tem_spacetime_fun_test.f90~~EfferentGraph sourcefile~tem_spacetime_fun_test.f90 tem_spacetime_fun_test.f90 sourcefile~tem_bc_prop_module.f90 tem_bc_prop_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~tem_bc_prop_module.f90 sourcefile~treelmesh_module.f90 treelmesh_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~treelmesh_module.f90 sourcefile~tem_spacetime_fun_module.f90 tem_spacetime_fun_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~tem_spacetime_fun_module.f90 sourcefile~tem_logging_module.f90 tem_logging_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~tem_logging_module.f90 sourcefile~tem_tools_module.f90 tem_tools_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~tem_tools_module.f90 sourcefile~tem_general_module.f90 tem_general_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~tem_general_module.f90 sourcefile~tem_utestenv_module.f90 tem_utestEnv_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~tem_utestenv_module.f90 sourcefile~env_module.f90 env_module.f90 sourcefile~tem_spacetime_fun_test.f90->sourcefile~env_module.f90

Contents


Source Code

! Copyright (c) 2014, 2016 Kannan Masilamani <kannan.masilamani@uni-siegen.de>
! Copyright (c) 2016 Tobias Schneider <tobias1.schneider@student.uni-siegen.de>
! Copyright (c) 2016, 2019 Harald Klimach <harald.klimach@uni-siegen.de>
! Copyright (c) 2016-2018 Peter Vitt <peter.vitt2@uni-siegen.de>
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice, this
! list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!> This UTEST is to test variable system.
!! load variables and access state and derive quantities from
!! c pointer methoddata
program tem_spacetime_fun_test
  use, intrinsic :: iso_c_binding, only: C_NEW_LINE, c_ptr, c_loc, c_f_pointer

  use env_module,               only: rk, solSpecLen, fin_env
  use tem_bc_prop_module,       only: tem_bc_prop_type
  use tem_general_module,       only: tem_general_type
  use treelmesh_module,         only: treelmesh_type
  use tem_utestEnv_module,      only: load_env
  use tem_tools_module,         only: upper_to_lower
  use tem_spacetime_fun_module, only: tem_spacetime_fun_type,             &
    &                                 tem_load_spacetime,                 &
    &                                 tem_spacetime_for
  use tem_logging_module,       only: tem_logging_init, logUnit

  use aotus_module,             only: open_config_chunk, close_config, &
    &                                 flu_state
  use aot_table_module,         only: aot_table_open, aot_table_close, &
    &                                 aot_table_length, aot_get_val

  !mpi!nprocs = 1

  implicit none

  character, parameter :: nl = C_NEW_LINE

  character(len=solSpecLen), parameter :: stfun_Conf =               &
    &    'function luafun_vector(x,y,z,t)' // nl                     &
    & // '  return {x,y,z}' // nl                                    &
    & // 'end' // nl                                                 &
    & // 'function luafun_scalar(x,y,z,t)' // nl                     &
    & // '  return x' // nl                                          &
    & // 'end' // nl                                                 &
    & // 'shape = {' // nl                                           &
    & // '  kind = "canoND",' // nl                                  &
    & // '  object = {' // nl                                        &
    & // '    origin = { 0.0, 0.5, 0.5 },' //nl                      &
    & // '    vec = { 1.0, 0.0, 0.0 }' // nl                         &
    & // '  }' // nl                                                 &
    & // '}' // nl                                                   &
    & // 'e1 = {' // nl                                              &
    & // '  kind = "canoND",' // nl                                  &
    & // '  object = { origin = { 0.25, 0.25, 0.25 } }' // nl        &
    & // '}' // nl                                                   &
    & // 'e2 = {' // nl                                              &
    & // '  kind = "canoND",' // nl                                  &
    & // '  object = { origin = { 0.75, 0.25, 0.25 } }' // nl        &
    & // '}' // nl                                                   &
    & // 'scalar_fun = luafun_scalar' // nl                          &
    & // 'scalar_const = 1.0' // nl                                  &
    & // 'vector_fun = luafun_vector' // nl                          &
    & // 'vector_const = { 1.0, 2.0, 3.0 }' // nl                    &
    & // 'vector_const_multitab = {' // nl                           &
    & // '  { 1.0, 2.0, 3.0},' // nl                                 &
    & // '  { 4.0, 5.0, 6.0}' // nl                                  &
    & // '}' // nl                                                   &
    & // 'scalar_fun_shapeall = { fun = luafun_scalar }' // nl       &
    & // 'scalar_const_shapeall = { const = scalar_const }' // nl    &
    & // 'predefined_shapeall = {' // nl                             &
    & // '  predefined = "combined",' // nl                          &
    & // '  temporal = 1.0,' // nl                                   &
    & // '  spatial = 1.0' // nl                                     &
    & // '}' // nl                                                   &
    & // 'scalar_fun_shape = {' // nl                                &
    & // '  fun = luafun_scalar,' // nl                              &
    & // '  shape = shape' // nl                                     &
    & // '}' // nl                                                   &
    & // 'scalar_const_shape = { const = 1.0, shape = shape }' // nl &
    & // 'vector_fun_shape = {' // nl                                &
    & // '  fun = luafun_vector,' // nl                              &
    & // '  shape = shape' // nl                                     &
    & // '}' // nl                                                   &
    & // 'vector_const_shape = {' // nl                              &
    & // '  const = { 1.0, 2.0, 3.0 },' // nl                        &
    & // '  shape = shape' // nl                                     &
    & // '}' // nl                                                   &
    & // 'predefined_shape = {' // nl                                &
    & // '  predefined = "combined",' // nl                          &
    & // '  temporal = 1.0,' // nl                                   &
    & // '  spatial = scalar_fun,' // nl                             &
    & // '  shape = shape' // nl                                     &
    & // '}' // nl                                                   &
    & // 'predefined_vec_shape = {' // nl                            &
    & // '  predefined = "combined",' // nl                          &
    & // '  temporal = 1.0,' // nl                                   &
    & // '  spatial = {1.0,2.0,3.0},' // nl                          &
    & // '  shape = shape' // nl                                     &
    & // '}' // nl                                                   &
    & // 'predefined_subtable_vec_shape = {' // nl                   &
    & // '  predefined = {' // nl                                    &
    & // '    "combined",' // nl                                     &
    & // '    temporal = 1.0,' // nl                                 &
    & // '    spatial = {1.0,2.0,3.0},' // nl                        &
    & // '    shape = shape' // nl                                   &
    & // '  }' // nl                                                 &
    & // '}' // nl                                                   &
    & // 'st_fun_singleTab = { scalar_fun }' // nl                   &
    & // 'st_fun_singleTab_shape = {' // nl                          &
    & // '  fun=scalar_fun,' // nl                                   &
    & // '  shape=shape' // nl                                       &
    & // '}' // nl                                                   &
    & // 'st_fun_multiTab = { { fun=scalar_fun } }' // nl            &
    & // 'st_fun_const = {' // nl                                    &
    & // '  scalar_const,' // nl                                     &
    & // '  scalar_const*2,' // nl                                   &
    & // '  scalar_const*3' // nl                                    &
    & // '}' // nl                                                   &
    & // 'st_fun_vec_const = {' // nl                                &
    & // '  vector_const,' // nl                                     &
    & // '  vector_const,' // nl                                     &
    & // '  vector_const' // nl                                      &
    & // '}' // nl                                                   &
    & // 'st_fun_2_s = {' // nl                                      &
    & // '  scalar_fun,' // nl                                       &
    & // '  scalar_fun,' // nl                                       &
    & // '  predefined_shape' // nl                                  &
    & // '}'

  type solver_type
    integer :: nComps
    integer :: nDofs
    real(kind=rk), allocatable :: state(:)
    type(treelmesh_type) :: tree
    type(tem_bc_prop_type) :: boundary
    type(tem_general_type) :: general
  end type solver_type

  type(flu_state) :: conf
  type(solver_type), target :: solver
  integer :: errorCode, iTest, i
  logical :: res(23)
  type(tem_spacetime_fun_type) :: density
  type(tem_spacetime_fun_type) :: velocity
  character(len=8) :: fi, fl

  write(*,*) 'Hello from tem_varSys_test'
  ! load utest mesh
  call load_env( tree     = solver%tree,     &
    &            boundary = solver%boundary, &
    &            general  = solver%general   )

  call tem_logging_init( level = 10, rank = 0 )

  write(*,*) 'nElems ', solver%tree%nElems
  errorCode = 0

  call open_config_chunk(L=conf, chunk=trim(stfun_conf))
  iTest = 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,     &
    &                      conf    = conf,        &
    &                      errCode = errorCode,   &
    &                      key     = 'scalar_fun' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,       &
    &                      conf    = conf,          &
    &                      errCode = errorCode,     &
    &                      key     = 'scalar_const' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,    &
    &                      conf    = conf,        &
    &                      nComp   = 3,           &
    &                      errCode = errorCode,   &
    &                      key     = 'vector_fun' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,      &
    &                      conf    = conf,          &
    &                      nComp   = 3,             &
    &                      errCode = errorCode,     &
    &                      key     = 'vector_const' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,               &
    &                      conf    = conf,                   &
    &                      nComp   = 3,                      &
    &                      errCode = errorCode,              &
    &                      key     = 'vector_const_multitab' )
  res(iTest) = errorCode == -1

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,              &
    &                      conf    = conf,                 &
    &                      errCode = errorCode,            &
    &                      key     = 'scalar_fun_shapeall' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,                &
    &                      conf    = conf,                   &
    &                      errCode = errorCode,              &
    &                      key     = 'scalar_const_shapeall' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,              &
    &                      conf    = conf,                 &
    &                      errCode = errorCode,            &
    &                      key     = 'predefined_shapeall' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,           &
    &                      conf    = conf,              &
    &                      errCode = errorCode,         &
    &                      key     = 'scalar_fun_shape' )
  res(iTest) = errorCode == 0
  write(*,*) 'shapekind ', density%geom(:)%kind

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,             &
    &                      conf    = conf,                &
    &                      errCode = errorCode,           &
    &                      key     = 'scalar_const_shape' )
  res(iTest) = errorCode == 0
  write(*,*) 'shapekind ', density%geom(:)%kind

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,          &
    &                      conf    = conf,              &
    &                      nComp   = 3,                 &
    &                      errCode = errorCode,         &
    &                      key     = 'vector_fun_shape' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,            &
    &                      conf    = conf,                &
    &                      errCode = errorCode,           &
    &                      nComp   = 3,                   &
    &                      key     = 'vector_const_shape' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = density,           &
    &                      conf    = conf,              &
    &                      errCode = errorCode,         &
    &                      key     = 'predefined_shape' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,              &
    &                      conf    = conf,                  &
    &                      ncomp   = 3,                     &
    &                      errCode = errorCode,             &
    &                      key     = 'predefined_vec_shape' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,                       &
    &                      conf    = conf,                           &
    &                      ncomp   = 3,                              &
    &                      errCode = errorCode,                      &
    &                      key     = 'predefined_subtable_vec_shape' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,    &
    &                      conf    = conf,        &
    &                      errCode = errorCode,   &
    &                      key     = 'scalar_fun' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,      &
    &                      conf    = conf,          &
    &                      nComp   = 3,             &
    &                      errCode = errorCode,     &
    &                      key     = 'vector_const' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,          &
    &                      conf    = conf,              &
    &                      errCode = errorCode,         &
    &                      key     = 'st_fun_singleTab' )
  ! This test should fail as the scalar value in a table is neither a vector
  ! nor is there one of the keywords, in this case 'const'.
  ! See scalar_const_shapeall
  res(iTest) = errorCode == -1

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,                &
    &                      conf    = conf,                    &
    &                      errCode = errorCode,               &
    &                      key     = 'st_fun_singleTab_shape' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,         &
    &                      conf    = conf,             &
    &                      errCode = errorCode,        &
    &                      key     = 'st_fun_multiTab' )
  ! A table within a table is not allowed. Therefore this one should fail
  res(iTest) = errorCode == -1

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,      &
    &                      conf    = conf,          &
    &                      errCode = errorCode,     &
    &                      key     = 'st_fun_const' )
  res(iTest) = errorCode == 0

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,          &
    &                      conf    = conf,              &
    &                      nComp   = 3,                 &
    &                      errCode = errorCode,         &
    &                      key     = 'st_fun_vec_const' )
  ! Again, tables within tables are not allowed. This time the tables are
  ! vectors, however, they need to be nested within a multiples-stfun
  res(iTest) = errorCode == -1

  iTest = iTest + 1
  write(*,"(A)") "---------------"
  write(*,"(A,I2)") "Running test ", iTest
  call tem_load_spacetime( me      = velocity,    &
    &                      conf    = conf,        &
    &                      errCode = errorCode,   &
    &                      key     = 'st_fun_2_s' )
  ! Two scalars within a table is not allowed. It is either a vector, then
  ! the notation is not corrent, or they qre two stfuns, then they need to be
  ! encapsulated by a multiples-stfun
  write(*,*) errorCode
  res(iTest) = errorCode == -1

  if ( .not. all(res) ) then
    write(logUnit(1),*) 'Error: Failed loading spacetime function calls.'
    write(fi,'(A,I2,A)') "(A,",iTest,"I3)"
    write(fl,'(A,I2,A)') "(A,",iTest,"L3)"
    write(logUnit(1),fi) 'Test no.', (i,i=1,iTest)
    write(logUnit(1),fl) 'Result  ', res
  else
    write(*,*) 'PASSED'
  end if
  call close_config(L=conf)
  call fin_env()

end program tem_spacetime_fun_test