rgb_to_cmyk Subroutine

private pure elemental subroutine rgb_to_cmyk(r, g, b, c, m, y, k)

Arguments

Type IntentOptional Attributes Name
integer(kind=ik), intent(in) :: r
integer(kind=ik), intent(in) :: g
integer(kind=ik), intent(in) :: b
integer(kind=ik), intent(out) :: c
integer(kind=ik), intent(out) :: m
integer(kind=ik), intent(out) :: y
integer(kind=ik), intent(out) :: k

Called by

proc~~rgb_to_cmyk~~CalledByGraph proc~rgb_to_cmyk rgb_to_cmyk proc~convert color%convert proc~convert->proc~rgb_to_cmyk 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_cmyk(r, g, b, c, m, y, k)
      integer(ik), intent(in)  :: r, g, b
      integer(ik), intent(out) :: c, m, y, k
      real(rk)                 :: rn, gn, bn
      real(rk)                 :: cr, mr, yr, kr

      rn = r/255.0_rk
      gn = g/255.0_rk
      bn = b/255.0_rk

      kr = 1.0_rk - max(rn, gn, bn)

      if (abs(kr - 1.0_rk) < 1.0e-6_rk) then
         cr = 0.0_rk
         mr = 0.0_rk
         yr = 0.0_rk
      else
         cr = (1.0_rk-rn-kr)/(1.0_rk-kr)
         mr = (1.0_rk-gn-kr)/(1.0_rk-kr)
         yr = (1.0_rk-bn-kr)/(1.0_rk-kr)
      end if

      c = nint(cr*100.0_rk, kind=ik)
      m = nint(mr*100.0_rk, kind=ik)
      y = nint(yr*100.0_rk, kind=ik)
      k = nint(kr*100.0_rk, kind=ik)
   end subroutine rgb_to_cmyk