xyz_to_rgb Subroutine

private pure elemental subroutine xyz_to_rgb(x, y, z, r, g, b)

Arguments

Type IntentOptional Attributes Name
real(kind=rk), intent(in) :: x
real(kind=rk), intent(in) :: y
real(kind=rk), intent(in) :: z
integer(kind=ik), intent(out) :: r
integer(kind=ik), intent(out) :: g
integer(kind=ik), intent(out) :: b

Called by

proc~~xyz_to_rgb~~CalledByGraph proc~xyz_to_rgb xyz_to_rgb proc~convert color%convert proc~convert->proc~xyz_to_rgb 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 xyz_to_rgb(x, y, z, r, g, b)
      real(rk), intent(in) :: x, y, z
      integer(ik), intent(out) :: r, g, b
      real(rk) :: rn, gn, bn
      real(rk) :: x1, y1, z1

      x1 = x/100.0_rk
      y1 = y/100.0_rk
      z1 = z/100.0_rk

      ! Convert XYZ to linear RGB
      rn =  3.2404542_rk*x1  -1.5371385_rk*y1 -0.4985314_rk*z1
      gn = -0.9692660_rk*x1  +1.8760108_rk*y1 +0.0415560_rk*z1
      bn =  0.0556434_rk*x1  -0.2040259_rk*y1 +1.0572252_rk*z1

      ! Apply gamma correction
      if (rn <= 0.0031308_rk) then
         rn = 12.92_rk * rn
      else
         rn = 1.055_rk * (rn ** (1.0_rk / 2.4_rk)) - 0.055_rk
      end if

      if (gn <= 0.0031308_rk) then
         gn = 12.92_rk * gn
      else
         gn = 1.055_rk * (gn ** (1.0_rk / 2.4_rk)) - 0.055_rk
      end if

      if (bn <= 0.0031308_rk) then
         bn = 12.92_rk * bn
      else
         bn = 1.055_rk * (bn ** (1.0_rk / 2.4_rk)) - 0.055_rk
      end if

      ! Scale and convert to integer RGB values
      r = nint(rn*255.0_rk, kind=ik)
      g = nint(gn*255.0_rk, kind=ik)
      b = nint(bn*255.0_rk, kind=ik)

   end subroutine xyz_to_rgb