cubehelix_colormap Subroutine

public pure subroutine cubehelix_colormap(map, nlev, varargs)

This subroutine is based on the public domain FORTRAN 77 subroutine published by D.A. Green: Green, D. A., 2011, Bulletin of the Astronomical Society of India, Vol.39, p.289 For more information on the parameters of cubehelix, see his page: https://www.mrao.cam.ac.uk/~dag/CUBEHELIX/

Arguments

Type IntentOptional Attributes Name
integer, intent(out), dimension(:,:), allocatable :: map
integer, intent(in) :: nlev
real(kind=wp), intent(in), optional, dimension(:) :: varargs

Called by

proc~~cubehelix_colormap~~CalledByGraph proc~cubehelix_colormap cubehelix_colormap proc~set Colormap%set proc~set->proc~cubehelix_colormap program~demo demo program~demo->proc~set program~demo_reverse demo_reverse program~demo_reverse->proc~set program~extract extract program~extract->proc~set program~modify modify program~modify->proc~set

Source Code

    pure subroutine cubehelix_colormap(map, nlev, varargs)
        integer, dimension(:,:), allocatable, intent(out) :: map
        integer, intent(in) :: nlev
        real(wp), dimension(:), intent(in), optional :: varargs
        integer  :: i
        real(wp) :: start, rots, hue, gamma
        real(wp) :: fract, angle, amp

        if (present(varargs)) then
            if (size(varargs) /= 4) error stop "ERROR: cubehelix varargs(:) must have 4 values"
            start = varargs(1)
            rots  = varargs(2)
            hue   = varargs(3)
            gamma = varargs(4)
        else
            ! Default values:
            start = 0.5_wp
            rots  = -1.5_wp
            hue   = 1.0_wp
            gamma = 1.0_wp
        end if

        allocate(map(0:nlev-1, 1:3))

        do concurrent (i = 0:nlev-1)
            fract = real(i, kind=wp) / (nlev-1)
            angle = 2*pi * (start/3 + 1 + rots*fract)
            fract = fract ** gamma
            amp   = hue * fract * (1-fract)/2

            map(i, 1) = nint(255*(fract + amp*(-0.14861_wp*cos(angle) + 1.78277_wp*sin(angle))))
            map(i, 2) = nint(255*(fract + amp*(-0.29227_wp*cos(angle) - 0.90649_wp*sin(angle))))
            map(i, 3) = nint(255*(fract + amp*(+1.97294_wp*cos(angle))))
        end do
    end subroutine cubehelix_colormap