subroutine chromcolor(range,rc,gc,bc) ! Subroutine to Map Depth to Color for Chromatek Glasses ! See www.chromatek.com and www.gac.edu/~huber/chromatek ! ! Tom Huber 20-Mar-1999 implicit none ! ! Input Variable ! Range -- Depth variable running from 0. (furthest away) to 1. (closest) ! For Example, in calling program one might define ! Range = (Z-Zmin)/(ZMax-Zmin) ! ! Output Variables ! rc, gc, bc :: Red, Green and Blue Color Values Ranging from 0. -> 1. ! real, intent(in) :: range real, intent(out) :: rc,gc,bc real :: tmp if (range > 1) then range = 1. elseif (range < 0.) then range = 0. endif tmp = range/0.9 if (tmp < 0.75) then rc = -2.13*tmp**4-1.07*tmp**3+0.133*tmp**2 rc = rc + 0.0667*tmp + 1. else rc = 0. endif if (rc < 0.) then rc = 0. elseif (rc > 1.) then rc = 1. endif if (range <= 0.5) then gc = 1.6*range**2+1.2*range else gc = 3.2*range**2-6.8*range+3.6 endif if (gc < 0.) then gc = 0. elseif (gc > 1.) then gc = 1. endif if (range <= 0.5) then bc = 0. else bc = -4.8*range**2+9.2*range-3.4 endif if (bc < 0.) then bc = 0. elseif (bc > 1.) then bc = 1. endif return end