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/
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(out), | dimension(:,:), allocatable | :: | map | ||
integer, | intent(in) | :: | nlev | |||
real(kind=wp), | intent(in), | optional, | dimension(:) | :: | varargs |
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