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