inverse_1d Subroutine

private pure subroutine inverse_1d(me, y, x, iflag)

The unique with for a bspline_1d (for example, a monotonic spline). This is a wrapper for db1root.

Returns iflag=4005 if there is no solution, and iflag=4006 if there is more than one (in which case x is the smallest).

Type Bound

bspline_1d

Arguments

Type IntentOptional Attributes Name
class(bspline_1d), intent(inout) :: me

the spline
real(kind=wp), intent(in) :: y

the spline value
real(kind=wp), intent(out) :: x

the solution of

integer(kind=ip), intent(out) :: iflag

status flag (see db1root)

Calls

proc~~inverse_1d~~CallsGraph proc~inverse_1d bspline_1d%inverse_1d proc~roots_1d bspline_1d%roots_1d proc~inverse_1d->proc~roots_1d proc~db1root db1root proc~roots_1d->proc~db1root proc~check_root_inputs check_root_inputs proc~db1root->proc~check_root_inputs proc~dbvalu dbvalu proc~db1root->proc~dbvalu proc~in_flat_region in_flat_region proc~db1root->proc~in_flat_region proc~root_dup_tol root_dup_tol proc~db1root->proc~root_dup_tol proc~sort_unique sort_unique proc~db1root->proc~sort_unique proc~spline_derivative spline_derivative proc~db1root->proc~spline_derivative proc~spline_roots spline_roots proc~db1root->proc~spline_roots proc~dintrv dintrv proc~dbvalu->proc~dintrv proc~in_flat_region->proc~dintrv proc~spline_roots->proc~dbvalu proc~spline_roots->proc~in_flat_region proc~spline_roots->proc~root_dup_tol proc~spline_roots->proc~sort_unique proc~get_temp_x_for_extrap get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap

Source Code

    pure subroutine inverse_1d(me,y,x,iflag)

    implicit none

    class(bspline_1d),intent(inout) :: me  !! the spline
    real(wp),intent(in)             :: y      !! the spline value
    real(wp),intent(out)            :: x      !! the solution of \( s(x) = y \)
    integer(ip),intent(out)         :: iflag  !! status flag (see [[db1root]])

    real(wp),dimension(:),allocatable :: roots  !! all the roots of \( s(x) = y \)

    x = 0.0_wp
    call me%roots(y,roots,iflag)
    if (iflag==0_ip .or. iflag==4004_ip) then
        if (size(roots)>0) x = roots(1)
        if (iflag==4004_ip .or. size(roots)>1) then
            iflag = 4006_ip  ! s(x) = y on a whole interval, or more than one root
        else if (size(roots)==0) then
            iflag = 4005_ip
        end if
    end if
    me%iflag = iflag

    end subroutine inverse_1d