This routine single ellipsoid from object table
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(tem_ellipsoid_type), | intent(out) | :: | me |
single ellipsoid |
||
type(tem_transformation_type), | intent(in) | :: | transform |
transformation for spatial object |
||
type(flu_State) | :: | conf |
lua state |
|||
integer, | intent(in) | :: | thandle |
subroutine tem_load_ellipsoid_single(me, transform, conf, thandle ) ! --------------------------------------------------------------------------! !inferface variables !> single ellipsoid type(tem_ellipsoid_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 :: ii, iError, vError(3), errFatal(3) ! --------------------------------------------------------------------------! errFatal = aoterr_fatal ! read origin of ellipsoid 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 ellipsoid' call tem_abort() end if !read radius of ellipsoid call aot_get_val(L=conf, thandle=thandle, val=me%radius, & & ErrCode=vError, key='radius', pos=2 ) if (any(btest(vError, errFatal))) then write(logunit(0),*) & & ' Error in configuration: radius is not given to define a ellipsoid' 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 ellipsoid 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 ellipsoid if(transform%active) then if(transform%deform%active) then write(logunit(5),"(A)") ' apply deformation ...' do ii = 1, 3 me%radius(ii) = me%radius(ii) & & * transform%deform%matrix(ii,ii) end do me%origin = matmul(transform%deform%matrix, me%origin) endif if(transform%translate%active) then write(logunit(5),"(A)") ' apply translation ...' me%origin = me%origin + transform%translate%vec endif endif end subroutine tem_load_ellipsoid_single