lagrange Function

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

Create colormap from Lagrange interpolation of control colors

Arguments

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

Return Value integer, 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 proc~test_022 test_022 proc~test_022->proc~lagrange proc~test_023 test_023 proc~test_023->proc~lagrange proc~test_024 test_024 proc~test_024->proc~lagrange proc~test_025 test_025 proc~test_025->proc~lagrange proc~test_026 test_026 proc~test_026->proc~lagrange proc~test_032 test_032 proc~test_032->proc~lagrange proc~test_033 test_033 proc~test_033->proc~lagrange proc~test_046 test_046 proc~test_046->proc~create_lagrange proc~test_071 test_071 proc~test_071->proc~create_lagrange proc~test_081 test_081 proc~test_081->proc~create_lagrange proc~test_084 test_084 proc~test_084->proc~create_lagrange program~check check program~check->proc~test_022 program~check->proc~test_023 program~check->proc~test_024 program~check->proc~test_025 program~check->proc~test_026 program~check->proc~test_032 program~check->proc~test_033 program~check->proc~test_046 program~check->proc~test_071 program~check->proc~test_081 program~check->proc~test_084 program~create create program~create->proc~create_lagrange

Source Code

    pure function lagrange(colors, levels) result(map)
        integer, intent(in) :: colors(:,:)
        integer, intent(in), optional :: levels
        integer, allocatable :: map(:,:)
        integer :: order, i, j, n, levels_
        real(wp) :: t, r, g, b
        real(wp), allocatable :: L(:)

        ! 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(levels_, 3))
        n = order + 1
        do i = 1, levels_
            t = real(i-1, wp) / real(levels_-1, wp)
            L = lagrange_poly(t, n)
            r = 0.0_wp
            g = 0.0_wp
            b = 0.0_wp
            do j = 1, n
                r = r + L(j) * real(colors(j,1), wp)
                g = g + L(j) * real(colors(j,2), wp)
                b = b + L(j) * real(colors(j,3), wp)
            end do
            map(i,1) = min(255, max(0, nint(r)))
            map(i,2) = min(255, max(0, nint(g)))
            map(i,3) = min(255, max(0, nint(b)))
        end do
    end function lagrange