This routine single sphere from object table
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(tem_sphere_type), | intent(out) | :: | me |
single sphere |
||
type(tem_transformation_type), | intent(in) | :: | transform |
transformation for spatial object |
||
type(flu_State) | :: | conf |
lua state |
|||
integer, | intent(in) | :: | thandle |
subroutine tem_load_sphere_single(me, transform, conf, thandle )
! -------------------------------------------------------------------------!
!inferface variables
!> single sphere
type(tem_sphere_type), intent(out) :: me
!> transformation for spatial object
type(tem_transformation_type), intent(in) :: transform
!> lua state
type(flu_state) :: conf
integer, intent(in) :: thandle !< handle for canonical objects
! -------------------------------------------------------------------------!
integer :: iError, vError(3), errFatal(3)
! -------------------------------------------------------------------------!
errFatal = aoterr_fatal
! read origin of sphere
call aot_get_val(L=conf, thandle=thandle, val=me%origin, &
& ErrCode=vError, key='origin', pos = 1)
if (any(btest(vError, errFatal))) then
write(logunit(0),*) &
& ' Error in configuration: origin is not given to define a sphere'
call tem_abort()
end if
!read radius of sphere
call aot_get_val(L=conf, thandle=thandle, val=me%radius, &
& ErrCode=iError, key='radius', pos=2 )
if (btest(iError, aoterr_Fatal)) then
write(logunit(0),*) 'FATAL Error occured, while retrieving radius'
if (btest(iError, aoterr_NonExistent)) &
& write(logunit(0),*) 'Variable not existent!'
if (btest(iError, aoterr_WrongType)) &
& write(logunit(0),*) 'Variable has wrong type!'
call tem_abort()
end if
call aot_get_val(L=conf, thandle=thandle, val=me%only_surface, &
& ErrCode=iError, key='only_surface', &
& pos=3, default=.false.)
if (btest(iError, aoterr_WrongType)) then
write(logunit(0),*) 'Error occured, while retrieving sphere only_surface'
write(logunit(0),*) 'Variable has wrong type!'
write(logunit(0),*) 'Should be a LOGICAL!'
call tem_abort()
endif
write(logunit(1),"(A,3E12.5)") ' origin: ', me%origin
write(logunit(1),"(A,3E12.5)") ' radius: ', me%radius
write(logunit(1),"(A,L5 )") ' only_surface: ', me%only_surface
!apply transformation to sphere
if(transform%active) then
if(transform%deform%active) then
write(logunit(1),*) 'WARNING: Sphere deformation is only applied to'
write(logunit(1),*) ' its radius as a scaling factor of '
write(logunit(1),*) ' first entry in the deformation table.'
me%radius = me%radius * transform%deform%matrix(1,1)
me%origin = matmul(transform%deform%matrix, me%origin)
endif
if(transform%translate%active) then
me%origin = me%origin + transform%translate%vec
endif
endif
end subroutine tem_load_sphere_single