lagrange Function

private pure function lagrange(colors, levels) result(map)

Create colormap from Lagrange interpolation of control colors

Arguments

Type IntentOptional Attributes Name
integer, intent(in), dimension(:,:) :: colors
integer, intent(in), optional :: levels

Return Value integer, dimension(:,:), allocatable


Calls

proc~~lagrange~~CallsGraph proc~lagrange lagrange proc~lagrange_poly lagrange_poly proc~lagrange->proc~lagrange_poly

Called by

proc~~lagrange~~CalledByGraph proc~lagrange lagrange proc~create_lagrange Colormap%create_lagrange proc~create_lagrange->proc~lagrange program~create create program~create->proc~create_lagrange

Source Code

    pure function lagrange(colors, levels) result(map)
        integer, dimension(:,:), intent(in) :: colors
        integer, intent(in), optional :: levels
        integer, dimension(:,:), allocatable :: map
        real(wp), dimension(:,:), allocatable :: map_r
        integer :: order, i, j, levels_
        real(wp) :: t

        ! Set default value for levels
        if (present(levels)) then
            levels_ = levels
        else
            levels_ = 256
        end if

        ! Order of the Lagrange interpolation.
        order = size(colors, 1) - 1
        if (order < 1) error stop "Error: At least two control colors are required for Lagrange interpolation."

        allocate(map_r(levels_,3), map(levels_,3)) ! 3 for RGB
        do i = 1, levels_
            t = real(i-1, wp) / real(levels_-1, wp)
            map_r(i,:) = 0.0_wp
            do j = 0, order
                map_r(i,1) = dot_product(lagrange_poly(t,order+1), real(colors(:,1), wp))
                map_r(i,2) = dot_product(lagrange_poly(t,order+1), real(colors(:,2), wp))
                map_r(i,3) = dot_product(lagrange_poly(t,order+1), real(colors(:,3), wp))
            end do
            map(i,1) = min(255, max(0, nint(map_r(i,1))))
            map(i,2) = min(255, max(0, nint(map_r(i,2))))
            map(i,3) = min(255, max(0, nint(map_r(i,3))))
        end do
    end function lagrange