subroutine angle_to_rgb ( angle, r, g, b ) ! !******************************************************************************* ! !! ANGLE_TO_RGB returns a color on the perimeter of the RGB color hexagon. ! ! ! Modified: ! ! 12 July 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ANGLE, the angle in the color hexagon. The sextants are ! defined by the following points: ! 0 degrees, 1, 0, 0, red; ! 60 degrees, 1, 1, 0, yellow; ! 120 degrees, 0, 1, 0, green; ! 180 degrees, 0, 1, 1, cyan; ! 240 degrees, 0, 0, 1, blue; ! 300 degrees, 1, 0, 1, magenta. ! ! Output, real R, G, B, RGB specifications for the color that lies ! at the given angle, on the perimeter of the color hexagon. One ! value will be 1, and one value will be 0. ! implicit none ! real angle real b real g real r ! angle = mod ( angle, 360.0E+00 ) if ( angle < 0.0E+00 ) then angle = angle + 360.0E+00 end if if ( angle <= 60.0E+00 ) then r = 1.0E+00 g = angle / 60.0E+00 b = 0.0E+00 else if ( angle <= 120.0E+00 ) then r = ( 120.0E+00 - angle ) / 60.0E+00 g = 1.0E+00 b = 0.0E+00 else if ( angle <= 180.0E+00 ) then r = 0.0E+00 g = 1.0E+00 b = ( angle - 120.0E+00 ) / 60.0E+00 else if ( angle <= 240.0E+00 ) then r = 0.0E+00 g = ( 240.0E+00 - angle ) / 60.0E+00 b = 1.0E+00 else if ( angle <= 300.0E+00 ) then r = ( angle - 240.0E+00 ) / 60.0E+00 g = 0.0E+00 b = 1.0E+00 else if ( angle <= 360.0E+00 ) then r = 1.0E+00 g = 0.0E+00 b = ( 360.0E+00 - angle ) / 60.0E+00 end if return end subroutine ch_cap ( c ) ! !******************************************************************************* ! !! CH_CAP capitalizes a single character. ! ! ! Modified: ! ! 19 July 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, character C, the character to capitalize. ! implicit none ! character c integer itemp ! itemp = ichar ( c ) if ( 97 <= itemp .and. itemp <= 122 ) then c = char ( itemp - 32 ) end if return end subroutine chart ( xcap, ycap, zcap, color ) ! !******************************************************************************* ! !! CHART returns the CIE XYZ values of a 24 box color chart. ! ! ! Diagram: ! ! The chart may be drawn as a set of 4 rows of 6 squares of color: ! ! 1 2 3 4 5 6 ! 7 8 9 10 11 12 ! 13 14 15 16 17 18 ! 19 20 21 22 23 24 ! ! Reference: ! ! Roy Hall, ! Illumination and Color in Computer Generated Imagery, ! Springer Verlag, 1988. ! ! C S McCamy, H Marcus and J G Davidson, ! A Color Rendition Chart, ! Journal of Applied Photographic Engineering, ! Volume 11, number 3, pages 95-99. ! ! Modified: ! ! 04 October 1998 ! ! Parameters: ! ! Output, real XCAP(24), YCAP(24), ZCAP(24), the CIE XYZ color coordinates ! of the color squares. ! ! Output, character ( len = * ) COLOR(24), the names of the colors. ! The names are up to 14 characters in length. ! implicit none ! character ( len = * ) color(24) real xcap(24) real ycap(24) real zcap(24) ! color(1) = 'dark skin' xcap(1) = 0.092E+00 ycap(1) = 0.081E+00 zcap(1) = 0.058E+00 color(2) = 'light skin' xcap(2) = 0.411E+00 ycap(2) = 0.376E+00 zcap(2) = 0.303E+00 color(3) = 'blue sky' xcap(3) = 0.183E+00 ycap(3) = 0.186E+00 zcap(3) = 0.373E+00 color(4) = 'foliage' xcap(4) = 0.094E+00 ycap(4) = 0.117E+00 zcap(4) = 0.067E+00 color(5) = 'blue flower' xcap(5) = 0.269E+00 ycap(5) = 0.244E+00 zcap(5) = 0.503E+00 color(6) = 'bluish green' xcap(6) = 0.350E+00 ycap(6) = 0.460E+00 zcap(6) = 0.531E+00 color(7) = 'orange' xcap(7) = 0.386E+00 ycap(7) = 0.311E+00 zcap(7) = 0.066E+00 color(8) = 'purplish blue' xcap(8) = 0.123E+00 ycap(8) = 0.102E+00 zcap(8) = 0.359E+00 color(9) = 'moderate red' xcap(9) = 0.284E+00 ycap(9) = 0.192E+00 zcap(9) = 0.151E+00 color(10) = 'purple' xcap(10) = 0.059E+00 ycap(10) = 0.040E+00 zcap(10) = 0.102E+00 color(11) = 'yellow green' xcap(11) = 0.368E+00 ycap(11) = 0.474E+00 zcap(11) = 0.127E+00 color(12) = 'orange yellow' xcap(12) = 0.497E+00 ycap(12) = 0.460E+00 zcap(12) = 0.094E+00 color(13) = 'blue' xcap(13) = 0.050E+00 ycap(13) = 0.035E+00 zcap(13) = 0.183E+00 color(14) = 'green' xcap(14) = 0.149E+00 ycap(14) = 0.234E+00 zcap(14) = 0.106E+00 color(15) = 'red' xcap(15) = 0.176E+00 ycap(15) = 0.102E+00 zcap(15) = 0.048E+00 color(16) = 'yellow' xcap(16) = 0.614E+00 ycap(16) = 0.644E+00 zcap(16) = 0.112E+00 color(17) = 'magenta' xcap(17) = 0.300E+00 ycap(17) = 0.192E+00 zcap(17) = 0.332E+00 color(18) = 'cyan' xcap(18) = 0.149E+00 ycap(18) = 0.192E+00 zcap(18) = 0.421E+00 color(19) = 'white' xcap(19) = 0.981E+00 ycap(19) = 1.000E+00 zcap(19) = 1.184E+00 color(20) = 'neutral 8' xcap(20) = 0.632E+00 ycap(20) = 0.644E+00 zcap(20) = 0.763E+00 color(21) = 'neutral 6.5' xcap(21) = 0.374E+00 ycap(21) = 0.381E+00 zcap(21) = 0.451E+00 color(22) = 'neutral 5' xcap(22) = 0.189E+00 ycap(22) = 0.192E+00 zcap(22) = 0.227E+00 color(23) = 'neutral 3.5' xcap(23) = 0.067E+00 ycap(23) = 0.068E+00 zcap(23) = 0.080E+00 color(24) = 'black' xcap(24) = 0.000E+00 ycap(24) = 0.000E+00 zcap(24) = 0.000E+00 return end subroutine cmy_check ( c, m, y ) ! !******************************************************************************* ! !! CMY_CHECK corrects out-of-range CMY color coordinates. ! ! ! Definition: ! ! The CMY color system describes a color based on the amounts of the ! base colors cyan, magenta, and yellow. Thus, a particular color ! has three coordinates, (C,M,Y). Each coordinate must be between ! 0 and 1. ! ! Examples: ! ! Black (1,1,1) ! Blue (1,1,0) ! Cyan (1,0,0) ! Green (1,0,1) ! Magenta (0,1,0) ! Red (0,1,1) ! White (0,0,0) ! Yellow (0,0,1) ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 25 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real C, M, Y, the CMY color coordinates to be checked. ! Any value less than 0 is increased to zero. ! Any value greater than 1 is decreased to 1. ! implicit none ! real c real m real y ! c = max ( c, 0.0E+00 ) c = min ( c, 1.0E+00 ) m = max ( m, 0.0E+00 ) m = min ( m, 1.0E+00 ) y = max ( y, 0.0E+00 ) y = min ( y, 1.0E+00 ) return end subroutine cmy_to_cmyk ( c, m, y, c2, m2, y2, k2 ) ! !******************************************************************************* ! !! CMY_TO_CMYK converts CMY to CMYK color coordinates. ! ! ! Definition: ! ! The CMY color system describes a color based on the amounts of the ! base colors cyan, magenta, and yellow. Thus, a particular color ! has three coordinates, (C,M,Y). Each coordinate must be between ! 0 and 1. Black is (1,1,1) and white is (0,0,0). ! ! The CMYK color system describes a color based on the amounts of the ! base colors cyan, magenta, yellow, and black. The CMYK system is ! based on the CMY system, except that equal amounts of C, M, and Y ! are replaced by the single color K. Thus, a particular color ! has four coordinates, (C,M,Y,K). Each coordinate must be between ! 0 and 1, and it must also be true that C+K, M+K and Y+K are ! each no greater than 1. ! ! Formula: ! ! K2 = min ( C, M, Y ) ! C2 = C - K2 ! M2 = M - K2 ! Y2 = Y - K2 ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real C, M, Y, the CMY color coordinates to be converted. ! ! Output, real C2, M2, Y2, K2, the corresponding CMYK color coordinates. ! implicit none ! real c real c2 real k2 real m real m2 real y real y2 ! k2 = min ( c, m, y ) c2 = c - k2 m2 = m - k2 y2 = y - k2 return end subroutine cmy_to_rgb ( c, m, y, r, g, b ) ! !******************************************************************************* ! !! CMY_TO_RGB converts CMY to RGB color coordinates. ! ! ! Definition: ! ! The CMY color system describes a color based on the amounts of the ! base colors cyan, magenta, and yellow. Thus, a particular color ! has three coordinates, (C,M,Y). Each coordinate must be between ! 0 and 1. Black is (1,1,1) and white is (0,0,0). ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Formula: ! ! R = 1.0E+00 - C ! G = 1.0E+00 - M ! B = 1.0E+00 - Y ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real C, M, Y, the CMY color coordinates to be converted. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real c real g real m real r real y ! r = 1.0E+00 - c g = 1.0E+00 - m b = 1.0E+00 - y return end subroutine cmyk_check ( c, m, y, k ) ! !******************************************************************************* ! !! CMYK_CHECK corrects out-of-range CMYK color coordinates. ! ! ! Definition: ! ! The CMYK color system describes a color based on the amounts of the ! base colors cyan, magenta, yellow, and black. The CMYK system is ! based on the CMY system, except that equal amounts of C, M, and Y ! are replaced by the single color K. Thus, a particular color ! has four coordinates, (C,M,Y,K). Each coordinate must be between ! 0 and 1, and it must also be true that C+K, M+K and Y+K are ! each no greater than 1. ! ! Examples: ! ! Black (0,0,0,1) ! Blue (1,1,0,0) ! Cyan (1,0,0,0) ! Green (1,0,1,0) ! Magenta (0,1,0,0) ! Red (0,1,1,0) ! White (0,0,0,0) ! Yellow (0,0,1,0) ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 26 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real C, M, Y, K, the CMYK color coordinates to be checked. ! Any value less than 0 is increased to zero. ! Any value greater than 1 is decreased to 1. ! Then, if any of C+K, M+K or Y+K is greater than 1, C, M or Y is reduced ! accordingly. ! implicit none ! real c real k real m real y ! ! 1: Enforce the simple rule that C, M, Y and K must lie between 0 and 1. ! c = max ( c, 0.0E+00 ) c = min ( c, 1.0E+00 ) m = max ( m, 0.0E+00 ) m = min ( m, 1.0E+00 ) y = max ( y, 0.0E+00 ) y = min ( y, 1.0E+00 ) k = max ( k, 0.0E+00 ) k = min ( k, 1.0E+00 ) ! ! 2: Enforce C+K, M+K, Y+K each no greater than 1. ! c = min ( c, 1.0E+00 - k ) m = min ( m, 1.0E+00 - k ) y = min ( y, 1.0E+00 - k ) return end subroutine cmyk_to_cmy ( c, m, y, k, c2, m2, y2 ) ! !******************************************************************************* ! !! CMYK_TO_CMY converts CMYK to CMY color coordinates. ! ! ! Definition: ! ! The CMYK color system describes a color based on the amounts of the ! base colors cyan, magenta, yellow, and black. The CMYK system is ! based on the CMY system, except that equal amounts of C, M, and Y ! are replaced by the single color K. Thus, a particular color ! has four coordinates, (C,M,Y,K). Each coordinate must be between ! 0 and 1, and it must also be true that C+K, M+K and Y+K are ! each no greater than 1. ! ! The CMY color system describes a color based on the amounts of the ! base colors cyan, magenta, and yellow. Thus, a particular color ! has three coordinates, (C,M,Y). Each coordinate must be between ! 0 and 1. Black is (1,1,1) and white is (0,0,0). ! ! Formula: ! ! C2 = C + K ! M2 = M + K ! Y2 = Y + K ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real C, M, Y, K, the CMYK color coordinates to be converted. ! ! Output, real C2, M2, Y2, the corresponding CMY color coordinates. ! implicit none ! real c real c2 real k real m real m2 real y real y2 ! c2 = c + k m2 = m + k y2 = y + k return end subroutine cmyk_to_rgb ( c, m, y, k, r, g, b ) ! !******************************************************************************* ! !! CMYK_TO_RGB converts CMYK to RGB color coordinates. ! ! ! Definition: ! ! The CMYK color system describes a color based on the amounts of the ! base colors cyan, magenta, yellow, and black. The CMYK system is ! based on the CMY system, except that equal amounts of C, M, and Y ! are replaced by the single color K. Thus, a particular color ! has four coordinates, (C,M,Y,K). Each coordinate must be between ! 0 and 1, and it must also be true that C+K, M+K and Y+K are ! each no greater than 1. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real C, M, Y, K, the CMYK color coordinates to be converted. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real c real g real k real m real r real y ! r = 1.0E+00 - ( c + k ) g = 1.0E+00 - ( m + k ) b = 1.0E+00 - ( y + k ) return end subroutine get_seed ( iseed ) ! !******************************************************************************* ! !! GET_SEED returns a seed for the random number generator. ! ! ! Discussion: ! ! The seed depends on the current time, and ought to be (slightly) ! different every millisecond. Once the seed is obtained, a random ! number generator should be called a few times to further process ! the seed. ! ! Modified: ! ! 23 March 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, integer ISEED, a pseudorandom seed value. ! implicit none ! integer iseed double precision temp character ( len = 10 ) time character ( len = 8 ) today integer values(8) character ( len = 5 ) zone ! call date_and_time ( today, time, zone, values ) temp = 0.0E+00 temp = temp + dble ( values(2) - 1 ) / 11.0E+00 temp = temp + dble ( values(3) - 1 ) / 30.0E+00 temp = temp + dble ( values(5) ) / 23.0E+00 temp = temp + dble ( values(6) ) / 59.0E+00 temp = temp + dble ( values(7) ) / 59.0E+00 temp = temp + dble ( values(8) ) / 999.0E+00 temp = temp / 6.0E+00 if ( temp <= 0.0E+00 ) then temp = 1.0E+00 / 3.0E+00 else if ( temp >= 1.0E+00 ) then temp = 2.0E+00 / 3.0E+00 end if iseed = int ( dble ( huge ( iseed ) ) * temp ) ! ! Never use a seed of 0 or maximum integer. ! if ( iseed == 0 ) then iseed = 1 end if if ( iseed == huge ( iseed ) ) then iseed = huge ( iseed ) - 1 end if return end subroutine get_unit ( iunit ) ! !******************************************************************************* ! !! GET_UNIT returns a free FORTRAN unit number. ! ! ! Discussion: ! ! A "free" FORTRAN unit number is an integer between 1 and 99 which ! is not currently associated with an I/O device. A free FORTRAN unit ! number is needed in order to open a file with the OPEN command. ! ! Modified: ! ! 02 March 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, integer IUNIT. ! ! If IUNIT = 0, then no free FORTRAN unit could be found, although ! all 99 units were checked (except for units 5 and 6). ! ! Otherwise, IUNIT is an integer between 1 and 99, representing a ! free FORTRAN unit. Note that GET_UNIT assumes that units 5 and 6 ! are special, and will never return those values. ! implicit none ! integer i integer ios integer iunit logical lopen iunit = 0 do i = 1, 99 if ( i /= 5 .and. i /= 6 ) then inquire ( unit = i, opened = lopen, iostat = ios ) if ( ios == 0 ) then if ( .not. lopen ) then iunit = i return end if end if end if end do return end subroutine hls_check ( h, l, s ) ! !******************************************************************************* ! !! HLS_CHECK corrects out-of-range HLS color coordinates. ! ! ! Definition: ! ! The HLS color system describes a color based on the qualities of ! hue, lightness, and saturation. A particular color has three ! coordinates, (H,L,S). The L and S coordinates must be between ! 0 and 1, while the H coordinate must be between 0 and 360, and ! is interpreted as an angle. ! ! The HLS color space is usually thought of as a double hexcone. ! If the L coordinate is vertical, then the color space is a single ! black point at L = 0, expands to a colorful hexagon ! at L = 0.5, and contracts again to a white point at L = 1. ! The colorful hexagon as the colors Red, Yellow, Green, Cyan, Blue, ! and Magenta at its vertices. ! The saturation coordinate varies from 0.0E+00 at the center of the ! hexagon to 1.0E+00 at the boundary. The corresponding color varies ! from gray at S = 0 to the full color on the boundary at S = 1. ! ! If the (H,S) plane is thought of as a circle, then S is the relative ! distance from the central vertical L axis to the boundary of the hexcone. ! Thus, even as the cone contracts to a point, S can always vary ! from 0 to 1. In particular, the white point can have coordinates ! ( H, 1.0, S ) where H is any value in [ 0, 360.0E+00 ) and S is ! any value in [ 0.0, 1.0E+00 ]. ! ! Note: ! ! Some versions of the HLS model assign Blue to have HLS coordinates ! ( 0.0, 0.5, 1.0E+00 ) instead of Red, rotating all the colors ahead ! 120 degrees. ! ! Some versions define L as equal to the average of R, G and B, rather ! than the average of the maximum and minimum of R, G and B. ! ! Examples: ! ! Given RED = ( 0.0, 0.5, 1.0E+00 ) then: ! ! Black ( 0.0, 0.0, 0.0E+00 ) ! Blue ( 240.0, 0.5, 1.0E+00 ) ! Cyan ( 180.0, 0.5, 1.0E+00 ) ! Green ( 120.0, 0.5, 1.0E+00 ) ! Magenta ( 300.0, 0.5, 1.0E+00 ) ! Red ( 0.0, 0.5, 1.0E+00 ) ! White ( 0.0, 1.0, 0.0E+00 ) ! Yellow ( 60.0, 0.5, 1.0E+00 ) ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 25 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real H, L, S, the HLS color coordinates to be checked. ! If H is outside the range [0, 360), it is brought back in range ! using a MOD operation. ! Values of L or S less than 0 are set to 0, greater than 1 are set ! to 1. ! implicit none ! real h real l real r_modp real s ! h = r_modp ( h, 360.0E+00 ) l = max ( l, 0.0E+00 ) l = min ( l, 1.0E+00 ) s = max ( s, 0.0E+00 ) s = min ( s, 1.0E+00 ) return end subroutine hls_to_rgb ( h, l, s, r, g, b ) ! !******************************************************************************* ! !! HLS_TO_RGB converts HLS to RGB color coordinates. ! ! ! Definition: ! ! The HLS color system describes a color based on the qualities of ! hue, lightness, and saturation. A particular color has three ! coordinates, (H,L,S). The L and S coordinates must be between ! 0 and 1, while the H coordinate must be between 0 and 360, and ! is interpreted as an angle. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real H, L, S, the HLS color coordinates to be converted. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real g real h real hls_value real l real m1 real m2 real r real s ! if ( l <= 0.5E+00 ) then m2 = l + l * s else m2 = l + s - l * s end if m1 = 2.0E+00 * l - m2 if ( s == 0.0E+00 ) then r = l g = l b = l else r = hls_value ( m1, m2, h + 120.0E+00 ) g = hls_value ( m1, m2, h ) b = hls_value ( m1, m2, h - 120.0E+00 ) end if return end function hls_value ( n1, n2, h ) ! !******************************************************************************* ! !! HLS_VALUE is a utility function used by HLS_TO_RGB. ! ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real N1, N2, H. ! ! Output, real HLS_VALUE. ! implicit none ! real h real hls_value real hue real n1 real n2 real r_modp ! ! Make sure HUE lies between 0 and 360. ! hue = r_modp ( h, 360.0E+00 ) if ( hue < 60.0E+00 ) then hls_value = n1 + ( n2 - n1 ) * hue / 60.0E+00 else if ( hue < 180.0E+00 ) then hls_value = n2 else if ( hue < 240.0E+00 ) then hls_value = n1 + ( n2 - n1 ) * ( 240.0E+00 - hue ) / 60.0E+00 else hls_value = n1 end if return end subroutine hsv_check ( h, s, v ) ! !******************************************************************************* ! !! HSV_CHECK corrects out-of-range HSV color coordinates. ! ! ! Definition: ! ! The HSV color system describes a color based on the three qualities ! of hue, saturation, and value. A given color will be represented ! by three numbers, (H,S,V). H, the value of hue, is an angle ! between 0 and 360 degrees, with 0 representing red. S is the ! saturation, and is between 0 and 1. Finally, V is the "value", ! a measure of brightness, which goes from 0 for black, increasing ! to a maximum of 1 for the brightest colors. The HSV color system ! is sometimes also called HSB, where the B stands for brightness. ! ! Examples: ! ! Black ( 0.000 0.000 0.000 ) ! Blue ( 240.000 1.000 1.000 ) ! Cyan ( 180.000 1.000 1.000 ) ! Green ( 120.000 1.000 1.000 ) ! Magenta ( 300.000 1.000 1.000 ) ! Red ( 0.000 1.000 1.000 ) ! White ( 0.000 0.000 1.000 ) ! Yellow ( 60.000 1.000 1.000 ) ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 30 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real H, S, V, the HSV color coordinates to be checked. ! implicit none ! real h real r_modp real s real v ! h = r_modp ( h, 360.0E+00 ) s = max ( s, 0.0E+00 ) s = min ( s, 1.0E+00 ) v = max ( v, 0.0E+00 ) v = min ( v, 1.0E+00 ) return end subroutine hsv_to_rgb ( h, s, v, r, g, b ) ! !******************************************************************************* ! !! HSV_TO_RGB converts HSV to RGB color coordinates. ! ! ! Definition: ! ! The HSV color system describes a color based on the three qualities ! of hue, saturation, and value. A given color will be represented ! by three numbers, (H,S,V). H, the value of hue, is an angle ! between 0 and 360 degrees, with 0 representing red. S is the ! saturation, and is between 0 and 1. Finally, V is the "value", ! a measure of brightness, which goes from 0 for black, increasing ! to a maximum of 1 for the brightest colors. The HSV color system ! is sometimes also called HSB, where the B stands for brightness. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real H, S, V, the HSV color coordinates to be converted. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real f real g real h real hue integer i real p real q real r real r_modp real s real t real v ! if ( s == 0.0E+00 ) then r = v g = v b = v else ! ! Make sure HUE lies between 0 and 360.0E+00 ! hue = r_modp ( h, 360.0E+00 ) hue = hue / 60.0E+00 i = int ( hue ) f = hue - real ( i ) p = v * ( 1.0E+00 - s ) q = v * ( 1.0E+00 - s * f ) t = v * ( 1.0E+00 - s + s * f ) if ( i == 0 ) then r = v g = t b = p else if ( i == 1 ) then r = q g = v b = p else if ( i == 2 ) then r = p g = v b = t else if ( i == 3 ) then r = p g = q b = v else if ( i == 4 ) then r = t g = p b = v else if ( i == 5 ) then r = v g = p b = q end if end if return end subroutine hvc_check ( h, v, c ) ! !******************************************************************************* ! !! HVC_CHECK corrects out-of-range HVC color coordinates. ! ! ! Definition: ! ! The HVC color system, developed by Tektronix, describes a color ! based on the three qualities of hue, value, and chroma. A given ! color will be represented by three numbers, (H,V,C). H, the value ! of hue, is an angle between 0 and 360 degrees, with 0 representing ! red. V, the "value", is between 0 and 100. C, the "chroma", is ! between 0 and 100. ! ! Modified: ! ! 03 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real H, V, C, the HVC color coordinates to be checked. ! implicit none ! real c real h real r_modp real v ! h = r_modp ( h, 360.0E+00 ) v = max ( v, 0.0E+00 ) v = min ( v, 100.0E+00 ) c = max ( c, 0.0E+00 ) c = min ( c, 100.0E+00 ) return end subroutine interp ( ndat, x, xdat, y, ydat ) ! !******************************************************************************* ! !! INTERP does simple linear interpolation in a table. ! ! ! Modified: ! ! 06 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer NDAT, the number of data items. ! ! Input, real X, the value of the independent variable. ! ! Input, real XDAT(NDAT), the tabulated X values, which should ! be in ascending order. ! ! Output, real Y, the interpolated Y value. ! ! Input, real YDAT(NDAT), the tabulated Y values. ! implicit none ! integer ndat ! integer i real x real xdat(ndat) real y real ydat(ndat) ! if ( x < xdat(1) ) then y = ydat(1) else do i = 1, ndat-1 if ( xdat(i) <= x .and. x <= xdat(i+1) ) then y = ( ( xdat(i+1) - x ) * ydat(i) + ( x - xdat(i) ) * ydat(i+1) ) & / ( xdat(i+1) - xdat(i) ) return end if end do end if y = ydat(ndat) return end subroutine lab_check ( lstar, astar, bstar ) ! !******************************************************************************* ! !! LAB_CHECK corrects out-of-range CIE L*a*b* color coordinates. ! ! ! Definition: ! ! The CIE L*a*b* color system describes a color based on three ! qualities: L* is CIE lightness, a* and b* contain chromatic ! information. A given color will be represented by three ! numbers, (L*,a*,b*). The ranges are ! 0 <= L* <= 100, ! -500 <= a* <= 500, ! -200 <= b* <= 200. ! ! Modified: ! ! 07 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real LSTAR, ASTAR, BSTAR, the CIE L*a*b* color coordinates ! to be checked. ! implicit none ! real astar real bstar real lstar ! lstar = max ( lstar, 0.0E+00 ) lstar = min ( lstar, 100.0E+00 ) astar = max ( astar, -500.0E+00 ) astar = min ( astar, 500.0E+00 ) bstar = max ( bstar, -200.0E+00 ) bstar = min ( bstar, 200.0E+00 ) return end subroutine lab_prop ( lstar, astar, bstar, chroma, hue, luminance ) ! !******************************************************************************* ! !! LAB_PROP returns certain properties of a CIE L*a*b* color. ! ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LSTAR, ASTAR, BSTAR, the CIE L*a*b* coordinates of the color. ! ! Output, real CHROMA, HUE, LUMINANCE, the chroma, hue, and relative ! luminance. HUE is returned as an angle, in degrees. ! implicit none ! real astar real bstar real chroma real hue real lstar real luminance real radians_to_degrees ! chroma = sqrt ( astar**2 + bstar**2 ) hue = atan2 ( bstar, astar ) hue = radians_to_degrees ( hue ) if ( lstar <= 0.0E+00 ) then luminance = 0.0E+00 else if ( lstar <= 903.3E+00 * 0.008856E+00 ) then luminance = lstar / 903.3E+00 else if ( lstar <= 100.0E+00 ) then luminance = ( ( lstar + 16.0E+00 ) / 116.0E+00 )**3 else luminance = 1.0E+00 end if return end subroutine lab_to_xyz ( lstar, astar, bstar, xcap, ycap, zcap, xcapn, ycapn, & zcapn ) ! !******************************************************************************* ! !! LAB_TO_XYZ converts CIE L*a*b* to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE L*a*b* color system describes a color based on three ! qualities: L* is CIE lightness, a* and b* contain chromatic ! information. A given color will be represented by three ! numbers, (L*,a*,b*). The ranges are 0 <= L* <= 100, -500 <= a* <= 500, ! -200 <= b* <= 200. ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 09 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LSTAR, ASTAR, BSTAR, the CIE L*a*b* color coordinates. ! ! Output, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Input, real XCAPN, YCAPN, ZCAPN, the CIE XYZ color coordinates of white. ! implicit none ! real astar real bstar real fx real fy real fz real lstar real r_cubert real xcap real xcapn real ycap real ycapn real zcap real zcapn ! if ( lstar <= 0.0E+00 ) then ycap = 0.0E+00 else if ( lstar <= 8.0E+00 ) then ycap = lstar * ycapn / 903.3E+00 else if ( lstar <= 100.0E+00 ) then ycap = ycapn * ( ( lstar + 16.0E+00 ) / 116.0E+00 )**3 else ycap = ycapn end if if ( ycap <= 0.00856E+00 * ycapn ) then fy = 7.787E+00 * ycap / ycapn + 16.0E+00 / 116.0E+00 else fy = r_cubert ( ycap / ycapn ) end if fx = fy + ( astar / 500.0E+00 ) if ( fx**3 <= 0.008856E+00 ) then xcap = xcapn * ( fx - 16.0E+00 / 116.0E+00 ) / 7.787E+00 else xcap = xcapn * fx**3 end if fz = fy - ( bstar / 200.0E+00 ) if ( fz**3 <= 0.008856E+00 ) then zcap = zcapn * ( fz - 16.0E+00 / 116.0E+00 ) / 7.787E+00 else zcap = zcapn * fz**3 end if return end subroutine lcc_to_rgbprime ( luma, chroma1, chroma2, yr, yg, yb, rprime, & gprime, bprime ) ! !******************************************************************************* ! !! LCC_TO_RGBPRIME converts LCC to R'G'B' color coordinates. ! ! ! Definition: ! ! The LCC color coordinate system records a color as three components, ! Luma, Chroma1 and Chroma2. The LCC color coordinates are used ! in an intermediate calculation of the PhotoYCC color coordinates. ! Luma is scaled luminance, Chroma1 is (B'-Luma) and Chroma2 is (R'-Luma). ! ! The R'G'B' color system is a nonlinear video signal measurement. ! Each coordinate must be between 0 and 1. ! ! Modified: ! ! 01 February 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LUMA, CHROMA1, CHROMA2, the LCC color coordinates. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real RPRIME, GPRIME, BPRIME, the R'G'B' color coordinates. ! implicit none ! real chroma1 real chroma2 real bprime real gprime real luma real rprime real yb real yg real yprime real yr ! yprime = luma rprime = yprime + chroma2 bprime = yprime + chroma1 gprime = ( luma - yr * rprime - yb * bprime ) / yg return end subroutine lcc_to_ycbcr ( luma, chroma1, chroma2, yprime, cb, cr ) ! !******************************************************************************* ! !! LCC_TO_YCBCR converts LCC to Y'CbCr color coordinates. ! ! ! Definition: ! ! The LCC color coordinate system records a color as three components, ! Luma, Chroma1 and Chroma2. The LCC color coordinates are used ! in an intermediate calculation of the PhotoYCC color coordinates. ! Luma is scaled luminance, Chroma1 is (B'-Luma) and Chroma2 is (R'-Luma). ! ! The Y'CbCr color system is used in digital television signals. ! The Y' component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, with reference black at 16/255 and reference white at 235/255, ! while Cb and Cr should be between -0.5 and 0.5. ! ! Reference: ! ! C Wayne Brown and Barry Shepherd, ! Graphics File Formats, ! Manning Publications, 1995. ! ! Modified: ! ! 04 October 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LUMA, CHROMA1, CHROMA2, the LCC color coordinates. ! ! Output, real YPRIME, CB, CR, the Y'CbCr color coordinates. ! implicit none ! real cb real chroma1 real chroma2 real cr real luma real yprime ! yprime = ( 219.0E+00 * luma + 16.0E+00 ) / 255.0E+00 cb = ( 224.0E+00 * 0.564E+00 * chroma1 + 128.0E+00 ) / 255.0E+00 cr = ( 224.0E+00 * 0.713E+00 * chroma2 + 128.0E+00 ) / 255.0E+00 return end subroutine lcc_to_ycc ( luma, chroma1, chroma2, yprime, c1, c2 ) ! !******************************************************************************* ! !! LCC_TO_YCC converts LCC to PhotoYCC color coordinates. ! ! ! Definition: ! ! The LCC color coordinate system records a color as three components, ! Luma, Chroma1 and Chroma2. The LCC color coordinates are used ! in an intermediate calculation of the PhotoYCC color coordinates. ! Luma is scaled luminance, Chroma1 is (B'-Luma) and Chroma2 is (R'-Luma). ! ! The Kodak PhotoYCC Color Interchange Space was developed for the ! Photo CD System. The Y' coordinate is a measure of luminance, ! while C1 and C2 measure color difference chrominance. ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 17 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LUMA, CHROMA1, CHROMA2, the LCC color coordinates. ! ! Output, real YPRIME, C1, C2, the PhotoYCC color coordinates. ! implicit none ! real c1 real c2 real chroma1 real chroma2 real luma real yprime ! yprime = 255.0E+00 * luma / 1.402E+00 c1 = 111.40E+00 * chroma1 + 156.0E+00 c2 = 135.64E+00 * chroma2 + 137.0E+00 return end subroutine lin_to_nonlin ( r, rprime ) ! !******************************************************************************* ! !! LIN_TO_NONLIN converts a linear light intensity to nonlinear video signal. ! ! ! Modified: ! ! 19 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, the linear light intensity. ! ! Output, real RPRIME, the nonlinear video signal. ! implicit none ! real r real rprime ! if ( r < -0.018E+00 ) then rprime = + 0.099E+00 - 1.099E+00 * abs ( r )**(0.45E+00) else if ( abs ( r ) <= 0.018E+00 ) then rprime = 4.5E+00 * r else rprime = - 0.099E+00 + 1.099E+00 * r**(0.45E+00) end if return end subroutine luv_check ( lstar, ustar, vstar ) ! !******************************************************************************* ! !! LUV_CHECK corrects out-of-range CIE L*u*v* color coordinates. ! ! ! Definition: ! ! The CIE L*u*v* color system describes a color based on three ! qualities: L* is CIE lightness, u* and v* contain chromatic ! information. A given color will be represented by three ! numbers, (L*,u*,v*). L* ranges between 0 and 100. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real LSTAR, USTAR, VSTAR, the CIE L*u*v* color coordinates ! to be checked. ! implicit none ! real lstar real ustar real vstar ! lstar = max ( lstar, 0.0E+00 ) lstar = min ( lstar, 100.0E+00 ) return end subroutine luv_prop ( lstar, ustar, vstar, chroma, hue, luminance, sat ) ! !******************************************************************************* ! !! LUV_PROP returns certain properties of a CIE L*u*v* color. ! ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LSTAR, USTAR, VSTAR, the CIE L*u*v* coordinates of the color. ! ! Output, real CHROMA, HUE, LUMINANCE, SAT, the chroma, hue, relative ! luminance, and saturation. HUE is returned as an angle in degrees. ! implicit none ! real chroma real hue real lstar real luminance real radians_to_degrees real sat real ustar real vstar ! chroma = sqrt ( ustar**2 + vstar**2 ) hue = atan2 ( vstar, ustar ) hue = radians_to_degrees ( hue ) if ( lstar == 0.0E+00 ) then sat = 0.0E+00 else sat = chroma / lstar end if if ( lstar <= 0.0E+00 ) then luminance = 0.0E+00 else if ( lstar <= 903.3E+00 * 0.008856E+00 ) then luminance = lstar / 903.3E+00 else if ( lstar <= 100.0E+00 ) then luminance = ( ( lstar + 16.0E+00 ) / 116.0E+00 )**3 else luminance = 1.0E+00 end if return end subroutine luv_to_xyz ( lstar, ustar, vstar, xcap, ycap, zcap, xcapn, ycapn, & zcapn ) ! !******************************************************************************* ! !! LUV_TO_XYZ converts CIE L*u*v* to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE L*u*v* color system describes a color based on three ! qualities: L* is CIE lightness, u* and v* contain chromatic ! information. A given color will be represented by three ! numbers, (L*,u*,v*). L* ranges between 0 and 100. ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 12 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LSTAR, USTAR, VSTAR, the CIE L*u*v* color coordinates. ! ! Output, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Input, real XCAPN, YCAPN, ZCAPN, the CIE XYZ color coordinates of white. ! implicit none ! real lstar real ustar real uprime real unprime real vstar real vprime real vnprime real wnprime real xcap real xcapn real ycap real ycapn real zcap real zcapn ! if ( lstar <= 0.0E+00 ) then xcap = 0.0E+00 ycap = 0.0E+00 zcap = 0.0E+00 else ! ! Compute CIE luminance from L* and YCAPN. ! if ( lstar <= 0.0E+00 ) then ycap = 0.0E+00 else if ( lstar <= 903.3E+00 * 0.008856E+00 ) then ycap = lstar * ycapn / 903.3E+00 else if ( lstar <= 100.0E+00 ) then ycap = ycapn * ( ( lstar + 16.0E+00 ) / 116.0E+00 )**3 else ycap = ycapn end if ! ! Compute (un',vn') from (XCAPN,YCAPN,ZCAPN). ! call xyz_to_uvwprime ( xcapn, ycapn, zcapn, unprime, vnprime, wnprime ) ! ! Compute (u',v') from (un',vn') and (l*,u*,v*). ! uprime = unprime + ustar / ( 13.0E+00 * lstar ) vprime = vnprime + vstar / ( 13.0E+00 * lstar ) ! ! Now compute XCAP and ZCAP from (u',v') and YCAP. ! call uvprimey_to_xyz ( uprime, vprime, xcap, ycap, zcap ) end if return end subroutine name_test ( itest, name ) ! !******************************************************************************* ! !! NAME_TEST supplies color names for tests. ! ! ! Modified: ! ! 19 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ITEST, the index of the test, between 1 and 15. ! ! Output, character ( len = * ) NAME, the name of a color to be tested. ! The longest name is 11 characters. ! implicit none ! integer itest character ( len = * ) name ! if ( itest == 1 ) then name = 'Red' else if ( itest == 2 ) then name = 'Green' else if ( itest == 3 ) then name = 'Blue' else if ( itest == 4 ) then name = 'Cyan' else if ( itest == 5 ) then name = 'Magenta' else if ( itest == 6 ) then name = 'Yellow' else if ( itest == 7 ) then name = 'White' else if ( itest == 8 ) then name = 'Black' else if ( itest == 9 ) then name = 'Pink' else if ( itest == 10 ) then name = 'Aquamarine' else if ( itest == 11 ) then name = 'Tan' else if ( itest == 12 ) then name = 'YellowGreen' else if ( itest == 13 ) then name = 'Maroon' else if ( itest == 14 ) then name = 'Salmon' else if ( itest == 15 ) then name = 'Mauve' else write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'NAME_TEST - Fatal error!' write ( *, '(a,i6)' ) ' No test number ITEST = ', itest stop end if return end subroutine name_to_primaries ( name, rx, ry, gx, gy, bx, by, wx, wy ) ! !******************************************************************************* ! !! NAME_TO_PRIMARIES returns CIExy chromaticities of television primaries. ! ! ! Reference: ! ! David Martindale and Alan Paeth, ! Television Color Encoding and Hot Broadcast Colors, ! Graphics Gems II, edited by James Arvo, ! Academic Press, 1991, pages 147-158. ! ! Modified: ! ! 30 April 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) NAME, the name of a television system: ! 'CIE', the CIE primaries; ! 'EBU', ! 'HDTV', ! 'NTSC', National Television Systems Committee; ! 'SMPTE', Society of Motion Picture and Television Engineers. ! ! Output, real RX, RY, the xy chromaticities of the R primary. ! ! Output, real GX, GY, the xy chromaticities of the G primary. ! ! Output, real BX, BY, the xy chromaticities of the B primary. ! ! Output, real WX, WY, the xy chromaticities of the reference white. ! implicit none ! real bx real by real gx real gy character ( len = * ) name character ( len = 30 ) name_copy real rx real ry logical s_eqi real wx real wy ! ! Make a temporary copy of NAME. ! name_copy = adjustl ( name ) ! ! Remove blanks and underlines. ! call s_c_delete ( name_copy, ' ' ) call s_c_delete ( name_copy, '_' ) if ( s_eqi ( name_copy, 'CIE' ) ) then rx = 0.73467E+00 ry = 0.26533E+00 gx = 0.27376E+00 gy = 0.71741E+00 bx = 0.16658E+00 by = 0.00886E+00 wx = 1.0E+00 / 3.0E+00 wy = 1.0E+00 / 3.0E+00 else if ( s_eqi ( name_copy, 'EBU' ) ) then rx = 0.64E+00 ry = 0.33E+00 gx = 0.29E+00 gy = 0.60E+00 bx = 0.15E+00 by = 0.06E+00 wx = 0.3127E+00 wy = 0.3291E+00 else if ( s_eqi ( name_copy, 'HDTV' ) ) then rx = 0.670E+00 ry = 0.330E+00 gx = 0.210E+00 gy = 0.710E+00 bx = 0.150E+00 by = 0.060E+00 wx = 0.3127E+00 wy = 0.3291E+00 else if ( s_eqi ( name_copy, 'NTSC' ) ) then rx = 0.67E+00 ry = 0.33E+00 gx = 0.21E+00 gy = 0.71E+00 bx = 0.14E+00 by = 0.08E+00 wx = 0.3101E+00 wy = 0.3162E+00 else if ( s_eqi ( name_copy, 'SMPTE' ) ) then rx = 0.630E+00 ry = 0.340E+00 gx = 0.310E+00 gy = 0.595E+00 bx = 0.155E+00 by = 0.070E+00 wx = 0.3127E+00 wy = 0.3291E+00 else write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'NAME_TO_PRIMARIES - Fatal error!' write ( *, '(a)' ) ' Unrecognized name: "' // trim ( name ) // '"' stop end if return end subroutine name_to_rgb ( name, r, g, b ) ! !******************************************************************************* ! !! NAME_TO_RGB converts a string to RGB colors. ! ! ! Discussion: ! ! The names and information are read from the file "COLORS.TXT", a ! modified version of the X Windows color data file "RGB.TXT". ! ! Modified: ! ! 30 April 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) NAME, the name of a color. ! ! Output, real R, G, B, the corresponding RGB coordinates. However, ! these will be returned as ( -1.0, -1.0, -1.0E+00 ) if the color name ! was not recognized. ! implicit none ! real b real bcolor character ( len = 20 ) :: color_file = 'colors.txt' real g real gcolor integer ib integer ig integer ios integer ir integer iunit character ( len = * ) name character ( len = 30 ) name_copy character ( len = 30 ) name_color real r real rcolor logical s_eqi ! ! Make a temporary copy of NAME. ! name_copy = adjustl ( name ) ! ! Remove blanks and underlines. ! call s_c_delete ( name_copy, ' ' ) call s_c_delete ( name_copy, '_' ) call get_unit ( iunit ) open ( unit = iunit, file = color_file, status = 'old', iostat = ios ) if ( ios /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'NAME_TO_RGB - Fatal error!' write ( *, '(a)' ) ' Could not open the color name file:' write ( *, '(a)' ) trim ( color_file ) stop end if do read ( iunit, '(a30,i3,1x,i3,1x,i3,1x,f9.4,1x,f9.4,1x,f9.4)', & iostat = ios ) name_color, ir, ig, ib, rcolor, gcolor, bcolor if ( ios /= 0 ) then r = - 1.0E+00 g = - 1.0E+00 b = - 1.0E+00 exit end if if ( s_eqi ( name_copy, name_color ) ) then r = rcolor g = gcolor b = bcolor exit end if end do close ( unit = iunit ) return end subroutine name_to_xyz ( name, x, y, z ) ! !******************************************************************************* ! !! NAME_TO_XYZ converts a color or illuminant name to CIE xyz chromaticities. ! ! ! Discussion: ! ! Thanks to Harald Anlauf of the Technical University of Darmstadt, ! for pointing out a programming error which meant that NAME was not ! an input-only variable. (30 April 2002) ! ! Definition: ! ! In the CIE color system, the exact chromaticities of several ! standard illuminants were defined. These were generally chosen to ! correspond to common lighting situations. ! ! Modified: ! ! 30 April 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) NAME, the name of a color. Before considering ! the name, the routine removes all blanks and underscores, and ! capitalizes the name. Legal names include: ! ! 'A', the CIE illuminant A, light from a tungsten lamp, at 500 watts; ! 'B', the CIE illuminant B, direct sunlight, at 500 watts; ! 'C', the CIE illuminant C, average sunlight, at 500 watts; ! This is used as the reference white for NTSC color encoding. ! 'D50' or 'D5000', the CIE illuminant used in graphics printing, ! bright tunsten illumination; ! 'D55' or 'D5500', a CIE illuminant that approximates a cloudy bright day; ! 'D65' or 'D6500', the CIE illuminant that approximates daylight; ! This is used as the reference white for SMPTE, PAL/EBU, and HDTV ! color encoding. ! 'E', the CIE illuminant E, normalized reference source. ! ! Output, real X, Y, Z, the corresponding CIE xyz chromaticities, ! or (0,0,0) if the name is not recognized. ! implicit none ! character ( len = * ) name character ( len = 20 ) name_copy logical s_eqi real x real y real z ! ! Make a temporary copy of NAME. ! name_copy = adjustl ( name ) ! ! Remove blanks and underlines. ! call s_c_delete ( name_copy, ' ' ) call s_c_delete ( name_copy, '_' ) ! ! Compare the input name to the recognized list. ! if ( s_eqi ( name_copy, 'A' ) ) then x = 0.448E+00 y = 0.407E+00 z = 0.145E+00 else if ( s_eqi ( name_copy, 'B' ) ) then x = 0.349E+00 y = 0.352E+00 z = 0.299E+00 else if ( s_eqi ( name_copy, 'C' ) ) then x = 0.3101E+00 y = 0.3162E+00 z = 0.3737E+00 else if ( s_eqi ( name_copy, 'D50' ) .or. & s_eqi ( name_copy, 'D5000' ) ) then x = 96.42E+00 / ( 96.42E+00 + 100.00E+00 + 82.49E+00 ) y = 100.00E+00 / ( 96.42E+00 + 100.00E+00 + 82.49E+00 ) z = 82.49E+00 / ( 95.42E+00 + 100.00E+00 + 82.49E+00 ) else if ( s_eqi ( name_copy, 'D55' ) .or. & s_eqi ( name_copy, 'D5500' ) ) then x = 0.3324E+00 y = 0.3474E+00 z = 0.3202E+00 else if ( s_eqi ( name_copy, 'D65' ) .or. & s_eqi ( name_copy, 'D6500' ) ) then x = 95.05E+00 / ( 95.05E+00 + 100.00E+00 + 108.91E+00 ) y = 100.00E+00 / ( 95.05E+00 + 100.00E+00 + 108.91E+00 ) z = 108.91E+00 / ( 95.05E+00 + 100.00E+00 + 108.91E+00 ) else if ( s_eqi ( name_copy, 'E' ) ) then x = 100.0E+00 / 300.0E+00 y = 100.0E+00 / 300.0E+00 z = 100.0E+00 / 300.0E+00 else x = 0.0E+00 y = 0.0E+00 z = 0.0E+00 end if return end subroutine ncs_check ( c1, c2, n, c, s ) ! !******************************************************************************* ! !! NCS_CHECK corrects out-of-range NCS color coordinates. ! ! ! Definition: ! ! The NCS or "natural color system" describes a color based on: ! * C1 and C2, two elementary colors from the sequence RYGB or ! C2 = blank for a pure elementary color, or ! C1 = N, C2 = blank for a neutral color); ! * N, the percentage of C2; ! * C, the colorfulness or strength, as a percentage; ! * S, the blackness as a percentage. ! ! The scant documentation I have seen claims that the percentages are ! always less than 100. I don't see why, and for now I'll let them ! lie between 0 and 100. The NCS designation for a color has the form ! "CCSS C1NC2". ! ! Examples: ! ! C1 C2 N C S Designation ! -- -- -- --- --- ----------- ! Black ( N * 0 0 100 ) 0099 N ! Blue ( B * 0 100 0 ) 9900 B ! Cyan ( G B 50 100 0 ) 9900 G50B ! Green ( G * 0 100 0 ) 9900 G ! Magenta ( B R 50 100 0 ) 9900 B50R ! Orange ( R Y 50 100 0 ) 9900 R50Y ! Red ( R * 0 100 0 ) 9900 R ! White ( N * 0 0 0 ) 0000 N ! Yellow ( Y * 0 100 0 ) 9900 Y ! ! Modified: ! ! 16 February 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, character C1, C2, integer N, C, S, the NCS color ! coordinates to be checked. If the color information is very ! bad, it is replaced by the designation for black. ! implicit none ! integer c character c1 character c2 integer n integer s ! ! Replace C1 by its capitalized value. ! call ch_upper ( c1 ) ! ! We're expecting only the values R, Y, G, B, and possibly N (for neutral). ! if ( c1 == 'R' .or. c1 == 'Y' .or. c1 == 'G' .or. c1 == 'B' ) then else if ( c1 == 'N' .and. c2 == ' ' .and. c == 0 ) then else c1 = 'N' c2 = ' ' n = 0 c = 0 s = 100 return end if ! ! Replace C2 by its capitalized value. ! C2 may be blank, but then N should be 0. ! call ch_upper ( c2 ) ! ! We're expecting only the values R, Y, G, B and blank. ! if ( c2 == 'R' .or. c2 == 'Y' .or. c2 == 'G' .or. c2 == 'B' ) then else if ( c2 == ' ' .and. n == 0 ) then else c1 = 'N' c2 = ' ' n = 0 c = 0 s = 100 return end if ! ! If necessary, swap the colors so they have a preferred order. ! if ( c1 == 'Y' .and. c2 == 'R' ) then c1 = 'R' c2 = 'Y' n = 100 - n else if ( c1 == 'G' .and. c2 == 'Y' ) then c1 = 'Y' c2 = 'G' n = 100 - n else if ( c1 == 'B' .and. c2 == 'G' ) then c1 = 'G' c2 = 'B' n = 100 - n else if ( c1 == 'R' .and. c2 == 'B' ) then c1 = 'B' c2 = 'R' n = 100 - n end if ! ! Only certain pairs of colors are allowed. ! if ( c2 == 'R' .and. c1 == 'Y' ) then else if ( c2 == 'Y' .and. c1 == 'G' ) then else if ( c2 == 'G' .and. c1 == 'B' ) then else if ( c2 == 'B' .and. c1 == 'R' ) then else if ( c2 == ' ' .and. c1 == 'N' ) then else c1 = 'N' c2 = ' ' n = 0 c = 0 s = 100 end if ! ! Only certain values of N are allowed. ! if ( n == 0 ) then c2 = ' ' else if ( n == 100 ) then c1 = c2 c2 = ' ' else if ( n < 0 ) then n = 0 else if ( n > 100 ) then n = 100 else end if ! ! Only certain values of C are allowed. ! Here, we will "repair" such values. ! if ( c < 0 ) then c = 0 else if ( c > 100 ) then c = 100 else end if ! ! Only certain values of S are allowed. ! Here, we will "repair" such values. ! if ( s < 0 ) then s = 0 else if ( s > 100 ) then s = 100 else end if ! ! C + S must be no more than 100. ! if ( c + s > 100 ) then c1 = 'N' c2 = ' ' n = 0 c = 0 s = 100 return end if return end subroutine nm_to_rgbcie ( lambda, r, g, b ) ! !******************************************************************************* ! !! NM_TO_RGBCIE returns the CIE RGB color matching functions for a given wavelength. ! ! ! Discussion: ! ! The "RGB" used here is not the "RGB" referred to in RGB monitors. Instead, ! it refers to three specific monochromatic light sources: ! ! R: red light at 700.0E+00 nanometers; ! G: green light at 546.1 nanometers; ! B: blue light at 435.8 nanometers. ! ! The relative intensities of these lights are adjusted so that ! ! 1 R + 1 G + 1 B = white. ! ! For a light emission with given spectral power distribution SPD(LAMBDA), ! the values tabulated here can be used to produce integrated RGB tristimulus ! values: ! ! rval = integral ( lambda = 380 to 760 ) ! spd(lambda) * rbar(lambda) d lambda; ! ! gval = integral ( lambda = 380 to 760 ) ! spd(lambda) * gbar(lambda) d lambda; ! ! bval = integral ( lambda = 380 to 760 ) ! spd(lambda) * bbar(lambda) d lambda. ! ! Modified: ! ! 12 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real LAMBDA, the wavelength of the monochromatic light whose ! RGB color matching functions are desired. ! ! Output, real R, G, B, the CIE RGB color matching functions for ! the monochromatic light of the given wavelength. ! implicit none ! integer, parameter :: ndat = 39 ! real b real, save, dimension ( ndat ) :: bdat = (/ & 0.00117, 0.00359, 0.01214, 0.03707, 0.11541, & 0.24769, 0.31228, 0.31670, 0.39821, 0.22991, & 0.14494, 0.08257, 0.04776, 0.02698, 0.01221, & 0.00549, 0.00146, -0.00058, 0.00130, -0.00135, & -0.00108, -0.00079, -0.00049, -0.00030, -0.00015, & -0.00008, -0.00003, -0.00001, 0.00000, 0.00000, & 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & 0.00000, 0.00000, 0.00000, 0.00000 /) real g real, save, dimension ( ndat ) :: gdat = (/ & -0.00001, -0.00004, -0.00014, -0.00041, -0.00110, & -0.00119, 0.00149, 0.00678, 0.01485, 0.02538, & 0.03914, 0.05689, 0.08536, 0.12860, 0.17468, & 0.20317, 0.21466, 0.21178, 0.19702, 0.17087, & 0.13610, 0.09754, 0.06246, 0.03557, 0.01828, & 0.00833, 0.00334, 0.00116, 0.00037, 0.00011, & 0.00003, 0.00000, 0.00000, 0.00000, 0.00000, & 0.00000, 0.00000, 0.00000, 0.00000 /) real lambda real, save, dimension ( ndat ) :: ldat = (/ & 380.0, 390.0, 400.0, 410.0, 420.0, & 430.0, 440.0, 450.0, 460.0, 470.0, & 480.0, 490.0, 500.0, 510.0, 520.0, & 530.0, 540.0, 550.0, 560.0, 570.0, & 580.0, 590.0, 600.0, 610.0, 620.0, & 630.0, 640.0, 650.0, 660.0, 670.0, & 680.0, 690.0, 700.0, 710.0, 720.0, & 730.0, 740.0, 750.0, 760.0E+00 /) real r real, save, dimension ( ndat ) :: rdat = (/ & 0.00003, 0.00010, 0.00030, 0.00084, 0.00211, & 0.00218, -0.00261, -0.01213, -0.02608, -0.03933, & -0.04939, -0.05814, -0.07173, -0.08901, -0.09264, & -0.07101, -0.03152, 0.02279, 0.09060, 0.16768, & 0.24526, 0.30928, 0.34429, 0.33971, 0.29708, & 0.22677, 0.15968, 0.10167, 0.05932, 0.03149, & 0.01687, 0.00819, 0.00410, 0.00210, 0.00105, & 0.00052, 0.00025, 0.00012, 0.00006 /) ! call interp ( ndat, lambda, ldat, r, rdat ) call interp ( ndat, lambda, ldat, g, gdat ) call interp ( ndat, lambda, ldat, b, bdat ) return end subroutine nm_to_xyz ( w, x, y, z ) ! !******************************************************************************* ! !! NM_TO_XYZ converts a light wavelength to CIE xyz chromaticities. ! ! ! Discussion: ! ! The CIE xyz chromaticities are derived from the CIE X, ! Y, Z color matching functions by the relationship: ! ! x = X / ( X + Y + Z ) ! y = Y / ( X + Y + Z ) ! z = Z / ( X + Y + Z ) ! ! Modified: ! ! 28 June 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real W, the wavelength of the pure light signal, in nanometers. ! Visible light has a wavelength between 380 nm and 780 nm. Input ! wavelengths outside this range will result in X = Y = Z = 0. ! ! Output, real X, Y, Z, the CIE xyz chromaticities. These ! lie between 0 and 1, and sum to 1. ! implicit none ! integer, parameter :: ndat = 81 ! real, save, dimension ( ndat ) :: ldat = (/ & 380.0, 385.0, 390.0, 395.0, 400.0, & 405.0, 410.0, 415.0, 420.0, 425.0, & 430.0, 435.0, 440.0, 445.0, 450.0, & 455.0, 460.0, 465.0, 470.0, 475.0, & 480.0, 485.0, 490.0, 495.0, 500.0, & 505.0, 510.0, 515.0, 520.0, 525.0, & 530.0, 535.0, 540.0, 545.0, 550.0, & 555.0, 560.0, 565.0, 570.0, 575.0, & 580.0, 585.0, 590.0, 595.0, 600.0, & 605.0, 610.0, 615.0, 620.0, 625.0, & 630.0, 635.0, 640.0, 645.0, 650.0, & 655.0, 660.0, 665.0, 670.0, 675.0, & 680.0, 685.0, 690.0, 695.0, 700.0, & 705.0, 710.0, 715.0, 720.0, 725.0, & 730.0, 735.0, 740.0, 745.0, 750.0, & 755.0, 760.0, 765.0, 770.0, 775.0, & 780.0E+00 /) real w real x real, save, dimension ( ndat ) :: xdat = (/ & 0.1741, 0.1740, 0.1738, 0.1736, 0.1733, & 0.1730, 0.1726, 0.1721, 0.1714, 0.1703, & 0.1689, 0.1669, 0.1644, 0.1611, 0.1566, & 0.1510, 0.1440, 0.1355, 0.1241, 0.1096, & 0.0913, 0.0687, 0.0454, 0.0235, 0.0082, & 0.0039, 0.0139, 0.0389, 0.0743, 0.1142, & 0.1547, 0.1929, 0.2296, 0.2658, 0.3016, & 0.3373, 0.3731, 0.4087, 0.4441, 0.4788, & 0.5125, 0.5448, 0.5752, 0.6029, 0.6270, & 0.6482, 0.6658, 0.6801, 0.6915, 0.7006, & 0.7079, 0.7140, 0.7190, 0.7230, 0.7260, & 0.7283, 0.7300, 0.7311, 0.7320, 0.7327, & 0.7334, 0.7340, 0.7344, 0.7346, 0.7347, & 0.7347, 0.7347, 0.7347, 0.7347, 0.7347, & 0.7347, 0.7347, 0.7347, 0.7347, 0.7347, & 0.7347, 0.7347, 0.7347, 0.7347, 0.7347, & 0.7347 /) real y real, save, dimension ( ndat ) :: ydat = (/ & 0.0050, 0.0050, 0.0049, 0.0049, 0.0048, & 0.0048, 0.0048, 0.0048, 0.0051, 0.0058, & 0.0069, 0.0086, 0.0109, 0.0138, 0.0177, & 0.0227, 0.0297, 0.0399, 0.0578, 0.0868, & 0.1327, 0.2007, 0.2950, 0.4127, 0.5384, & 0.6548, 0.7502, 0.8120, 0.8338, 0.8262, & 0.8059, 0.7816, 0.7543, 0.7243, 0.6923, & 0.6589, 0.6245, 0.5896, 0.5547, 0.5202, & 0.4866, 0.4544, 0.4242, 0.3965, 0.3725, & 0.3514, 0.3340, 0.3197, 0.3083, 0.2993, & 0.2920, 0.2859, 0.2809, 0.2770, 0.2740, & 0.2717, 0.2700, 0.2689, 0.2680, 0.2673, & 0.2666, 0.2660, 0.2656, 0.2654, 0.2653, & 0.2653, 0.2653, 0.2653, 0.2653, 0.2653, & 0.2653, 0.2653, 0.2653, 0.2653, 0.2653, & 0.2653, 0.2653, 0.2653, 0.2653, 0.2653, & 0.2653 /) real z real, save, dimension ( ndat ) :: zdat = (/ & 0.8209, 0.8210, 0.8213, 0.8215, 0.8219, & 0.8222, 0.8226, 0.8231, 0.8235, 0.8239, & 0.8242, 0.8245, 0.8247, 0.8251, 0.8257, & 0.8263, 0.8263, 0.8246, 0.8181, 0.8036, & 0.7760, 0.7306, 0.6596, 0.5638, 0.4534, & 0.3413, 0.2359, 0.1491, 0.0919, 0.0596, & 0.0394, 0.0255, 0.0161, 0.0099, 0.0061, & 0.0038, 0.0024, 0.0017, 0.0012, 0.0010, & 0.0009, 0.0008, 0.0006, 0.0006, 0.0005, & 0.0004, 0.0002, 0.0002, 0.0002, 0.0001, & 0.0001, 0.0001, 0.0001, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000 /) ! if ( w >= 380.0E+00 .and. w <= 780.0E+00 ) then call interp ( ndat, w, ldat, x, xdat ) call interp ( ndat, w, ldat, y, ydat ) call interp ( ndat, w, ldat, z, zdat ) else x = 0.0E+00 y = 0.0E+00 z = 0.0E+00 end if return end subroutine nm_to_xyzcap ( w, xcap, ycap, zcap ) ! !******************************************************************************* ! !! NM_TO_XYZCAP converts a light wavelength to CIE XYZ color matching functions. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Reference: ! ! Deane Judd and Gunter Wyszecki, ! Color in Business, Science, and Industry, ! Wiley, 1975, pages 126-127, 130. ! ! Modified: ! ! 28 June 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real W, the wavelength in nanometers. Visible light has ! a wavelength between 380 nm and 780 nm. Values of W outside this ! range will result in output values of XBAR = YBAR = ZBAR = 0. ! Measurements were made assuming a stimulus of one watt of pure ! light of the indicated wavelength. ! ! Output, real XCAP, YCAP, ZCAP, the CIE XYZ color matching functions. ! The values indicate the amounts of the CIE primaries X, Y and Z ! required to match the color of the stimulus light. ! implicit none ! integer, parameter :: ndat = 90 ! real w real, save, dimension ( ndat ) :: wdat = (/ & 380.0, 385.0, 390.0, 395.0, 400.0, & 405.0, 410.0, 415.0, 420.0, 425.0, & 430.0, 435.0, 440.0, 445.0, 450.0, & 455.0, 460.0, 465.0, 470.0, 475.0, & 480.0, 485.0, 490.0, 495.0, 500.0, & 505.0, 510.0, 515.0, 520.0, 525.0, & 530.0, 535.0, 540.0, 545.0, 550.0, & 555.0, 560.0, 565.0, 570.0, 575.0, & 580.0, 585.0, 590.0, 595.0, 600.0, & 605.0, 610.0, 615.0, 620.0, 625.0, & 630.0, 635.0, 640.0, 645.0, 650.0, & 655.0, 660.0, 665.0, 670.0, 675.0, & 680.0, 685.0, 690.0, 695.0, 700.0, & 705.0, 710.0, 715.0, 720.0, 725.0, & 730.0, 735.0, 740.0, 745.0, 750.0, & 755.0, 760.0, 765.0, 770.0, 775.0, & 780.0, 785.0, 790.0, 795.0, 800.0, & 805.0, 810.0, 815.0, 820.0, 825.0E+00 /) real xcap real, save, dimension ( ndat ) :: xdat = (/ & 0.0014, 0.0022, 0.0042, 0.0076, 0.0143, & 0.0232, 0.0435, 0.0776, 0.1344, 0.2148, & 0.2839, 0.3285, 0.3483, 0.3481, 0.3362, & 0.3187, 0.2908, 0.2511, 0.1954, 0.1421, & 0.0956, 0.0580, 0.0320, 0.0147, 0.0049, & 0.0024, 0.0093, 0.0291, 0.0633, 0.1096, & 0.1655, 0.2257, 0.2904, 0.3597, 0.4334, & 0.5121, 0.5945, 0.6784, 0.7621, 0.8425, & 0.9163, 0.9786, 1.0263, 1.0567, 1.0622, & 1.0456, 1.0026, 0.9384, 0.8544, 0.7514, & 0.6424, 0.5419, 0.4479, 0.3608, 0.2835, & 0.2187, 0.1649, 0.1212, 0.0874, 0.0636, & 0.0468, 0.0329, 0.0227, 0.0158, 0.0114, & 0.0081, 0.0058, 0.0041, 0.0029, 0.0020, & 0.0014, 0.0010, 0.0007, 0.0005, 0.0003, & 0.0002, 0.0002, 0.0001, 0.0001, 0.0001, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000 /) real ycap real, save, dimension ( ndat ) :: ydat = (/ & 0.0000, 0.0001, 0.0001, 0.0002, 0.0004, & 0.0006, 0.0012, 0.0022, 0.0040, 0.0073, & 0.0116, 0.0168, 0.0230, 0.0298, 0.0380, & 0.0480, 0.0600, 0.0739, 0.0910, 0.1126, & 0.1390, 0.1693, 0.2080, 0.2586, 0.3230, & 0.4073, 0.5030, 0.6082, 0.7100, 0.7932, & 0.8620, 0.9149, 0.9540, 0.9803, 0.9950, & 1.0000, 0.9950, 0.9786, 0.9520, 0.9154, & 0.8700, 0.8163, 0.7570, 0.6949, 0.6310, & 0.5668, 0.5030, 0.4412, 0.3810, 0.3210, & 0.2650, 0.2170, 0.1750, 0.1382, 0.1070, & 0.0816, 0.0610, 0.0466, 0.0320, 0.0232, & 0.0170, 0.0119, 0.0082, 0.0057, 0.0041, & 0.0029, 0.0021, 0.0015, 0.0010, 0.0007, & 0.0005, 0.0004, 0.0002, 0.0002, 0.0001, & 0.0001, 0.0001, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000 /) real zcap real, save, dimension ( ndat ) :: zdat = (/ & 0.0065, 0.0105, 0.0201, 0.0362, 0.0679, & 0.1102, 0.2074, 0.3713, 0.6456, 1.0391, & 1.3856, 1.6230, 1.7471, 1.7826, 1.7721, & 1.7441, 1.6692, 1.5281, 1.2876, 1.0419, & 0.8130, 0.6162, 0.4652, 0.3533, 0.2720, & 0.2123, 0.1582, 0.1117, 0.0782, 0.0573, & 0.0422, 0.0298, 0.0203, 0.0134, 0.0087, & 0.0057, 0.0039, 0.0027, 0.0021, 0.0018, & 0.0017, 0.0014, 0.0011, 0.0010, 0.0008, & 0.0006, 0.0003, 0.0002, 0.0002, 0.0001, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & 0.0000, 0.0000, 0.0000, 0.0000, 0.0000 /) ! if ( w >= wdat(1) .and. w <= wdat(ndat) ) then call interp ( ndat, w, wdat, xcap, xdat ) call interp ( ndat, w, wdat, ycap, ydat ) call interp ( ndat, w, wdat, zcap, zdat ) else xcap = 0.0E+00 ycap = 0.0E+00 zcap = 0.0E+00 end if return end subroutine nonlin_to_lin ( rprime, r ) ! !******************************************************************************* ! !! NONLIN_TO_LIN converts a nonlinear video signal to a linear light intensity. ! ! ! Modified: ! ! 08 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real RPRIME, the nonlinear video signal. ! ! Output, real R, the linear light intensity. ! implicit none ! real r real rprime ! if ( rprime <= -0.081E+00 ) then r = - ( ( ( 0.099E+00 - rprime ) / 1.099E+00 )**(1.0E+00/0.45E+00) ) else if ( abs ( rprime ) <= 0.081E+00 ) then r = rprime / 4.5E+00 else if ( rprime >= 0.081E+00 ) then r = ( ( 0.099E+00 + rprime ) / 1.099E+00 )**(1.0E+00/0.45E+00) end if return end function pi ( ) ! !******************************************************************************* ! !! PI returns the value of pi. ! ! ! Modified: ! ! 04 December 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, real PI, the value of pi. ! implicit none ! real pi ! pi = 3.14159265358979323846264338327950288419716939937510E+00 return end subroutine primaries_to_y ( rx, ry, gx, gy, bx, by, wx, wy, yr, yg, yb ) ! !******************************************************************************* ! !! PRIMARIES_TO_Y computes the luminance function for given primaries. ! ! ! Formula: ! ! The luminance function has the form: ! ! Y = YR * R + YG * G + YB * B ! ! Reference: ! ! David Martindale and Alan Paeth, ! Television Color Encoding and Hot Broadcast Colors, ! Graphics Gems II, edited by James Arvo, ! Academic Press, 1991, pages 147-158. ! ! Modified: ! ! 27 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real RX, RY, the xy chromaticities of the R primary. ! ! Input, real GX, GY, the xy chromaticities of the G primary. ! ! Input, real BX, BY, the xy chromaticities of the B primary. ! ! Input, real WX, WY, the xy chromaticities of the reference white. ! ! Output, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! implicit none ! integer, parameter :: n = 3 integer, parameter :: nrhs = 1 ! real a(n,n+nrhs) real bx real by real gx real gy integer info real rx real ry real wx real wy real yb real yg real yr ! ! Set up the coefficients and right hand side of the linear system. ! a(1,1) = rx a(1,2) = gx a(1,3) = bx a(1,4) = wx / wy a(2,1) = ry a(2,2) = gy a(2,3) = by a(2,4) = wy / wy a(3,1) = 1.0E+00 - rx - ry a(3,2) = 1.0E+00 - gx - gy a(3,3) = 1.0E+00 - bx - by a(3,4) = ( 1.0E+00 - wx - wy ) / wy ! ! Solve the linear system A * x = b. ! call rmat_solve ( a, n, nrhs, info ) ! ! Extract the solution. ! if ( info == 0 ) then yr = a(1,4) * ry yg = a(2,4) * gy yb = a(3,4) * by else yr = 0.0E+00 yg = 0.0E+00 yb = 0.0E+00 end if return end function r_cubert ( x ) ! !******************************************************************************* ! !! R_CUBERT returns the cube root of a real number. ! ! ! Discussion: ! ! R_CUBERT is designed to avoid the possible problems that can occur ! when formulas like 0.0**(1/3) or (-1.0)**(1/3) are to be evaluated. ! ! Modified: ! ! 01 March 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real X, the number whose cube root is desired. ! ! Output, real R_CUBERT, the cube root of X. ! implicit none ! real r_cubert real x ! if ( x > 0.0E+00 ) then r_cubert = x**(1.0E+00/3.0E+00) else if ( x == 0.0E+00 ) then r_cubert = 0.0E+00 else r_cubert = - ( abs ( x ) )**(1.0E+00/3.0E+00) end if return end function r_modp ( x, y ) ! !******************************************************************************* ! !! R_MODP returns the nonnegative remainder of real division. ! ! ! Formula: ! ! If ! REM = R_MODP ( X, Y ) ! RMULT = ( X - REM ) / Y ! then ! X = Y * RMULT + REM ! where REM is always nonnegative. ! ! Comments: ! ! The MOD function computes a result with the same sign as the ! quantity being divided. Thus, suppose you had an angle A, ! and you wanted to ensure that it was between 0 and 360. ! Then mod(A,360.0) would do, if A was positive, but if A ! was negative, your result would be between -360 and 0. ! ! On the other hand, R_MODP(A,360.0) is between 0 and 360, always. ! ! Examples: ! ! I J MOD R_MODP R_MODP Factorization ! ! 107 50 7 7 107 = 2 * 50 + 7 ! 107 -50 7 7 107 = -2 * -50 + 7 ! -107 50 -7 43 -107 = -3 * 50 + 43 ! -107 -50 -7 43 -107 = 3 * -50 + 43 ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real X, the number to be divided. ! ! Input, real Y, the number that divides X. ! ! Output, real R_MODP, the nonnegative remainder when X is divided by Y. ! implicit none ! real r_modp real x real y ! if ( y == 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'R_MODP - Fatal error!' write ( *, '(a,g14.6)' ) ' R_MODP ( X, Y ) called with Y = ', y stop end if r_modp = mod ( x, y ) if ( r_modp < 0.0E+00 ) then r_modp = r_modp + abs ( y ) end if return end subroutine r_random ( rlo, rhi, r ) ! !******************************************************************************* ! !! R_RANDOM returns a random real in a given range. ! ! ! Modified: ! ! 23 September 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real RLO, RHI, the minimum and maximum values. ! ! Output, real R, the randomly chosen value. ! implicit none ! real r real rhi real rlo logical, save :: seed = .false. real t ! if ( .not. seed ) then call random_seed seed = .true. end if ! ! Pick a random number in (0,1). ! call random_number ( harvest = t ) ! ! Set R. ! r = ( 1.0E+00 - t ) * rlo + t * rhi return end function radians_to_degrees ( angle ) ! !******************************************************************************* ! !! RADIANS_TO_DEGREES converts an angle from radians to degrees. ! ! ! Modified: ! ! 10 July 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real ANGLE, an angle in radians. ! ! Output, real RADIANS_TO_DEGREES, the equivalent angle ! in degrees. ! implicit none ! real angle real radians_to_degrees real, parameter :: pi = 3.14159265358979323846264338327950288419716939937510E+00 ! radians_to_degrees = ( angle / pi ) * 180.0E+00 return end subroutine rgb709_to_xyz ( r, g, b, xcap, ycap, zcap ) ! !******************************************************************************* ! !! RGB709_TO_XYZ converts RGB709 to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 06 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB 709 color coordinates to be converted. ! ! Output, real XCAP, YCAP, ZCAP, the corresponding CIE XYZ color coordinates. ! implicit none ! real b real g real r real xcap real ycap real zcap ! xcap = 0.412453E+00 * r + 0.35758E+00 * g + 0.180423E+00 * b ycap = 0.212671E+00 * r + 0.71516E+00 * g + 0.072169E+00 * b zcap = 0.019334E+00 * r + 0.119193E+00 * g + 0.950227E+00 * b return end subroutine rgb_check ( r, g, b ) ! !******************************************************************************* ! !! RGB_CHECK corrects out-of-range RGB color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Examples: ! ! Black ( 0.0, 0.0, 0.0E+00 ) ! Blue ( 0.0, 0.0, 1.0E+00 ) ! Cyan ( 0.0, 1.0, 1.0E+00 ) ! Green ( 0.0, 1.0, 0.0E+00 ) ! Magenta ( 1.0, 0.0, 1.0E+00 ) ! Red ( 1.0, 0.0, 0.0E+00 ) ! White ( 1.0, 1.0, 1.0E+00 ) ! Yellow ( 1.0, 1.0, 0.0E+00 ) ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 25 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real R, G, B, the RGB color coordinates to be checked. ! Any coordinate less than 0 is set to 0, and any coordinate greater ! than 1 is set to 1. ! implicit none ! real b real g real r ! r = max ( r, 0.0E+00 ) r = min ( r, 1.0E+00 ) g = max ( g, 0.0E+00 ) g = min ( g, 1.0E+00 ) b = max ( b, 0.0E+00 ) b = min ( b, 1.0E+00 ) return end subroutine rgb_test ( itest, rtest, gtest, btest ) ! !******************************************************************************* ! !! RGB_TEST supplies RGB values for tests. ! ! ! Modified: ! ! 17 February 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ITEST, the index of the test, between 1 and 8. ! ! Output, real RTEST, GTEST, BTEST, sample RGB color coordinate ! values for testing. ! implicit none ! real btest real gtest integer itest real rtest ! if ( itest == 1 ) then rtest = 0.9E+00 gtest = 0.0E+00 btest = 0.0E+00 else if ( itest == 2 ) then rtest = 0.0E+00 gtest = 0.8E+00 btest = 0.0E+00 else if ( itest == 3 ) then rtest = 0.0E+00 gtest = 0.0E+00 btest = 0.7E+00 else if ( itest == 4 ) then rtest = 0.0E+00 gtest = 0.6E+00 btest = 0.6E+00 else if ( itest == 5 ) then rtest = 0.5E+00 gtest = 0.0E+00 btest = 0.5E+00 else if ( itest == 6 ) then rtest = 0.4E+00 gtest = 0.4E+00 btest = 0.0E+00 else if ( itest == 7 ) then rtest = 0.3E+00 gtest = 0.3E+00 btest = 0.3E+00 else if ( itest == 8 ) then rtest = 0.0E+00 gtest = 0.0E+00 btest = 0.0E+00 else if ( itest == 9 ) then rtest = 0.1E+00 gtest = 0.3E+00 btest = 0.5E+00 else if ( itest == 10 ) then rtest = 0.3E+00 gtest = 0.5E+00 btest = 0.3E+00 else write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'RGB_TEST - Fatal error!' write ( *, '(a,i6)' ) ' No such test number ITEST = ', itest stop end if return end subroutine rgb_to_cmy ( r, g, b, c, m, y ) ! !******************************************************************************* ! !! RGB_TO_CMY converts RGB to CMY color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! The CMY color system describes a color based on the amounts of the ! base colors cyan, magenta, and yellow. Thus, a particular color ! has three coordinates, (C,M,Y). Each coordinate must be between ! 0 and 1. Black is (1,1,1) and white is (0,0,0). ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Output, real C, M, Y, the corresponding CMY color coordinates. ! implicit none ! real b real c real g real m real r real y ! c = 1.0E+00 - r m = 1.0E+00 - g y = 1.0E+00 - b return end subroutine rgb_to_cmyk ( r, g, b, c, m, y, k ) ! !******************************************************************************* ! !! RGB_TO_CMYK converts RGB to CMYK color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! The CMYK color system describes a color based on the amounts of the ! base colors cyan, magenta, yellow, and black. The CMYK system is ! based on the CMY system, except that equal amounts of C, M, and Y ! are replaced by the single color K. Thus, a particular color ! has four coordinates, (C,M,Y,K). Each coordinate must be between ! 0 and 1, and it must also be true that C+K, M+K and Y+K are ! each no greater than 1. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 30 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Output, real C, M, Y, K, the corresponding CMYK color coordinates. ! implicit none ! real b real c real g real k real m real r real y ! ! Compute the CMY equivalent colors. ! c = 1.0E+00 - r m = 1.0E+00 - g y = 1.0E+00 - b ! ! Compute the black component. ! k = min ( c, m, y ) ! ! Subtract off the black component to complete the CMYK specification. ! c = c - k m = m - k y = y - k return end subroutine rgb_to_hls ( r, g, b, h, l, s ) ! !******************************************************************************* ! !! RGB_TO_HLS converts RGB to HLS color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! The HLS color system describes a color based on the qualities of ! hue, lightness, and saturation. A particular color has three ! coordinates, (H,L,S). The L and S coordinates must be between ! 0 and 1, while the H coordinate must be between 0 and 360, and ! is interpreted as an angle. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Output, real H, L, S, the corresponding HLS color coordinates. ! implicit none ! real b real bc real g real gc real h real l real r real rc real rgbmax real rgbmin real r_modp real s ! ! Compute lightness. ! rgbmax = max ( r, g, b ) rgbmin = min ( r, g, b ) l = ( rgbmax + rgbmin ) / 2.0E+00 ! ! Compute saturation. ! if ( rgbmax == rgbmin ) then s = 0.0E+00 else if ( l <= 0.5E+00 ) then s = ( rgbmax - rgbmin ) / ( rgbmax + rgbmin ) else s = ( rgbmax - rgbmin ) / ( 2.0E+00 - rgbmax - rgbmin ) end if end if ! ! Compute the hue. ! if ( rgbmax == rgbmin ) then h = 0.0E+00 else rc = ( rgbmax - r ) / ( rgbmax - rgbmin ) gc = ( rgbmax - g ) / ( rgbmax - rgbmin ) bc = ( rgbmax - b ) / ( rgbmax - rgbmin ) if ( r == rgbmax ) then h = bc - gc else if ( g == rgbmax ) then h = 2.0E+00 + rc - bc else h = 4.0E+00 + gc - rc end if h = h * 60.0E+00 ! ! Make sure H lies between 0 and 360.0. ! h = r_modp ( h, 360.0E+00 ) end if return end subroutine rgb_to_hsv ( r, g, b, h, s, v ) ! !******************************************************************************* ! !! RGB_TO_HSV converts RGB to HSV color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! The HSV color system describes a color based on the three qualities ! of hue, saturation, and value. A given color will be represented ! by three numbers, (H,S,V). H, the value of hue, is an angle ! between 0 and 360 degrees, with 0 representing red. S is the ! saturation, and is between 0 and 1. Finally, V is the "value", ! a measure of brightness, which goes from 0 for black, increasing ! to a maximum of 1 for the brightest colors. The HSV color system ! is sometimes also called HSB, where the B stands for brightness. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 29 August 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Output, real H, S, V, the corresponding HSV color coordinates. ! implicit none ! real b real bc real g real gc real h real r real rc real rgbmax real rgbmin real r_modp real s real v ! rgbmax = max ( r, g, b ) rgbmin = min ( r, g, b ) v = rgbmax ! ! Compute the saturation. ! if ( rgbmax /= 0.0E+00 ) then s = ( rgbmax - rgbmin ) / rgbmax else s = 0.0E+00 end if ! ! Compute the hue. ! if ( s == 0.0E+00 ) then h = 0.0E+00 else rc = ( rgbmax - r ) / ( rgbmax - rgbmin ) gc = ( rgbmax - g ) / ( rgbmax - rgbmin ) bc = ( rgbmax - b ) / ( rgbmax - rgbmin ) if ( r == rgbmax ) then h = bc - gc else if ( g == rgbmax ) then h = 2.0E+00 + rc - bc else h = 4.0E+00 + gc - rc end if h = h * 60.0E+00 ! ! Make sure H lies between 0 and 360.0E+00 ! h = r_modp ( h, 360.0E+00 ) end if return end subroutine rgb_to_hue ( r, g, b, h ) ! !******************************************************************************* ! !! RGB_TO_HUE converts (R,G,B) colors to a hue value between 0 and 1. ! ! ! Discussion: ! ! The hue computed here should be the same as the H value computed ! for HLS and HSV, except that it ranges from 0 to 1 instead of ! 0 to 360. ! ! A monochromatic color ( white, black, or a shade of gray) does not ! have a hue. This routine will return a special value of H = -1 ! for such cases. ! ! Examples: ! ! Color R G B H ! ! red 1.0 0.0 0.0 0.00 ! yellow 1.0 1.0 0.0 0.16 ! green 0.0 1.0 0.0 0.33 ! cyan 0.0 1.0 1.0 0.50 ! blue 0.0 0.0 1.0 0.67 ! magenta 1.0 0.0 1.0 0.83 ! ! black 0.0 0.0 0.0 -1.00 ! gray 0.5 0.5 0.5 -1.00 ! white 1.0 1.0 1.0 -1.00 ! ! Modified: ! ! 25 March 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the red, green and blue values of the color. ! These values should be between 0 and 1. ! ! Output, real H, the corresponding hue of the color, or -1.0E+00 if ! the color is monochromatic. ! implicit none ! real b real b2 real g real g2 real h real r real r2 real rgbmax real rgbmin ! ! Make sure the colors are between 0 and 1. ! r2 = min ( max ( r, 0.0E+00 ), 1.0E+00 ) g2 = min ( max ( g, 0.0E+00 ), 1.0E+00 ) b2 = min ( max ( b, 0.0E+00 ), 1.0E+00 ) ! ! Compute the minimum and maximum of R, G and B. ! rgbmax = r2 rgbmax = max ( rgbmax, g2 ) rgbmax = max ( rgbmax, b2 ) rgbmin = r2 rgbmin = min ( rgbmin, g2 ) rgbmin = min ( rgbmin, b2 ) ! ! If RGBMAX = RGBMIN, then the color has no hue. ! if ( rgbmax == rgbmin ) then h = - 1.0E+00 ! ! Otherwise, we need to determine the dominant color. ! else if ( r2 == rgbmax ) then h = ( g2 - b2 ) / ( rgbmax - rgbmin ) else if ( g2 == rgbmax ) then h = 2.0E+00 + ( b2 - r2 ) / ( rgbmax - rgbmin ) else if ( b2 == rgbmax ) then h = 4.0E+00 + ( r2 - g2 ) / ( rgbmax - rgbmin ) end if h = h / 6.0E+00 ! ! Make sure H lies between 0 and 1.0. ! if ( h < 0.0E+00 ) then h = h + 1.0E+00 else if ( h > 1.0E+00 ) then h = h - 1.0E+00 end if end if return end subroutine rgb_to_name ( r, g, b, name ) ! !******************************************************************************* ! !! RGB_TO_NAME converts RGB colors to the name of the nearest color. ! ! ! Discussion: ! ! The names and information are read from the file "COLORS.TXT", a ! modified version of the X Windows color data file "RGB.TXT". ! ! Modified: ! ! 19 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB coordinates of the color. ! ! Output, character ( len = * ) NAME, the name of the color that is the ! "closest" to the given RGB coordinates. ! implicit none ! real b real bcolor character ( len = 20 ) :: color_file = 'colors.txt' real dismin real dist logical first real g real gcolor integer ib integer ig integer ios integer ir integer iunit character ( len = * ) name character ( len = 30 ) namecolor real r real rcolor ! first = .true. call get_unit ( iunit ) open ( unit = iunit, file = color_file, status = 'old', iostat = ios ) if ( ios /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'RGB_TO_NAME - Fatal error!' write ( *, '(a)' ) ' Could not open the color name file:' write ( *, '(a)' ) trim ( color_file ) stop end if do read ( iunit, '(a30,i3,1x,i3,1x,i3,1x,f9.4,1x,f9.4,1x,f9.4)', & iostat = ios ) namecolor, ir, ig, ib, rcolor, gcolor, bcolor if ( ios /= 0 ) then exit end if dist = sqrt ( ( r - rcolor )**2 + ( g - gcolor ) **2 + ( b - bcolor ) **2 ) if ( first ) then dismin = dist name = namecolor first = .false. else if ( dist < dismin ) then dismin = dist name = namecolor end if if ( dismin == 0.0E+00 ) then exit end if end do close ( unit = iunit ) return end subroutine rgb_to_rgbprime ( r, g, b, rprime, gprime, bprime ) ! !******************************************************************************* ! !! RGB_TO_RGBPRIME converts RGB to R'G'B' color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! The R'G'B' color system is a nonlinear video signal measurement. ! Each coordinate must be between 0 and 1. ! ! Modified: ! ! 07 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Output, real RPRIME, GPRIME, BPRIME, the corresponding R'G'B' color ! coordinates. ! implicit none ! real b real bprime real g real gprime real r real rprime ! call lin_to_nonlin ( r, rprime ) call lin_to_nonlin ( g, gprime ) call lin_to_nonlin ( b, bprime ) return end subroutine rgb_to_ycbcr ( r, g, b, yr, yg, yb, yprime, cb, cr ) ! !******************************************************************************* ! !! RGB_TO_YCBCR converts RGB to Y'CbCr color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! The Y'CbCr color system is used in digital television signals. ! The Y' component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, while Cb and Cr should be between -0.5 and 0.5. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real YPRIME, CB, CR, the corresponding Y'CbCr color coordinates. ! implicit none ! real b real cb real cr real g real r real yb real yg real yprime real yr ! yprime = yr * r + yg * g + yb * b cb = 0.5E+00 * ( b - yprime ) / ( 1.0E+00 - yb ) cr = 0.5E+00 * ( r - yprime ) / ( 1.0E+00 - yr ) return end subroutine rgb_to_yiq ( r, g, b, yr, yg, yb, yprime, i, q ) ! !******************************************************************************* ! !! RGB_TO_YIQ converts RGB to Y'IQ color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Y'IQ colors are used in American NTSC commercial color television ! broadcasting. The Y' component measures luma, an approximation to ! luminance, or the amount of light. Y' is the only component ! displayed on black and white televisions. The I and Q components ! contain color information. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real YPRIME, I, Q, the corresponding Y'IQ color coordinates. ! implicit none ! real b real g real i real q real r real yb real yg real yprime real yr ! yprime = yr * r + yg * g + yb * b i = 0.7357E+00 * ( r - yprime ) - 0.2684E+00 * ( b - yprime ) q = 0.4777E+00 * ( r - yprime ) + 0.4133E+00 * ( b - yprime ) return end subroutine rgb_to_yuv ( r, g, b, yr, yg, yb, yprime, u, v ) ! !******************************************************************************* ! !! RGB_TO_YUV converts RGB to Y'UV color coordinates. ! ! ! Definition: ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Y'UV colors are used in European PAL commercial color television ! broadcasting. The Y' component measures luma, an approximation ! to the luminance, or amount of light. Y' is the only component ! displayed on black and white televisions. The U and V components ! contain color information. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the RGB color coordinates to be converted. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real YPRIME, U, V, the corresponding Y'UV color coordinates. ! implicit none ! real b real g real r real u real v real yb real yg real yprime real yr ! yprime = yr * r + yg * g + yb * b u = ( b - yprime ) / 2.029E+00 v = ( r - yprime ) / 1.140E+00 return end subroutine rgbcie_to_xyz ( r, g, b, xcap, ycap, zcap ) ! !******************************************************************************* ! !! RGBCIE_TO_XYZ converts CIE RGB to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE RGB color coordinates were based on color matching data ! using three primaries, labeled R, G, and B, associated with ! monochromatic light at the wavelengths of 700, 546.1, and 435.8 ! nanometers. However, this set or primaries was found unsatisfactory ! to use as the basis for color representation, since the ! representation of some colors required negative coefficients. ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Reference: ! ! Jonas Gomes and Luiz Velho, ! Image Processing for Computer Graphics, ! Springer, 1997. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real R, G, B, the CIE RGB color coordinates to be converted. ! ! Output, real XCAP, YCAP, ZCAP, the corresponding CIE XYZ color coordinates. ! implicit none ! real b real g real r real xcap real ycap real zcap ! xcap = 0.489989E+00 * r + 0.310008E+00 * g + 0.20E+00 * b ycap = 0.176962E+00 * r + 0.81240E+00 * g + 0.01E+00 * b zcap = 0.0E+00 * r + 0.01E+00 * g + 0.99E+00 * b return end subroutine rgbprime_to_lcc ( rprime, gprime, bprime, yr, yg, yb, luma, & chroma1, chroma2 ) ! !******************************************************************************* ! !! RGBPRIME_TO_LCC converts R'G'B' to LCC color coordinates. ! ! ! Definition: ! ! The R'G'B' color system is a nonlinear video signal measurement. ! Each coordinate must be between 0 and 1. ! ! The LCC color coordinate system records a color as three components, ! Luma, Chroma1 and Chroma2. The LCC color coordinates are used ! in an intermediate calculation of the PhotoYCC color coordinates. ! Luma is scaled luminance, Chroma1 is (B'-Luma) and Chroma2 is (R'-Luma). ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real RPRIME, GPRIME, BPRIME, the R'G'B' color coordinates. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real LUMA, CHROMA1, CHROMA2, the corresponding LCC color ! coordinates. ! implicit none ! real chroma1 real chroma2 real bprime real gprime real luma real rprime real yb real yg real yprime real yr ! yprime = yr * rprime + yg * gprime + yb * bprime luma = yprime chroma1 = bprime - luma chroma2 = rprime - luma return end subroutine rgbprime_to_rgb ( rprime, gprime, bprime, r, g, b ) ! !******************************************************************************* ! !! RGBPRIME_TO_RGB converts R'G'B' to RGB color coordinates. ! ! ! Definition: ! ! The R'G'B' color system is a nonlinear video signal measurement. ! Each coordinate must be between 0 and 1. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Modified: ! ! 07 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real RPRIME, GPRIME, BPRIME, the R'G'B' color coordinates. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real bprime real g real gprime real r real rprime ! call nonlin_to_lin ( rprime, r ) call nonlin_to_lin ( gprime, g ) call nonlin_to_lin ( bprime, b ) return end subroutine rmat_solve ( a, n, nrhs, info ) ! !******************************************************************************* ! !! RMAT_SOLVE uses Gauss-Jordan elimination to solve an N by N linear system. ! ! ! Modified: ! ! 30 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real A(N,N+NRHS), contains in rows and columns 1 ! to N the coefficient matrix, and in columns N+1 through ! N+NRHS, the right hand sides. On output, the coefficient matrix ! area has been destroyed, while the right hand sides have ! been overwritten with the corresponding solutions. ! ! Input, integer NRHS, the number of right hand sides. NRHS ! must be at least 0. ! ! Output, integer INFO, singularity flag. ! 0, the matrix was not singular, the solutions were computed; ! J, factorization failed on step J, and the solutions could not ! be computed. ! implicit none ! integer n integer nrhs ! real a(n,n+nrhs) real apivot real factor integer i integer info integer ipivot integer j integer k real temp ! info = 0 do j = 1, n ! ! Choose a pivot row. ! ipivot = j apivot = a(j,j) do i = j+1, n if ( abs ( a(i,j) ) > abs ( apivot ) ) then apivot = a(i,j) ipivot = i end if end do if ( apivot == 0.0E+00 ) then info = j return end if ! ! Interchange. ! do i = 1, n + nrhs call r_swap ( a(ipivot,i), a(j,i) ) end do ! ! A(J,J) becomes 1. ! a(j,j) = 1.0E+00 do k = j+1, n + nrhs a(j,k) = a(j,k) / apivot end do ! ! A(I,J) becomes 0. ! do i = 1, n if ( i /= j ) then factor = a(i,j) a(i,j) = 0.0E+00 do k = j+1, n + nrhs a(i,k) = a(i,k) - factor * a(j,k) end do end if end do end do return end subroutine r_swap ( x, y ) ! !******************************************************************************* ! !! R_SWAP switches two real values. ! ! ! Modified: ! ! 01 May 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real X, Y. On output, the values of X and ! Y have been interchanged. ! implicit none ! real x real y real z ! z = x x = y y = z return end subroutine s_c_delete ( s, c ) ! !******************************************************************************* ! !! S_C_DELETE removes all occurrences of a character from a string. ! ! ! Discussion: ! ! Each time the given character is found in the string, the characters ! to the right of the string are shifted over one position. ! ! Modified: ! ! 28 June 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, character ( len = * ) S, the string to be transformed. ! ! Input, character C, the character to be removed. ! implicit none ! character c integer iget integer iput integer nchar character ( len = * ) s ! nchar = len_trim ( s ) iput = 1 do iget = 1, nchar if ( s(iget:iget) == c ) then else if ( iput == iget ) then iput = iput + 1 else s(iput:iput) = s(iget:iget) iput = iput + 1 end if end do s(iput:nchar) = ' ' return end function s_eqi ( s1, s2 ) ! !******************************************************************************* ! !! S_EQI is a case insensitive comparison of two strings for equality. ! ! ! Examples: ! ! S_EQI ( 'Anjana', 'ANJANA' ) is .TRUE. ! ! Modified: ! ! 14 April 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S1, S2, the strings to compare. ! ! Output, logical S_EQI, the result of the comparison. ! implicit none ! character c1 character c2 integer i integer len1 integer len2 integer lenc logical s_eqi character ( len = * ) s1 character ( len = * ) s2 ! len1 = len ( s1 ) len2 = len ( s2 ) lenc = min ( len1, len2 ) s_eqi = .false. do i = 1, lenc c1 = s1(i:i) c2 = s2(i:i) call ch_cap ( c1 ) call ch_cap ( c2 ) if ( c1 /= c2 ) then return end if end do do i = lenc + 1, len1 if ( s1(i:i) /= ' ' ) then return end if end do do i = lenc + 1, len2 if ( s2(i:i) /= ' ' ) then return end if end do s_eqi = .true. return end subroutine srgb_to_xyz ( sr, sg, sb, xcap, ycap, zcap ) ! !******************************************************************************* ! !! SRGB_TO_XYZ converts sRGB to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The sRGB color space is based on the monitor characteristics expected ! in a dimly lit office. ! ! Reference: ! ! International Electrotechnical Commission, ! Standard IEC 61966-2-1 ! ! http://www.srgb.com ! ! Modified: ! ! 07 March 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer SR, SG, SB, the sRGB color coordinates to be converted. ! ! Output, real XCAP, YCAP, ZCAP, the corresponding CIE XYZ color coordinates. ! implicit none ! real b real b_prime real g real g_prime real, parameter :: power = 2.4E+00 real r real r_prime integer sb integer sg integer sr real xcap real ycap real zcap ! r_prime = real ( sr ) / 255.0E+00 g_prime = real ( sg ) / 255.0E+00 b_prime = real ( sb ) / 255.0E+00 if ( r_prime <= 0.04045E+00 ) then r = r_prime / 12.92E+00 else r = ( ( r_prime + 0.055E+00 ) / 1.055E+00 )**power end if if ( g_prime <= 0.04045E+00 ) then g = g_prime / 12.92E+00 else g = ( ( g_prime + 0.055E+00 ) / 1.055E+00 )**power end if if ( b_prime <= 0.04045E+00 ) then b = b_prime / 12.92E+00 else b = ( ( b_prime + 0.055E+00 ) / 1.055E+00 )**power end if xcap = 0.4124E+00 * r + 0.3576E+00 * g + 0.1805E+00 * b ycap = 0.2126E+00 * r + 0.7152E+00 * g + 0.0722E+00 * b zcap = 0.0193E+00 * r + 0.1192E+00 * g + 0.9505E+00 * b return end subroutine t_to_spd ( t, lambda, power ) ! !******************************************************************************* ! !! T_TO_SPD evaluates the black body power spectrum at a given temperature. ! ! ! Definition: ! ! Planck's law gives the spectral power distribution function of ! radiation from a black body, per unit volume per infinitesimal ! increment of wavelength, as: ! ! SPD(Lambda,T) ! = 1/Volume * dPower / dLambda ! = 8 * Pi * H * C / ! ( (10**(-9))**4 * Lambda**5 * ( EXP ( P ) - 1 ) ) ! ! where ! ! P = H * C / ( ( Lambda * 10**(-9) ) * K * T ); ! Lambda = Wavelength, in nanometers; ! T = Temperature of the black body, in degrees Kelvin; ! H = Planck's constant, in joule-seconds; ! C = Speed of light, in meters/second; ! K = Boltzmann's constant, in joules / degrees Kelvin; ! Volume = Volume of the cavity, in cubic meters. ! ! Modified: ! ! 12 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real T, the temperature, in degrees Kelvin, of the black body. ! ! Input, real LAMBDA, the wavelength, in nanometers, at which the ! spectral power distribution function (SPD) is to be evaluated. ! ! Output, real POWER, the black body spectral power distribution ! function at the given temperature and wavelength, per volume, ! per wavelength. The units are ( 1 / Meter**3 ) * Joules / Nanometer, ! that is, 1/Volume * ( Energy Increment / Wavelength Increment ). ! implicit none ! real, parameter :: c = 2.9979246E+08 real expon real, parameter :: h = 6.626176E-34 real, parameter :: k = 1.38066E-23 real lambda real, parameter :: nmtom = 1.0E-09 real pi real power real t ! expon = h * c / ( nmtom * lambda * k * t ) power = 8.0E+00 * pi ( ) * h * c / & ( nmtom**4 * lambda**5 * ( exp ( expon ) - 1.0E+00 ) ) return end subroutine t_to_xyz ( t, x, y, z ) ! !******************************************************************************* ! !! T_TO_XY returns CIE xyz chromaticities for black body radiation. ! ! ! Definition: ! ! The CIE xyz system defines a color in terms of its normalized ! chromaticities (x,y,z), without reference to the absolute strength ! or luminance of the color. ! ! Reference: ! ! Guenter Wyszecki and W Stiles, ! Color Science, Concepts and Methods, Quantitative Data and Formulas, ! John Wiley, 1967, page 48. ! ! Modified: ! ! 28 June 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real T, the temperature, in degrees Kelvin, of the black ! body. Data is only available for T in the range of 1,000 to 30,000 ! degrees. Input values of T outside this range will result in ! output values of X and Y at the nearest endpoint of the data range. ! ! Output, real X, Y, Z, the CIE xyz chromaticities of the black ! body radiation. ! implicit none ! integer, parameter :: ndat = 53 ! real t real, save, dimension ( ndat ) :: tdat = (/ & 1000.0, 1200.0, 1400.0, 1500.0, 1600.0, & 1700.0, 1800.0, 1900.0, 2000.0, 2100.0, & 2200.0, 2300.0, 2400.0, 2500.0, 2600.0, & 2700.0, 2800.0, 2900.0, 3000.0, 3100.0, & 3200.0, 3300.0, 3400.0, 3500.0, 3600.0, & 3700.0, 3800.0, 3900.0, 4000.0, 4100.0, & 4200.0, 4300.0, 4400.0, 4500.0, 4600.0, & 4700.0, 4800.0, 4900.0, 5000.0, 5200.0, & 5400.0, 5600.0, 5800.0, 6000.0, 6500.0, & 7000.0, 7500.0, 8000.0, 8500.0, 9000.0, & 10000.0, 15000.0, 30000.0E+00 /) real x real, save, dimension ( ndat ) :: xdat = (/ & 0.6526, 0.6249, 0.5984, 0.5856, 0.5731, & 0.5610, 0.5491, 0.5377, 0.5266, 0.5158, & 0.5055, 0.4956, 0.4860, 0.4769, 0.4681, & 0.4597, 0.4517, 0.4441, 0.4368, 0.4299, & 0.4233, 0.4170, 0.4109, 0.4052, 0.3997, & 0.3945, 0.3896, 0.3848, 0.3804, 0.3760, & 0.3719, 0.3680, 0.3643, 0.3607, 0.3573, & 0.3540, 0.3509, 0.3479, 0.3450, 0.3397, & 0.3347, 0.3301, 0.3259, 0.3220, 0.3135, & 0.3063, 0.3003, 0.2952, 0.2908, 0.2869, & 0.2806, 0.2637, 0.2501 /) real y real, save, dimension ( ndat ) :: ydat = (/ & 0.3446, 0.3676, 0.3859, 0.3932, 0.3993, & 0.4043, 0.4083, 0.4112, 0.4133, 0.4146, & 0.4152, 0.4152, 0.4147, 0.4137, 0.4123, & 0.4106, 0.4086, 0.4064, 0.4041, 0.4015, & 0.3989, 0.3962, 0.3935, 0.3907, 0.3879, & 0.3851, 0.3822, 0.3795, 0.3767, 0.3740, & 0.3713, 0.3687, 0.3660, 0.3635, 0.3610, & 0.3586, 0.3562, 0.3539, 0.3516, 0.3472, & 0.3430, 0.3391, 0.3353, 0.3318, 0.3236, & 0.3165, 0.3103, 0.3048, 0.2999, 0.2956, & 0.2883, 0.2673, 0.2489 /) real z ! if ( t < tdat(1) ) then x = xdat(1) y = ydat(1) else if ( t > tdat(ndat) ) then x = xdat(ndat) y = ydat(ndat) else call interp ( ndat, t, tdat, x, xdat ) call interp ( ndat, t, tdat, y, ydat ) end if z = 1.0E+00 - x - y return end subroutine timestamp ( ) ! !******************************************************************************* ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! ! Example: ! ! May 31 2001 9:45:54.872 AM ! ! Modified: ! ! 31 May 2001 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none ! character ( len = 8 ) ampm integer d character ( len = 8 ) date integer h integer m integer mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer n integer s character ( len = 10 ) time integer values(8) integer y character ( len = 5 ) zone ! call date_and_time ( date, time, zone, values ) y = values(1) m = values(2) d = values(3) h = values(5) n = values(6) s = values(7) mm = values(8) if ( h < 12 ) then ampm = 'AM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Midnight' else ampm = 'AM' end if end if end if write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end subroutine uvprime_to_xyz ( uprime, vprime, x, y, z ) ! !******************************************************************************* ! !! UVPRIME_TO_XYZ converts CIE u'v' to CIE xyz color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real UPRIME, VPRIME, the CIE u'v' color coordinates. ! ! Output, real X, Y, Z, the CIE xyz color coordinates. ! implicit none ! real denom real uprime real vprime real x real y real z ! denom = 6.0E+00 * uprime - 16.0E+00 * vprime + 12.0E+00 if ( denom == 0.0E+00 ) then x = 0.0E+00 y = 0.0E+00 z = 0.0E+00 else x = 9.0E+00 * uprime / denom y = 4.0E+00 * vprime / denom z = ( - 3.0E+00 * uprime - 20.0E+00 * vprime + 12.0E+00 ) / denom end if return end subroutine uvprimey_to_xyz ( uprime, vprime, xcap, ycap, zcap ) ! !******************************************************************************* ! !! UVPRIMEY_TO_XYZ converts CIE u'v'Y to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 12 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real UPRIME, VPRIME, YCAP, the CIE u'v'Y color coordinates. ! ! Output, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! implicit none ! real uprime real vprime real xcap real ycap real zcap ! xcap = 9.0E+00 * ycap * uprime / ( 4.0E+00 * vprime ) zcap = - xcap / 3.0E+00 - 5.0E+00 * ycap + 3.0E+00 * ycap / vprime return end subroutine xy_to_uvwprime ( x, y, uprime, vprime, wprime ) ! !******************************************************************************* ! !! XY_TO_UVWPRIME converts CIE xy to CIE u'v'w' color coordinates. ! ! ! Definition: ! ! The CIE xy system defines a color in terms of its normalized ! chromaticities (x,y), without reference to the absolute strength ! or luminance of the color. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real X, Y, the CIE xy color coordinates. ! ! Output, real UPRIME, VPRIME, WPRIME, the CIE u'v'w' color coordinates. ! implicit none ! real denom real uprime real vprime real wprime real x real y ! denom = - 2.0E+00 * x + 12.0E+00 * y + 3.0E+00 if ( denom == 0.0E+00 ) then uprime = 4.0E+00 vprime = 9.0E+00 wprime = 3.0E+00 else uprime = 4.0E+00 * x / denom vprime = 9.0E+00 * y / denom wprime = ( - 6.0E+00 * x + 3.0E+00 * y + 3.0E+00 ) / denom end if return end subroutine xyy_check ( x, y, ycap ) ! !******************************************************************************* ! !! XYY_CHECK corrects out-of-range CIE xyY color coordinates. ! ! ! Definition: ! ! The CIE xyY color system describes a color based on the normalized ! chromaticities (x,y), and the unnormalized CIE luminance Y. ! The luminance must be positive. The values x and y must each be ! nonnegative, and must sum to no more than 1. ! ! Modified: ! ! 04 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real X, Y, YCAP, the CIE xyY chromaticities to be checked. ! YCAP must be positive. X and Y must be nonnegative, and must sum ! to no more than 1. ! implicit none ! real sum2 real x real y real ycap ! ycap = max ( ycap, 0.0E+00 ) x = max ( x, 0.0E+00 ) y = max ( y, 0.0E+00 ) sum2 = x + y if ( sum2 > 1.0E+00 ) then x = x / sum2 y = y / sum2 end if return end subroutine xyy_to_xyz ( x, y, xcap, ycap, zcap ) ! !******************************************************************************* ! !! XYY_TO_XYZ converts CIE xyY to CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE xyY system defines a color in terms of its normalized ! chromaticities (x,y), plus the value of Y, which allows the ! normalizing factor to be determined. ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 09 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real x, y, the CIE xy chromaticities. ! ! Output, real XCAP, the CIE X color coordinate. ! ! Input, real YCAP, the CIE Y color coordinate. ! ! Output, real ZCAP, the CIE Z color coordinate. ! implicit none ! real x real xcap real y real ycap real z real zcap ! if ( ycap == 0.0E+00 ) then xcap = 0.0E+00 zcap = 0.0E+00 else xcap = x * ycap / y xcap = max ( xcap, 0.0E+00 ) z = 1.0E+00 - x - y zcap = z * ycap / y zcap = max ( zcap, 0.0E+00 ) end if return end subroutine xyz_to_lab ( xcap, ycap, zcap, xcapn, ycapn, zcapn, lstar, astar, & bstar ) ! !******************************************************************************* ! !! XYZ_TO_LAB converts CIE XYZ to CIE L*a*b* color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The CIE L*a*b* color system describes a color based on three ! qualities: L* is CIE lightness, a* and b* contain chromatic ! information. A given color will be represented by three ! numbers, (L*,a*,b*). The ranges are 0 <= L* <= 100, -500 <= a* <= 500, ! -200 <= b* <= 200. ! ! Modified: ! ! 11 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Input, real XCAPN, YCAPN, ZCAPN, the CIE XYZ color coordinates of white. ! ! Output, real LSTAR, ASTAR, BSTAR, the CIE L*a*b* color coordinates. ! implicit none ! real astar real bstar real fx real fy real fz real lstar real r_cubert real xcap real xcapn real ycap real ycapn real zcap real zcapn ! if ( xcapn == 0.0E+00 .or. ycapn == 0.0E+00 .or. zcapn == 0.0E+00 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'XYZ_TO_LAB - Fatal error!' write ( *, '(a)' ) ' XCAPN, YCAPN and ZCAPN cannot be zero.' write ( *, '(a,g14.6)' ) ' XCAPN = ', xcapn write ( *, '(a,g14.6)' ) ' YCAPN = ', ycapn write ( *, '(a,g14.6)' ) ' ZCAPN = ', zcapn stop end if ! ! Compute the CIE lightness. ! if ( ycap <= 0.0E+00 ) then lstar = 0.0E+00 else if ( ycap <= 0.008856E+00 * ycapn ) then lstar = 903.3E+00 * ycap / ycapn else if ( ycap <= ycapn ) then lstar = 116.0E+00 * r_cubert ( ycap / ycapn ) - 16.0E+00 else lstar = 100.0E+00 end if if ( xcap <= 0.008856E+00 * xcapn ) then fx = 7.787E+00 * xcap / xcapn + 16.0E+00 / 116.0E+00 else fx = r_cubert ( xcap / xcapn ) end if if ( ycap <= 0.008856E+00 * ycapn ) then fy = 7.787E+00 * ycap / ycapn + 16.0E+00 / 116.0E+00 else fy = r_cubert ( ycap / ycapn ) end if if ( zcap <= 0.008856E+00 * zcapn ) then fz = 7.787E+00 * zcap / zcapn + 16.0E+00 / 116.0E+00 else fz = r_cubert ( zcap / zcapn ) end if astar = 500.0E+00 * ( fx - fy ) bstar = 200.0E+00 * ( fy - fz ) return end subroutine xyz_to_luv ( xcap, ycap, zcap, xcapn, ycapn, zcapn, lstar, ustar, & vstar ) ! !******************************************************************************* ! !! XYZ_TO_LUV converts CIE XYZ to CIE L*u*v* color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The CIE L*u*v* color system describes a color based on three ! qualities: L* is CIE lightness, u* and v* contain chromatic ! information. A given color will be represented by three ! numbers, (L*,u*,v*). L* ranges between 0 and 100. ! ! Modified: ! ! 12 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Input, real XCAPN, YCAPN, ZCAPN, the CIE XYZ color coordinates of ! white. ! ! Output, real LSTAR, USTAR, VSTAR, the CIE L*u*v* color coordinates. ! implicit none ! real lstar real r_cubert real ustar real uprime real unprime real vstar real vprime real vnprime real wprime real wnprime real xcap real xcapn real ycap real ycapn real zcap real zcapn ! if ( ycap == 0.0E+00 ) then lstar = 0.0E+00 ustar = 0.0E+00 vstar = 0.0E+00 else ! ! Compute LSTAR, the CIE lightness from YCAP. ! if ( ycap <= 0.0E+00 ) then lstar = 0.0E+00 else if ( ycap <= 0.008856E+00 * ycapn ) then lstar = 903.3E+00 * ycap / ycapn else if ( ycap <= ycapn ) then lstar = 116.0E+00 * r_cubert ( ycap / ycapn ) - 16.0E+00 else lstar = 100.0E+00 end if ! ! Compute (un',vn') from (XCAPN,YCAPN,ZCAPN). ! call xyz_to_uvwprime ( xcapn, ycapn, zcapn, unprime, vnprime, wnprime ) ! ! Compute (u',v') from (XCAP,YCAP,ZCAP). ! call xyz_to_uvwprime ( xcap, ycap, zcap, uprime, vprime, wprime ) ! ! Compute (u*,v*) from (u',v') and (un',vn'). ! ustar = 13.0E+00 * lstar * ( uprime - unprime ) vstar = 13.0E+00 * lstar * ( vprime - vnprime ) end if return end subroutine xyz_to_rgb709 ( xcap, ycap, zcap, r, g, b ) ! !******************************************************************************* ! !! XYZ_TO_RGB709 converts CIE XYZ to RGB709 color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 06 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Output, real R, G, B, the RGB 709 color coordinates. ! implicit none ! real b real g real r real xcap real ycap real zcap ! r = 3.240479E+00 * xcap - 1.53715E+00 * ycap - 0.498535E+00 * zcap g = -0.969256E+00 * xcap + 1.875991E+00 * ycap + 0.041556E+00 * zcap b = 0.055648E+00 * xcap - 0.204043E+00 * ycap + 1.057311E+00 * zcap return end subroutine xyz_to_rgbcie ( xcap, ycap, zcap, r, g, b ) ! !******************************************************************************* ! !! XYZ_TO_RGBCIE converts CIE XYZ to CIE RGB color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The CIE RGB color coordinates were based on color matching data ! using three primaries, labeled R, G, and B, associated with ! monochromatic light at the wavelengths of 700, 546.1, and 435.8 ! nanometers. However, this set or primaries was found unsatisfactory ! to use as the basis for color representation, since the ! representation of some colors required negative coefficients. ! ! Reference: ! ! Jonas Gomes and Luiz Velho, ! Image Processing for Computer Graphics, ! Springer, 1997. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Input, real R, G, B, the CIE RGB color coordinates. ! implicit none ! real b real g real r real xcap real ycap real zcap ! r = 2.3647E+00 * xcap - 0.89658E+00 * ycap - 0.468083E+00 * zcap g = - 0.515155E+00 * xcap + 1.426409E+00 * ycap + 0.088746E+00 * zcap b = 0.005203E+00 * xcap - 0.014407E+00 * ycap + 1.0092E+00 * zcap return end subroutine xyz_to_srgb ( xcap, ycap, zcap, sr, sg, sb ) ! !******************************************************************************* ! !! XYZ_TO_SRGB converts CIE XYZ to sRGB color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The sRGB color space is based on the monitor characteristics expected ! in a dimly lit office. ! ! Reference: ! ! International Electrotechnical Commission, ! Standard IEC 61966-2-1 ! ! http://www.srgb.com ! ! Modified: ! ! 07 March 2002 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Output, integer SR, SG, SB, the sRGB color coordinates, each between 0 and 255. ! implicit none ! real b real b_prime real g real g_prime real, parameter :: rewop = 1.0E+00 / 2.4E+00 real r real r_prime integer sb integer sg integer sr real xcap real ycap real zcap ! r = 3.2406E+00 * xcap - 1.5372E+00 * ycap - 0.4986E+00 * zcap g = -0.9689E+00 * xcap + 1.8758E+00 * ycap + 0.0415E+00 * zcap b = 0.0557E+00 * xcap - 0.2040E+00 * ycap + 1.0570E+00 * zcap if ( r <= 0.0031308E+00 ) then r_prime = 12.92E+00 * r else r_prime = 1.055E+00 * r**rewop - 0.055E+00 end if if ( g <= 0.0031308E+00 ) then g_prime = 12.92E+00 * g else g_prime = 1.055E+00 * g**rewop - 0.055E+00 end if if ( b <= 0.0031308E+00 ) then b_prime = 12.92E+00 * b else b_prime = 1.055E+00 * b**rewop - 0.055E+00 end if sr = nint ( 255.0E+00 * r_prime ) sr = max ( sr, 0 ) sr = min ( sr, 255 ) sg = nint ( 255.0E+00 * g_prime ) sg = max ( sg, 0 ) sg = min ( sg, 255 ) sb = nint ( 255.0E+00 * b_prime ) sb = max ( sb, 0 ) sb = min ( sb, 255 ) return end subroutine xyz_to_uvwprime ( xcap, ycap, zcap, uprime, vprime, wprime ) ! !******************************************************************************* ! !! XYZ_TO_UVWPRIME converts CIE XYZ to CIE u'v'w' color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 12 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Output, real UPRIME, VPRIME, WPRIME, the CIE u'v'w' color coordinates. ! implicit none ! real denom real uprime real vprime real wprime real xcap real ycap real zcap ! denom = xcap + 15.0E+00 * ycap + 3.0E+00 * zcap if ( denom == 0.0E+00 ) then uprime = 4.0E+00 vprime = 9.0E+00 wprime = 3.0E+00 else uprime = 4.0E+00 * xcap / denom vprime = 9.0E+00 * ycap / denom wprime = ( - 3.0E+00 * xcap + 6.0E+00 * ycap + 3.0E+00 * zcap ) / denom end if return end subroutine xyz_to_xyy ( xcap, ycap, zcap, x, y ) ! !******************************************************************************* ! !! XYZ_TO_XYY converts CIE XYZ to CIE xyY color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The CIE xyY system defines a color in terms of its normalized ! chromaticities (x,y), plus the value of Y, which allows the ! normalizing factor to be determined. ! ! Modified: ! ! 04 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Output, real x, y, the corresponding CIE xy chromaticities. ! implicit none ! real sum2 real x real xcap real y real ycap real zcap ! sum2 = xcap + ycap + zcap if ( sum2 == 0.0E+00 ) then x = 0.0E+00 y = 0.0E+00 else x = xcap / sum2 y = ycap / sum2 end if return end subroutine xyz_to_ycc ( xcap, ycap, zcap, yr, yg, yb, yprime, c1, c2 ) ! !******************************************************************************* ! !! XYZ_TO_YCC converts CIE XYZ to PhotoYCC color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! The Kodak PhotoYCC Color Interchange Space was developed for the ! Photo CD System. The Y' coordinate is a measure of luminance, ! while C1 and C2 measure color difference chrominance. ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real YPRIME, C1, C2, the PhotoYCC color coordinates. ! implicit none ! real b real bprime real c1 real c2 real chroma1 real chroma2 real g real gprime real luma real r real rprime real xcap real xcap2 real yb real ycap real ycap2 real yg real yprime real yr real zcap real zcap2 ! ! Divide by 100.0E+00 ! xcap2 = xcap / 100.0E+00 ycap2 = ycap / 100.0E+00 zcap2 = zcap / 100.0E+00 ! ! Convert to RGB709 values. ! call xyz_to_rgb709 ( xcap2, ycap2, zcap2, r, g, b ) ! ! Convert to nonlinear values. ! call lin_to_nonlin ( r, rprime ) call lin_to_nonlin ( g, gprime ) call lin_to_nonlin ( b, bprime ) ! ! Compute Luma, Chroma1, Chroma2. ! call rgbprime_to_lcc ( rprime, gprime, bprime, yr, yg, yb, luma, chroma1, & chroma2 ) ! ! Now compute Y', C1, C2: ! call lcc_to_ycc ( luma, chroma1, chroma2, yprime, c1, c2 ) return end subroutine xyzcap_check ( xcap, ycap, zcap ) ! !******************************************************************************* ! !! XYZCAP_CHECK corrects out-of-range CIE XYZ color coordinates. ! ! ! Definition: ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Modified: ! ! 09 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates ! to be checked. ! implicit none ! real xcap real ycap real zcap ! xcap = max ( xcap, 0.0E+00 ) ycap = max ( ycap, 0.0E+00 ) zcap = max ( zcap, 0.0E+00 ) return end subroutine ycbcr_check ( yprime, cb, cr ) ! !******************************************************************************* ! !! YCBCR_CHECK corrects out-of-range Y'CbCr color coordinates. ! ! ! Definition: ! ! The Y'CbCr color system is used in digital television signals. ! The Y component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, while Cb and Cr should be between -0.5 and 0.5. ! ! Examples: ! ! Black ( 0.000 0.000 0.000 ) ! Blue ( 0.114 0.500 0.081 ) ! Cyan ( 0.701 0.169 -0.337 ) ! Green ( 0.587 -0.331 -0.419 ) ! Magenta ( 0.413 0.669 0.581 ) ! Red ( 0.299 0.169 0.500 ) ! White ( 1.000 0.337 0.163 ) ! Yellow ( 0.886 -0.163 0.081 ) ! ! Method: ! ! The Y'CbCr coordinate space is "slanted", so it is not possible ! to give simple bounds directly on the Y, Br and Cr values. ! The routine converts the YBrCr coordinates to RGB coordinates, ! forces each component to be between 0 and 1, and then converts ! back to Y'CbCr. ! ! Modified: ! ! 07 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real YPRIME, CB, CR, the Y'CbCr color coordinates to ! be checked. ! implicit none ! real cb real cr real yprime ! yprime = max ( yprime, 0.0E+00 ) yprime = min ( yprime, 1.0E+00 ) cb = max ( cb, -0.5E+00 ) cb = min ( cb, +0.5E+00 ) cr = max ( cr, -0.5E+00 ) cr = min ( cr, +0.5E+00 ) return end subroutine ycbcr_to_lcc ( yprime, cb, cr, luma, chroma1, chroma2 ) ! !******************************************************************************* ! !! YCBCR_TO_LCC converts Y'CbCr to LCC color coordinates. ! ! ! Definition: ! ! The Y'CbCr color system is used in digital television signals. ! The Y' component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, with reference black at 16/255 and reference white at 235/255, ! while Cb and Cr should be between -0.5 and 0.5. ! ! The LCC color coordinate system records a color as three components, ! Luma, Chroma1 and Chroma2. The LCC color coordinates are used ! in an intermediate calculation of the PhotoYCC color coordinates. ! Luma is scaled luminance, Chroma1 is (B'-Luma) and Chroma2 is (R'-Luma). ! ! Reference: ! ! C Wayne Brown and Barry Shepherd, ! Graphics File Formats, ! Manning Publications, 1995. ! ! Modified: ! ! 04 October 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, CB, CR, the Y'CbCr color coordinates. ! ! Output, real LUMA, CHROMA1, CHROMA2, the LCC color coordinates. ! implicit none ! real cb real chroma1 real chroma2 real cr real luma real yprime ! luma = ( 255.0E+00 * yprime - 16.0E+00 ) / 219.0E+00 chroma1 = ( 255.0E+00 * cb - 128.0E+00 ) / ( 224.0E+00 * 0.564E+00 ) chroma2 = ( 255.0E+00 * cr - 128.0E+00 ) / ( 224.0E+00 * 0.713E+00 ) return end subroutine ycbcr_to_rgb ( yprime, cb, cr, yr, yg, yb, r, g, b ) ! !******************************************************************************* ! !! YCBCR_TO_RGB converts Y'CbCr to RGB color coordinates. ! ! ! Definition: ! ! The Y'CbCr color system is used in digital television signals. ! The Y' component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, while Cb and Cr should be between -0.5 and 0.5. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, CB, CR, the Y'CbCr color coordinates to be converted. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real cb real cr real g real r real yb real yg real yprime real yr ! b = yprime + 2.0E+00 * ( 1.0E+00 - yb ) * cb r = yprime + 2.0E+00 * ( 1.0E+00 - yr ) * cr g = ( yprime - yr * r - yb * b ) / yg return end subroutine ycbcr_to_ycc ( yprime, cb, cr, yprime2, c1, c2 ) ! !******************************************************************************* ! !! YCBCR_TO_YCC converts Y'CbCr to PhotoYCC color coordinates. ! ! ! Definition: ! ! The Y'CbCr color system is used in digital television signals. ! The Y' component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, while Cb and Cr should be between -0.5 and 0.5. ! ! The Kodak PhotoYCC Color Interchange Space was developed for the ! Photo CD System. The Y' coordinate is a measure of luminance, ! while C1 and C2 measure color difference chrominance. ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 13 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, real YPRIME, CB, CR, the Y'CbCr color coordinates. ! ! Input, real YPRIME2, C1, C2, the PhotoYCC color coordinates. ! implicit none ! real c1 real c2 real cb real cr real yprime real yprime2 ! yprime2 = yprime / 1.402E+00 c1 = ( cb + 73.400E+00 ) / 1.291E+00 c2 = ( cr + 55.638E+00 ) / 1.340E+00 return end subroutine ycc_test ( itest, ytest, c1test, c2test ) ! !******************************************************************************* ! !! YCC_TEST supplies PhotoYCC values for tests. ! ! ! Modified: ! ! 19 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ITEST, the index of the test, between 1 and 5. ! ! Output, real YTEST, C1TEST, C2TEST, sample PhotoYCC color ! coordinates for testing. ! implicit none ! real c1test real c2test integer itest real ytest ! if ( itest == 1 ) then ytest = 3.0E+00 c1test = 250.0E+00 c2test = 200.0E+00 else if ( itest == 2 ) then ytest = 10.0E+00 c1test = 200.0E+00 c2test = 20.0E+00 else if ( itest == 3 ) then ytest = 50.0E+00 c1test = 75.0E+00 c2test = 0.0E+00 else if ( itest == 4 ) then ytest = 100.0E+00 c1test = 30.0E+00 c2test = 120.0E+00 else if ( itest == 5 ) then ytest = 150.0E+00 c1test = 80.0E+00 c2test = 200.0E+00 else write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'YCC_TEST - Fatal error!' write ( *, '(a,i6)' ) ' No such test number ITEST = ', itest stop end if return end subroutine ycc_to_lcc ( yprime, c1, c2, luma, chroma1, chroma2 ) ! !******************************************************************************* ! !! YCC_TO_LCC converts PhotoYCC to LCC color coordinates. ! ! ! Definition: ! ! The Kodak PhotoYCC Color Interchange Space was developed for the ! Photo CD System. The Y' coordinate is a measure of luminance, ! while C1 and C2 measure color difference chrominance. ! ! The LCC color coordinate system records a color as three components, ! Luma, Chroma1 and Chroma2. The LCC color coordinates are used ! in an intermediate calculation of the PhotoYCC color coordinates. ! Luma is scaled luminance, Chroma1 is (B'-Luma) and Chroma2 is (R'-Luma). ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 17 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, C1, C2, the PhotoYCC color coordinates. ! ! Output, real LUMA, CHROMA1, CHROMA2, the LCC color coordinates. ! implicit none ! real c1 real c2 real chroma1 real chroma2 real luma real yprime ! luma = 1.402E+00 * yprime / 255.0E+00 chroma1 = ( c1 - 156.0E+00 ) / 111.40E+00 chroma2 = ( c2 - 137.0E+00 ) / 135.64E+00 return end subroutine ycc_to_xyz ( yprime, c1, c2, yr, yg, yb, xcap, ycap, zcap ) ! !******************************************************************************* ! !! YCC_TO_XYZ converts PhotoYCC to CIE XYZ color coordinates. ! ! ! Definition: ! ! The Kodak PhotoYCC Color Interchange Space was developed for the ! Photo CD System. The Y' coordinate is a measure of luminance, ! while C1 and C2 measure color difference chrominance. ! ! The CIE XYZ color system describes a color in terms of its components ! of X, Y and Z primaries. In ordinary circumstances, all three of ! these components must be nonnegative. ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 01 February 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, C1, C2, the PhotoYCC color coordinates. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real XCAP, YCAP, ZCAP, the CIE XYZ color coordinates. ! implicit none ! real b real bprime real c1 real c2 real chroma1 real chroma2 real g real gprime real luma real r real rprime real xcap real xcap2 real yb real ycap real ycap2 real yg real yprime real yr real zcap real zcap2 ! ! Compute LUMA, CHROMA1, CHROMA2: ! call ycc_to_lcc ( yprime, c1, c2, luma, chroma1, chroma2 ) ! ! Compute R'G'B'. ! call lcc_to_rgbprime ( luma, chroma1, chroma2, yr, yg, yb, rprime, gprime, & bprime ) ! ! Convert to linear values. ! call nonlin_to_lin ( rprime, r ) call nonlin_to_lin ( gprime, g ) call nonlin_to_lin ( bprime, b ) ! ! Convert to CIE XYZ values. ! call rgb709_to_xyz ( r, g, b, xcap2, ycap2, zcap2 ) ! ! Multiply by 100.0E+00 ! xcap = xcap2 * 100.0E+00 ycap = ycap2 * 100.0E+00 zcap = zcap2 * 100.0E+00 return end subroutine ycc_to_ycbcr ( yprime, c1, c2, yprime2, cb, cr ) ! !******************************************************************************* ! !! YCC_TO_YCBCR converts PhotoYCC to Y'CbCr color coordinates. ! ! ! Definition: ! ! The Kodak PhotoYCC Color Interchange Space was developed for the ! Photo CD System. The Y' coordinate is a measure of luminance, ! while C1 and C2 measure color difference chrominance. ! ! The Y'CbCr color system is used in digital television signals. ! The Y' component measures luma, an approximation to the luminance ! or amount of light. Y' is the only component displayed on black ! and white televisions. The Cb and Cr components contain measures ! of the blue and red components of the color. Y' should be between ! 0 and 1, while Cb and Cr should be between -0.5 and 0.5. ! ! Reference: ! ! Edward Giorgianni and Thomas Madden, ! Digital Color Management, Encoding Solutions, ! Addison Wesley, 1998. ! ! Modified: ! ! 17 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, C1, C2, the PhotoYCC color coordinates. ! ! Output, real YPRIME2, CB, CR, the Y'CbCr color coordinates. ! implicit none ! real c1 real c2 real cb real cr real yprime real yprime2 ! yprime2 = 1.402E+00 * yprime cb = 1.291E+00 * c1 - 73.400E+00 cr = 1.340E+00 * c2 - 55.638E+00 return end subroutine yiq_check ( yprime, i, q, yr, yg, yb ) ! !******************************************************************************* ! !! YIQ_CHECK corrects out-of-range Y'IQ color coordinates. ! ! ! Definition: ! ! Y'IQ colors are used in American NTSC commercial color television ! broadcasting. The Y' component measures luma, an approximation to ! luminance, or the amount of light. Y' is the only component ! displayed on black and white televisions. The I and Q components ! contain color information. ! ! Examples: ! ! Black ( 0.000, 0.000, 0.000 ) ! Blue ( 0.114, -0.322, 0.311 ) ! Cyan ( 0.701, -0.596, -0.212 ) ! Green ( 0.587, -0.274, -0.523 ) ! Magenta ( 0.413, 0.274, 0.523 ) ! Red ( 0.299, 0.596, 0.212 ) ! White ( 1.000, 0.000, 0.000 ) ! Yellow ( 0.886, 0.322, -0.311 ) ! ! Method: ! ! The Y'IQ coordinate space is "slanted", so it is not possible ! to give simple bounds directly on the Y', I and Q values. ! The routine converts the Y'IQ coordinates to RGB coordinates, ! forces each component to be between 0 and 1, and then converts ! back to Y'IQ. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 01 February 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real YPRIME, I, Q, the Y'IQ color coordinates to be checked. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! implicit none ! real b real g real i real q real r real yb real yg real yprime real yr ! ! Convert Y'IQ to RGB. ! call yiqtorgb ( yprime, i, q, yr, yg, yb, r, g, b ) ! ! Check RGB. ! call rgb_check ( r, g, b ) ! ! Convert RGB back to Y'IQ. ! call rgbtoyiq ( r, g, b, yr, yg, yb, yprime, i, q ) return end subroutine yiq_to_rgb ( yprime, i, q, yr, yg, yb, r, g, b ) ! !******************************************************************************* ! !! YIQ_TO_RGB converts Y'IQ to RGB color coordinates. ! ! ! Definition: ! ! Y'IQ colors are used in American NTSC commercial color television ! broadcasting. The Y' component measures luma, an approximation to ! luminance, or the amount of light. Y' is the only component ! displayed on black and white televisions. The I and Q components ! contain color information. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, I, Q, the Y'IQ color coordinates to be converted. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real g real i real q real r real yb real yg real yprime real yr ! r = yprime + 0.956E+00 * i + 0.621E+00 * q b = yprime - 1.105E+00 * i + 1.702E+00 * q g = ( yprime - yr * r - yb * b ) / yg return end subroutine yiq_to_yuv ( yprime, i, q, yprime2, u, v ) ! !******************************************************************************* ! !! YIQ_TO_YUV converts Y'IQ to Y'UV color coordinates. ! ! ! Definition: ! ! Y'IQ colors are used in American NTSC commercial color television ! broadcasting. The Y' component measures luma, an approximation to ! luminance, or the amount of light. Y' is the only component ! displayed on black and white televisions. The I and Q components ! contain color information. ! ! Y'UV colors are used in European PAL commercial color television ! broadcasting. The Y' component measures luma, an approximation ! to the luminance, or amount of light. Y' is the only component ! displayed on black and white televisions. The U and V components ! contain color information. ! ! Reference: ! ! Foley, van Dam, Feiner, and Hughes, ! Computer Graphics, Principles and Practice, ! Addison Wesley, Second Edition, 1990. ! ! Modified: ! ! 13 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, I, Q, the Y'IQ color coordinates to be converted. ! ! Output, real YPRIME2, U, V, the corresponding Y'UV color coordinates. ! implicit none ! real i real q real u real v real yprime real yprime2 ! yprime2 = yprime u = - 1.1270E+00 * i + 1.8050E+00 * q v = 0.9489E+00 * i + 0.6561E+00 * q return end subroutine yuv_check ( yprime, u, v, yr, yg, yb ) ! !******************************************************************************* ! !! YUV_CHECK corrects out-of-range Y'UV color coordinates. ! ! ! Definition: ! ! Y'UV colors are used in European PAL commercial color television ! broadcasting. The Y' component measures luma, an approximation ! to the luminance, or amount of light. Y' is the only component ! displayed on black and white televisions. The U and V components ! contain color information. ! ! Examples: ! ! Black ( 0.000 0.000 0.000 ) ! Blue ( 0.114 0.436 -0.100 ) ! Cyan ( 0.701 0.147 -0.615 ) ! Green ( 0.587 -0.289 -0.515 ) ! Magenta ( 0.413 0.289 0.515 ) ! Red ( 0.299 -0.147 0.615 ) ! White ( 1.000 0.000 0.000 ) ! Yellow ( 0.886 -0.436 0.100 ) ! ! Method: ! ! The Y'UV coordinate space is "slanted", so it is not possible ! to give simple bounds directly on the Y', U and V values. ! The routine converts the Y'UV coordinates to RGB coordinates, ! forces each component to be between 0 and 1, and then converts ! back to Y'UV. ! ! Modified: ! ! 01 February 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, real YPRIME, U, V, the Y'UV color coordinates to be checked. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! implicit none ! real b real g real r real u real v real yb real yg real yprime real yr ! ! Convert Y'UV to RGB. ! call yuvtorgb ( yprime, u, v, yr, yg, yb, r, g, b ) ! ! Check RGB. ! call rgb_check ( r, g, b ) ! ! Convert RGB back to Y'UV. ! call rgbtoyuv ( r, g, b, yr, yg, yb, yprime, u, v ) return end subroutine yuv_to_rgb ( yprime, u, v, yr, yg, yb, r, g, b ) ! !******************************************************************************* ! !! YUV_TO_RGB converts Y'UV to RGB color coordinates. ! ! ! Definition: ! ! Y'UV colors are used in European PAL commercial color television ! broadcasting. The Y' component measures luma, an approximation ! to the luminance, or amount of light. Y' is the only component ! displayed on black and white televisions. The U and V components ! contain color information. ! ! The RGB color system describes a color based on the amounts of the ! base colors red, green, and blue. Thus, a particular color ! has three coordinates, (R,G,B). Each coordinate must be between ! 0 and 1. ! ! Modified: ! ! 31 January 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, U, V, the Y'UV color coordinates to be converted. ! ! Input, real YR, YG, YB, the coefficients of the R, G and B ! primaries in the luminance function. ! ! Output, real R, G, B, the corresponding RGB color coordinates. ! implicit none ! real b real g real r real u real v real yb real yg real yprime real yr ! b = yprime + 2.029E+00 * u r = yprime + 1.140E+00 * v g = ( yprime - yr * r - yb * b ) / yg return end subroutine yuv_to_yiq ( yprime, u, v, yprime2, i, q ) ! !******************************************************************************* ! !! YUV_TO_YIQ converts Y'UV to Y'IQ color coordinates. ! ! ! Definition: ! ! Y'UV colors are used in European PAL commercial color television ! broadcasting. The Y' component measures luma, an approximation ! to the luminance, or amount of light. Y' is the only component ! displayed on black and white televisions. The U and V components ! contain color information. ! ! Y'IQ colors are used in American NTSC commercial color television ! broadcasting. The Y' component measures luma, an approximation to ! luminance, or the amount of light. Y' is the only component ! displayed on black and white televisions. The I and Q components ! contain color information. ! ! Modified: ! ! 13 September 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, real YPRIME, U, V, the Y'UV color coordinates to be converted. ! ! Output, real YPRIME2, I, Q, the corresponding Y'IQ color coordinates. ! implicit none ! real i real q real u real v real yprime real yprime2 ! yprime2 = yprime i = - 0.2676E+00 * u + 0.7361E+00 * v q = + 0.3869E+00 * u + 0.4596E+00 * v return end