rgb_to_hsl Subroutine

private pure elemental subroutine rgb_to_hsl(r, g, b, h, s, l)

Arguments

Type IntentOptional Attributes Name
integer(kind=ik), intent(in) :: r
integer(kind=ik), intent(in) :: g
integer(kind=ik), intent(in) :: b
real(kind=rk), intent(out) :: h
real(kind=rk), intent(out) :: s
real(kind=rk), intent(out) :: l

Called by

proc~~rgb_to_hsl~~CalledByGraph proc~rgb_to_hsl rgb_to_hsl proc~convert color%convert proc~convert->proc~rgb_to_hsl proc~initialize_colors initialize_colors proc~initialize_colors->proc~convert proc~set color%set proc~initialize_colors->proc~set program~demo_color demo_color program~demo_color->proc~convert proc~find_nearest color%find_nearest program~demo_color->proc~find_nearest proc~print_available_colors color%print_available_colors program~demo_color->proc~print_available_colors proc~save_available_colors color%save_available_colors program~demo_color->proc~save_available_colors program~demo_color->proc~set program~example26 example26 program~example26->proc~convert program~example26->proc~set program~example27 example27 program~example27->proc~convert program~example27->proc~find_nearest program~example27->proc~set proc~find_nearest->proc~initialize_colors proc~print_available_colors->proc~initialize_colors proc~save_available_colors->proc~initialize_colors proc~set_by_name color%set_by_name proc~set_by_name->proc~initialize_colors proc~set->proc~set_by_name program~example29 example29 program~example29->proc~print_available_colors program~example29->proc~save_available_colors program~example28 example28 program~example28->proc~set

Source Code

   elemental pure subroutine rgb_to_hsl(r, g, b, h, s, l)
      integer(ik), intent(in) :: r, g, b
      real(rk), intent(out) :: h, s, l
      real(rk) :: rn, gn, bn
      real(rk) :: cmax, cmin

      rn = real(r, kind=rk) / 255.0_rk
      gn = real(g, kind=rk) / 255.0_rk
      bn = real(b, kind=rk) / 255.0_rk

      cmax = max(rn, max(gn, bn))
      cmin = min(rn, min(gn, bn))

      l = (cmax + cmin) / 2.0_rk

      if (abs(cmax - cmin) < 1e-6_rk) then
         s = 0.0_rk
      else
         if (l <= 0.5_rk) then
            s = (cmax - cmin) / (cmax + cmin)
         else
            s = (cmax - cmin) / (2.0_rk - cmax - cmin)
         end if
      end if

      if (abs(cmax - cmin) < 1e-6_rk) then
         h = 0.0_rk
      elseif (abs(cmax - rn) < 1e-6_rk) then
         h = 60.0_rk * mod((gn - bn) / (cmax - cmin), 6.0_rk)
      else if (abs(cmax - gn) < 1e-6_rk) then
         h = 60.0_rk * ((bn - rn) / (cmax - cmin) + 2.0_rk)
      else if (abs(cmax - bn) < 1e-6_rk) then
         h = 60.0_rk * ((rn - gn) / (cmax - cmin) + 4.0_rk)
      end if

      if (h < 0.0_rk) then
         h = h + 360.0_rk
      end if

      s = s*100.0_rk
      l = l*100.0_rk
   end subroutine rgb_to_hsl