evaluate sbase at position x [0,1], NOT EFFICIENT!!
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(t_sBase), | intent(in) | :: | sf |
self |
||
| real(kind=wp), | intent(in) | :: | x |
position [0,1] where to evaluate |
||
| integer, | intent(in) | :: | deriv | |||
| integer, | intent(out) | :: | iElem | |||
| real(kind=wp), | intent(out) | :: | base_x(:) |
all basis functions (0:deg) evaluated |
SUBROUTINE sBase_eval( sf , x,deriv,iElem,base_x) ! MODULES USE MODgvec_Basis1D, ONLY:LagrangeInterpolationPolys IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES CLASS(t_sbase), INTENT(IN ) :: sf !! self REAL(wp) , INTENT(IN ) :: x !! position [0,1] where to evaluate INTEGER , INTENT(IN ) :: deriv !! 0: evaluation,1: 1st derivative !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES INTEGER , INTENT( OUT) :: iElem REAL(wp) , INTENT( OUT) :: base_x(:) !! all basis functions (0:deg) evaluated !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: ideriv REAL(wp):: xiloc,baseloc(0:sf%deg,0:sf%deg) !=================================================================================================================================== SELECT TYPE(sf) TYPE IS(t_sbase_disc) iElem=sf%grid%find_elem(x) xiloc =(x-sf%grid%sp(iElem-1))*2.0_wp/sf%grid%ds(iElem)-1.0_wp !in [-1,1] IF(deriv.EQ.0)THEN CALL LagrangeInterpolationPolys(xiloc,sf%deg,sf%xiIP,sf%wBaryIP,base_x(:)) ELSEIF(deriv.GT.sf%deg) THEN base_x=0.0_wp ELSE CALL LagrangeInterpolationPolys(xiloc,sf%deg,sf%xiIP,sf%wBaryIP,baseloc(:,0)) DO ideriv=1,deriv baseloc(:,ideriv)=MATMUL(TRANSPOSE(sf%DmatIP),baseloc(:,ideriv-1))*(2.0_wp/sf%grid%ds(iElem)) END DO base_x=baseloc(:,deriv) END IF!deriv TYPE IS(t_sbase_spl) IF(deriv.EQ.0)THEN CALL sf%bspl%eval_basis(x,base_x(:),iElem) ELSEIF(deriv.GT.sf%deg) THEN iElem=sf%grid%find_elem(x) base_x=0.0_wp ELSE CALL sf%bspl%eval_basis_and_n_derivs(x,deriv,baseloc(0:deriv,:),iElem) base_x=baseloc(deriv,:) END IF IF(iElem.EQ.-1)CALL abort(__STAMP__,& 'PROBLEM, iElem not found in spline eval (sbase_eval)...') CLASS DEFAULT CALL abort(__STAMP__, & "this type of continuity not implemented!") END SELECT !TYPE END SUBROUTINE sbase_eval