program tem_variable_extract_test
use, intrinsic :: iso_c_binding, only: C_NEW_LINE, c_ptr, c_loc, c_f_pointer
use env_module, only: eps, rk, solSpecLen, fin_env
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
use tem_logging_module, only: tem_logging_init
use treelmesh_module, only: treelmesh_type
use tem_bc_prop_module, only: tem_bc_prop_type
use tem_general_module, only: tem_general_type
use tem_variable_module, only: tem_variable_type, &
& tem_variable_load
use tem_spacetime_fun_module, only: tem_st_fun_linkedList_type
use tem_derived_module, only: tem_varSys_append_luaVar
use tem_spacetime_fun_module, only: tem_create_subTree_of_st_funList
use tem_varSys_module, only: tem_varSys_init, &
& tem_varSys_type, &
& tem_varSys_op_type, &
& tem_varSys_append_stateVar, &
& tem_varSys_append_derVar, &
& tem_varSys_proc_point, &
& tem_varSys_proc_element
use tem_dyn_array_module, only: PositionOfVal
use tem_utestEnv_module, only: load_env
!mpi!nprocs = 1
implicit none
character, parameter :: nl = C_NEW_LINE
character(len=solSpecLen), parameter :: sysConf = &
& 'variable = {' // nl &
& // ' {' // nl &
& // ' name = "velocity",' // nl &
& // ' ncomponents = 3,' // nl &
& // ' vartype = "st_fun",' // nl &
& // ' st_fun = {' // nl &
& // ' const = {1,2,3}' // nl &
& // ' }' // nl &
& // ' },' // nl &
& // ' {' // nl &
& // ' name = "vel_y",' // nl &
& // ' ncomponents = 1,' // nl &
& // ' vartype = "operation",' // nl &
& // ' operation = {' // nl &
& // ' kind = "extract",' // nl &
& // ' input_varname = "velocity",' // nl &
& // ' input_varindex = {2}' // nl &
& // ' }' // nl &
& // ' },' // nl &
& // '}' // nl
type solver_type
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
integer :: nComponents, nDofs, nElemsToTrack, pos
type(solver_type), target :: solver
type(tem_varSys_type) :: varSys
type(tem_st_fun_linkedList_type) :: st_funList
type(tem_variable_type), allocatable :: newVar(:)
real(kind=rk), allocatable :: res(:)
integer, allocatable :: vError(:)
write(*,*) 'Hello from tem_variable_extract_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
allocate(solver%general%solver%conf(1))
call open_config_chunk(L=solver%general%solver%conf(1), chunk=trim(sysConf))
call tem_variable_load( me = newVar, &
& conf = solver%general%solver%conf(1), &
& key = 'variable', &
& vError = vError )
call close_config(L=solver%general%solver%conf(1))
nElemsToTrack = 1
nDofs = 1
! initialize variable system
write(*,*) 'calling varsys init'
call tem_varSys_init(me = varSys, systemName = 'utest')
call tem_varSys_append_luaVar( luaVar = newVar, &
& varSys = varSys, &
& st_funList = st_funList )
call tem_create_subTree_of_st_funList( &
& me = st_funList, &
& tree = solver%tree, &
& bc_prop = solver%boundary )
pos = positionOfVal( varSys%varname, 'vel_y' )
if (pos==0) then
write(*,*) 'FAILED: vel_y not found'
stop
end if
nComponents = varSys%method%val(pos)%nComponents
allocate(res(nElemsToTrack*nComponents*nDofs))
call varSys%method%val(pos)%get_element( &
& varSys = varSys, &
& elemPos = (/ 1 /), &
& time = solver%general%simControl%now, &
& tree = solver%tree, &
& nElems = nElemsToTrack, &
& nDofs = nDofs, &
& res = res )
write(*,*) res
if( abs(res(1) - 2) > eps ) then
write(*,*) 'FAILED: Variable vel_y returned wrong value.'
stop
endif
write(*,*) 'PASSED'
call fin_env()
end program tem_variable_extract_test