diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends b/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends index efaa40ec..b1ec216b 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends @@ -20,6 +20,16 @@ cal_pvr_modelview_mat.o: $(PVR_DIR)/cal_pvr_modelview_mat.f90 m_precision.o m_co $(F90) -c $(F90OPTFLAGS) $< cal_pvr_projection_mat.o: $(PVR_DIR)/cal_pvr_projection_mat.f90 m_precision.o m_constants.o m_machine_parameter.o t_control_params_4_pvr.o t_control_params_stereo_pvr.o set_projection_matrix.o $(F90) -c $(F90OPTFLAGS) $< +colormap_grayscales.o: $(PVR_DIR)/colormap_grayscales.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< +colormap_metal.o: $(PVR_DIR)/colormap_metal.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< +colormap_rainbow.o: $(PVR_DIR)/colormap_rainbow.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< +colormap_space.o: $(PVR_DIR)/colormap_space.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< +colormap_two_colors.o: $(PVR_DIR)/colormap_two_colors.f90 m_precision.o m_constants.o + $(F90) -c $(F90OPTFLAGS) $< comm_tbl_4_img_composit.o: $(PVR_DIR)/comm_tbl_4_img_composit.f90 m_precision.o m_constants.o quicksort.o $(F90) -c $(F90OPTFLAGS) $< comm_tbl_4_img_output.o: $(PVR_DIR)/comm_tbl_4_img_output.f90 m_precision.o m_constants.o @@ -88,7 +98,7 @@ rendering_vr_image.o: $(PVR_DIR)/rendering_vr_image.f90 m_precision.o m_machine_ $(F90) -c $(F90OPTFLAGS) $< set_PVR_view_and_image.o: $(PVR_DIR)/set_PVR_view_and_image.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o m_geometry_constants.o t_mesh_data.o t_pvr_image_array.o t_rendering_vr_image.o t_surf_grp_4_pvr_domain.o t_geometries_in_pvr_screen.o t_mesh_SR.o rendering_vr_image.o cal_pvr_modelview_mat.o cal_pvr_projection_mat.o $(F90) -c $(F90OPTFLAGS) $< -set_color_4_pvr.o: $(PVR_DIR)/set_color_4_pvr.f90 m_precision.o set_rgb_colors.o +set_color_4_pvr.o: $(PVR_DIR)/set_color_4_pvr.f90 m_precision.o set_rgb_colors.o colormap_rainbow.o colormap_two_colors.o colormap_grayscales.o colormap_metal.o colormap_space.o $(F90) -c $(F90OPTFLAGS) $< set_composition_pe_range.o: $(PVR_DIR)/set_composition_pe_range.f90 m_precision.o t_rendering_vr_image.o t_pvr_image_array.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_grayscales.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_grayscales.f90 new file mode 100644 index 00000000..7ecd7340 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_grayscales.f90 @@ -0,0 +1,88 @@ +!>@file colormap_grayscales.F90 +!!@brief module colormap_grayscales +!! +!!@author H. Matsui +!!@date Programmed in Apr., 2024 +! +!>@brief Colormapping for grayscales +!! +!!@verbatim +!! subroutine s_colormap_grayscale(rnorm, r, g, b) +!! subroutine s_colormap_sym_grayscale(rnorm, r, g, b) +!! real(kind = kreal), intent(in) :: rnorm +!! real(kind = kreal), intent(inout) :: r, g, b +!!@endverbatim +! + module colormap_grayscales +! + use m_precision + use m_constants +! + implicit none +! +! ------------------------------------------------------------------ +! + contains +! +! ------------------------------------------------------------------ +! + subroutine s_colormap_grayscale(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: black = zero + real(kind = kreal), parameter :: white = one +! +! + if (rnorm .lt. zero ) then + r = zero + g = zero + b = zero + else if (rnorm .ge. zero .and. rnorm.lt.white) then + r = 0.85d0*rnorm + g = 0.85d0*rnorm + b = 0.85d0*rnorm + else if (rnorm .ge. white ) then + r = 0.85d0 + g = 0.85d0 + b = 0.85d0 + end if +! + end subroutine s_colormap_grayscale +! +! ---------------------------------------------------------------------- +! + subroutine s_colormap_sym_grayscale(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: black = zero + real(kind = kreal), parameter :: white = one + real(kind = kreal), parameter :: half = one / two +! +! + if (rnorm .lt. zero ) then + r = zero + g = zero + b = zero + else if (rnorm .ge. zero .and. rnorm.lt.half) then + r = 0.85d0*two*rnorm + g = 0.85d0*two*rnorm + b = 0.85d0*two*rnorm + else if (rnorm .ge. half .and. rnorm.lt.white) then + r = 0.85d0*two*(one - rnorm) + g = 0.85d0*two*(one - rnorm) + b = 0.85d0*two*(one - rnorm) + else if (rnorm .ge. white ) then + r = zero + g = zero + b = zero + end if +! + end subroutine s_colormap_sym_grayscale +! +! ---------------------------------------------------------------------- +! + end module colormap_grayscales diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_metal.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_metal.f90 new file mode 100644 index 00000000..1c590383 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_metal.f90 @@ -0,0 +1,63 @@ +!>@file colormap_metal.F90 +!!@brief module colormap_metal +!! +!!@author H. Matsui +!!@date Programmed in Apr., 2024 +! +!>@brief Colormapping for molten metal +!! +!!@verbatim +!! subroutine s_colormap_metal(rnorm, r, g, b) +!! real(kind = kreal), intent(in) :: rnorm +!! real(kind = kreal), intent(inout) :: r, g, b +!!@endverbatim +! + module colormap_metal +! + use m_precision + use m_constants +! + implicit none +! +! ------------------------------------------------------------------ +! + contains +! +! ------------------------------------------------------------------ +! + subroutine s_colormap_metal(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: c_g1 = 0.6 + real(kind = kreal), parameter :: r_mul = one / c_g1 + real(kind = kreal), parameter :: g_mul = one / (one - c_g1) +! + real(kind = kreal) :: x +! +! + x = rnorm + if (x .lt. zero) then + r = zero + else if(r .lt. c_g1) then + r = x * r_mul + else + r = one + end if +! + if (x .lt. c_g1) then + g = zero + else if(r .lt. one) then + g = (x - c_g1) * g_mul + else + g = one + end if +! + b = zero +! + end subroutine s_colormap_metal +! +! ---------------------------------------------------------------------- +! + end module colormap_metal diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_rainbow.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_rainbow.f90 new file mode 100644 index 00000000..bb7f84f7 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_rainbow.f90 @@ -0,0 +1,76 @@ +!>@file colormap_rainbow.F90 +!!@brief module colormap_rainbow +!! +!!@author H. Matsui +!!@date Programmed in Apr., 2024 +! +!>@brief Rainbow colormapping +!! +!!@verbatim +!! subroutine s_colormap_rainbow(rnorm, r, g, b) +!! real(kind = kreal), intent(in) :: rnorm +!! real(kind = kreal), intent(inout) :: r, g, b +!!@endverbatim +! + module colormap_rainbow +! + use m_precision + use m_constants +! + implicit none +! +! ------------------------------------------------------------------ +! + contains +! +! ------------------------------------------------------------------ +! + subroutine s_colormap_rainbow(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: purple = zero + real(kind = kreal), parameter :: blue = 0.1e0 + real(kind = kreal), parameter :: ocean = 0.325e0 + real(kind = kreal), parameter :: green = 0.55e0 + real(kind = kreal), parameter :: yellow = 0.775e0 + real(kind = kreal), parameter :: red = one + real(kind = kreal), parameter :: forty = four*ten +! +! + if (rnorm .lt. purple ) then + r = half + g = zero + b = one + else if (rnorm .ge. purple .and. rnorm.lt.blue) then + r = half - five*rnorm + g = zero + b = one + else if (rnorm .ge. blue .and. rnorm.lt.ocean) then + r = zero + g = forty*(rnorm-blue) / dnine + b = one + else if (rnorm .ge. ocean .and. rnorm.lt.green) then + r = zero + g = one + b = one - forty*(rnorm-ocean) / dnine + else if (rnorm .ge. green .and. rnorm.lt.yellow) then + r = forty*(rnorm-green) / dnine + g = one + b = zero + else if (rnorm .ge. yellow .and. rnorm.lt. red) then + r = one + g = one - forty*(rnorm-yellow) / dnine + b = zero + else if (rnorm .ge. red ) then + r = one + g = zero + b = zero + end if +! + end subroutine s_colormap_rainbow +! +! ---------------------------------------------------------------------- +! + end module colormap_rainbow diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_space.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_space.f90 new file mode 100644 index 00000000..a7025d55 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_space.f90 @@ -0,0 +1,117 @@ +!>@file colormap_space.F90 +!!@brief module colormap_space +!! +!!@author H. Matsui +!!@date Programmed in Apr., 2024 +! +!>@brief Colormapping +!! +!!@verbatim +!! subroutine s_colormap_space(rnorm, r, g, b) +!! real(kind = kreal), intent(in) :: rnorm +!! real(kind = kreal), intent(inout) :: r, g, b +!!@endverbatim +! + module colormap_space +! + use m_precision + use m_constants +! + implicit none +! +! ------------------------------------------------------------------ +! + contains +! +! ------------------------------------------------------------------ +! + subroutine s_colormap_space(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: c_r1 = 37067.0 / 158860.0 + real(kind = kreal), parameter :: c_r2 = 85181.0 / 230350.0 + real(kind = kreal), parameter & + & :: c_r3 = (sqrt(3196965649.0) + 83129.0) / 310480.0 + real(kind = kreal), parameter :: c_r4 = 231408.0 / 362695.0 + real(kind = kreal), parameter :: c_r5 = 152073.0 / 222340.0 + real(kind = kreal), parameter :: c_r6 = 294791.0 / 397780.0 + real(kind = kreal), parameter :: c_r7 = 491189.0 / 550980.0 +! + real(kind = kreal), parameter & + & :: c_g1 = (-sqrt(166317494.0) + 39104.0) / 183830.0 + real(kind = kreal), parameter & + & :: c_g3 = (3.0 * sqrt(220297369.0) + 58535.0) / 155240.0 +! + real(kind = kreal), parameter :: c_b1 = 51987.0 / 349730.0 +! + real(kind = kreal) :: x, xx +! +! + x = rnorm + if (x .lt. c_r1) then + r = 0.0 + else if (x .lt. c_r2) then + xx = x - c_r1 + r = (780.25 * xx + 319.71) * xx / 255.0 + else if (x .lt. c_r3) then + r = ((1035.33580904442 * x - 82.5380748768798) * x & + & - 52.8985266363332) / 255.0 + else if (x .lt. c_r4) then + r = (339.41 * x - 33.194) / 255.0 + else if (x .lt. c_r5) then + r = (1064.8 * x - 496.01) / 255.0 + else if (x .lt. c_r6) then + r = (397.78 * x - 39.791) / 255.0 + else if (x .lt. c_r7) then + r = 1.0 + else if (x .lt. one) then + r = (5509.8 * x + 597.91) * x / 255.0 + else + r = 1.0 + end if + + if (x .lt. zero) then + g = 0.0 + else if (x .lt. c_g1) then + g = (-1838.3 * x + 464.36) * x / 255.0 + else if (x .lt. c_r1) then + g = (-317.72 * x + 74.134) / 255.0 + else if (x .lt. c_g3) then + g = 0.0 + else if (x .lt. c_r6) then + xx = x - c_g3 + g = (-1945.0 * xx + 1430.2) * xx / 255.0 + else if (x .lt. c_r7) then + g = ((-1770.0 * x + 3.92813840044638e3) * x & + & - 1.84017494792245e3) / 255.0 + else + g = 1.0 + end if + + if (x .lt. zero) then + b = 0.0 + else if (x .lt. c_b1) then + b = (458.79 * x) / 255.0 + else if (x .lt. c_r2) then + b = (109.06 * x + 51.987) / 255.0 + else if (x .lt. c_r3) then + b = (339.41 * x - 33.194) / 255.0 + else if (x .lt. c_g3) then + b = ((-1552.4 * x + 1170.7) * x - 92.996) / 255.0 + else if (x .lt. 27568.0 / 38629.0) then + b = 0.0 + else if (x .lt. 81692.0 / 96241.0) then + b = (386.29 * x - 275.68) / 255.0 + else if (x .lt. 1.0) then + b = (1348.7 * x - 1092.6) / 255.0 + else + b = 1.0 + end if +! + end subroutine s_colormap_space +! +! ---------------------------------------------------------------------- +! + end module colormap_space diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_two_colors.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_two_colors.f90 new file mode 100644 index 00000000..cf0d8389 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/colormap_two_colors.f90 @@ -0,0 +1,103 @@ +!>@file colormap_two_colors.F90 +!!@brief module colormap_two_colors +!! +!!@author H. Matsui +!!@date Programmed in Apr., 2024 +! +!>@brief Colormapping with two colors +!! +!!@verbatim +!! subroutine s_colormap_redblue(rnorm, r, g, b) +!! subroutine s_colormap_orangecyan(rnorm, r, g, b) +!! real(kind = kreal), intent(in) :: rnorm +!! real(kind = kreal), intent(inout) :: r, g, b +!!@endverbatim +! + module colormap_two_colors +! + use m_precision + use m_constants +! + implicit none +! +! ------------------------------------------------------------------ +! + contains +! +! ------------------------------------------------------------------ +! + subroutine s_colormap_redblue(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: abyss = zero + real(kind = kreal), parameter :: blue = 0.1d0 + real(kind = kreal), parameter :: white = half + real(kind = kreal), parameter :: red = 0.9d0 + real(kind = kreal), parameter :: blood = one +! +! + if (rnorm .lt. abyss ) then + r = zero + g = 0.2d0 + b = 0.8d0 + else if (rnorm .ge. abyss .and. rnorm.lt.blue) then + r = zero + g = 2.0d0 * (blue - rnorm) + b = 0.8d0 + 2.0d0 * rnorm + else if (rnorm .ge. blue .and. rnorm.lt.white) then + r = (rnorm - blue) * 2.0d0 + g = (rnorm - blue) * 2.0d0 + b = one - (rnorm - blue) * 0.25 + else if (rnorm .ge. white .and. rnorm.lt.red) then + r = one - (red - rnorm) * 0.25 + g = (red - rnorm) * 2.0d0 + b = (red - rnorm) * 2.0d0 + else if (rnorm .ge. red .and. rnorm.lt. blood) then + r = one - (rnorm - red) * 2.0d0 + g = zero + b = zero + else if (rnorm .ge. blood) then + r = 0.8d0 + g = zero + b = zero + end if +! + end subroutine s_colormap_redblue +! +! ---------------------------------------------------------------------- +! + subroutine s_colormap_orangecyan(rnorm, r, g, b) +! + real(kind = kreal), intent(in) :: rnorm + real(kind = kreal), intent(inout) :: r, g, b +! + real(kind = kreal), parameter :: blue = zero + real(kind = kreal), parameter :: white = half + real(kind = kreal), parameter :: red = one +! +! + if (rnorm .lt. blue ) then + r = 0.0d0 + g = 1.0d0 + b = 1.0d0 + else if (rnorm .ge. blue .and. rnorm.lt.white) then + r = rnorm * 2.0d0 + g = 1.0d0 + b = 1.0d0 - rnorm * 0.5d0 + else if (rnorm .ge. white .and. rnorm.lt.red) then + r = 1.0 + g = (red - rnorm) + 0.5d0 + b = (red - rnorm) * 1.5d0 + else if (rnorm .ge. red) then + r = 1.0d0 + g = 0.5d0 + b = 0.0d0 + end if +! + end subroutine s_colormap_orangecyan +! +! ---------------------------------------------------------------------- +! + end module colormap_two_colors diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_color_4_pvr.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_color_4_pvr.f90 index e9bd3df1..18fa3cdb 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_color_4_pvr.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_color_4_pvr.f90 @@ -32,10 +32,20 @@ module set_color_4_pvr & :: hd_radblue = 'blue_to_red' character(len = kchara), parameter & & :: hd_sym_gray = 'symmetric_grayscale' - integer(kind = kint), parameter :: iflag_redblue = 3 - integer(kind = kint), parameter :: iflag_rainbow = 1 - integer(kind = kint), parameter :: iflag_grayscale = 2 - integer(kind = kint), parameter :: iflag_sym_gray = 4 + character(len = kchara), parameter & + & :: hd_orangecyan = 'cyan_to_orange' + character(len = kchara), parameter & + & :: hd_moltenmetal = 'molten_metal' + character(len = kchara), parameter & + & :: hd_spacecolor = 'space' +! + integer(kind = kint), parameter :: iflag_rainbow = 1 + integer(kind = kint), parameter :: iflag_grayscale = 2 + integer(kind = kint), parameter :: iflag_redblue = 3 + integer(kind = kint), parameter :: iflag_sym_gray = 4 + integer(kind = kint), parameter :: iflag_orangecyan = 5 + integer(kind = kint), parameter :: iflag_moltenmetal = 6 + integer(kind = kint), parameter :: iflag_spacecolor = 7 ! character(len = kchara), parameter :: hd_minmax = 'minmax' character(len = kchara), parameter :: hd_linear = 'linear' @@ -103,6 +113,11 @@ end subroutine restore_from_normalize subroutine normvalue_to_rgb(id_color_system, colordat, color) ! use set_rgb_colors + use colormap_rainbow + use colormap_two_colors + use colormap_grayscales + use colormap_metal + use colormap_space ! integer(kind = kint), intent(in) :: id_color_system real(kind = kreal), intent(in) :: colordat @@ -111,14 +126,22 @@ subroutine normvalue_to_rgb(id_color_system, colordat, color) ! ! if(id_color_system .eq. iflag_redblue) then - call color_redblue(colordat, color(1), color(2), color(3)) + call s_colormap_redblue(colordat, color(1), color(2), color(3)) + else if(id_color_system .eq. iflag_orangecyan) then + call s_colormap_orangecyan & + & (colordat, color(1), color(2), color(3)) + else if(id_color_system .eq. iflag_moltenmetal) then + call s_colormap_metal(colordat, color(1), color(2), color(3)) + else if(id_color_system .eq. iflag_spacecolor) then + call s_colormap_space(colordat, color(1), color(2), color(3)) else if(id_color_system .eq. iflag_sym_gray) then - call color_sym_grayscale & + call s_colormap_sym_grayscale & & (colordat, color(1), color(2), color(3)) else if(id_color_system .eq. iflag_grayscale) then - call color_grayscale(colordat, color(1), color(2), color(3)) + call s_colormap_grayscale & + & (colordat, color(1), color(2), color(3)) else - call color_rainbow(colordat, color(1), color(2), color(3)) + call s_colormap_rainbow(colordat, color(1), color(2), color(3)) end if ! end subroutine normvalue_to_rgb diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 index eb1b70b6..3f821b7b 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 @@ -154,6 +154,12 @@ subroutine set_control_pvr_colormap(color, color_param) color_param%id_pvr_color(1) = iflag_grayscale else if(cmp_no_case(tmpchara, hd_sym_gray)) then color_param%id_pvr_color(1) = iflag_sym_gray + else if(cmp_no_case(tmpchara, hd_orangecyan)) then + color_param%id_pvr_color(1) = iflag_orangecyan + else if(cmp_no_case(tmpchara, hd_moltenmetal)) then + color_param%id_pvr_color(1) = iflag_moltenmetal + else if(cmp_no_case(tmpchara, hd_spacecolor)) then + color_param%id_pvr_color(1) = iflag_spacecolor end if end if ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgb_colors.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgb_colors.f90 index 28fe9011..ec15ada3 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgb_colors.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgb_colors.f90 @@ -1,6 +1,34 @@ -! -! module set_rgb_colors -! +!>@file set_rgb_colors.F90 +!!@brief module set_rgb_colors +!! +!!@author H. Matsui +!!@date Programmed in Apr., 2024 +! +!>@brief Normalization for color mapping +!! +!!@verbatim +!! subroutine normalize_by_linear(dat_min, dat_max, value, & +!! & colordat) +!! real(kind = kreal), intent(in) :: value +!! real(kind = kreal), intent(in) :: dat_min, dat_max +!! real(kind = kreal), intent(out) :: colordat +!! subroutine normalize_by_linear_segment(num_point, datamap_param,& +!! & value, colordat) +!! real(kind = kreal), intent(in) :: value +!! integer(kind = kint), intent(in) :: num_point +!! real(kind = kreal), intent(in) :: datamap_param(2,num_point) +!! real(kind = kreal), intent(out) :: colordat +!! +!! subroutine restore_linear_normalize(value_rgb, & +!! & mincolor, maxcolor, value) +!! subroutine restore_segment_normalize(value_rgb, & +!! & mincolor, maxcolor, num_point, datamap_param, value) +!! real(kind = kreal), intent(in) :: value_rgb +!! real(kind = kreal), intent(in) :: mincolor, maxcolor +!! integer(kind = kint), intent(in) :: num_point +!! real(kind = kreal), intent(in) :: datamap_param(2,num_point) +!! real(kind = kreal), intent(out) :: value +!!@endverbatim module set_rgb_colors ! use m_precision @@ -12,20 +40,6 @@ module set_rgb_colors private :: EPSILON ! ! -! subroutine normalize_by_linear(dat_min, dat_max, value, & -! & colordat) -! subroutine normalize_by_linear_segment(num_point, datamap_param, & -! & value, colordat) -! -! subroutine restore_linear_normalize(value_rgb, & -! & mincolor, maxcolor, value) -! subroutine restore_segment_normalize(value_rgb, & -! & mincolor, maxcolor, num_point, datamap_param, value) -! -! subroutine color_rainbow(rnorm, r, g, b) -! subroutine color_redblue(rnorm, r, g, b) -! subroutine color_grayscale(rnorm, r, g, b) -! subroutine color_sym_grayscale(rnorm, r, g, b) ! ! ---------------------------------------------------------------------- ! @@ -139,155 +153,5 @@ subroutine restore_segment_normalize(value_rgb, & end subroutine restore_segment_normalize ! ! ---------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! - subroutine color_rainbow(rnorm, r, g, b) -! - real(kind = kreal), intent(in) :: rnorm - real(kind = kreal), intent(inout) :: r, g, b -! - real(kind = kreal), parameter :: purple = zero - real(kind = kreal), parameter :: blue = 0.1e0 - real(kind = kreal), parameter :: ocean = 0.325e0 - real(kind = kreal), parameter :: green = 0.55e0 - real(kind = kreal), parameter :: yellow = 0.775e0 - real(kind = kreal), parameter :: red = one - real(kind = kreal), parameter :: forty = four*ten -! -! - if (rnorm .lt. purple ) then - r = half - g = zero - b = one - else if (rnorm .ge. purple .and. rnorm.lt.blue) then - r = half - five*rnorm - g = zero - b = one - else if (rnorm .ge. blue .and. rnorm.lt.ocean) then - r = zero - g = forty*(rnorm-blue) / dnine - b = one - else if (rnorm .ge. ocean .and. rnorm.lt.green) then - r = zero - g = one - b = one - forty*(rnorm-ocean) / dnine - else if (rnorm .ge. green .and. rnorm.lt.yellow) then - r = forty*(rnorm-green) / dnine - g = one - b = zero - else if (rnorm .ge. yellow .and. rnorm.lt. red) then - r = one - g = one - forty*(rnorm-yellow) / dnine - b = zero - else if (rnorm .ge. red ) then - r = one - g = zero - b = zero - end if -! - end subroutine color_rainbow -! -! ---------------------------------------------------------------------- -! - subroutine color_redblue(rnorm, r, g, b) -! - real(kind = kreal), intent(in) :: rnorm - real(kind = kreal), intent(inout) :: r, g, b -! - real(kind = kreal), parameter :: abyss = zero - real(kind = kreal), parameter :: blue = 0.1d0 - real(kind = kreal), parameter :: white = half - real(kind = kreal), parameter :: red = 0.9d0 - real(kind = kreal), parameter :: blood = one -! -! - if (rnorm .lt. abyss ) then - r = zero - g = 0.2d0 - b = 0.8d0 - else if (rnorm .ge. abyss .and. rnorm.lt.blue) then - r = zero - g = 2.0d0 * (blue - rnorm) - b = 0.8d0 + 2.0d0 * rnorm - else if (rnorm .ge. blue .and. rnorm.lt.white) then - r = (rnorm - blue) * 2.0d0 - g = (rnorm - blue) * 2.0d0 - b = one - (rnorm - blue) * 0.25 - else if (rnorm .ge. white .and. rnorm.lt.red) then - r = one - (red - rnorm) * 0.25 - g = (red - rnorm) * 2.0d0 - b = (red - rnorm) * 2.0d0 - else if (rnorm .ge. red .and. rnorm.lt. blood) then - r = one - (rnorm - red) * 2.0d0 - g = zero - b = zero - else if (rnorm .ge. blood) then - r = 0.8d0 - g = zero - b = zero - end if -! - end subroutine color_redblue -! -! ---------------------------------------------------------------------- -! - subroutine color_grayscale(rnorm, r, g, b) -! - real(kind = kreal), intent(in) :: rnorm - real(kind = kreal), intent(inout) :: r, g, b -! - real(kind = kreal), parameter :: black = zero - real(kind = kreal), parameter :: white = one -! -! - if (rnorm .lt. zero ) then - r = zero - g = zero - b = zero - else if (rnorm .ge. zero .and. rnorm.lt.white) then - r = 0.85d0*rnorm - g = 0.85d0*rnorm - b = 0.85d0*rnorm - else if (rnorm .ge. white ) then - r = 0.85d0 - g = 0.85d0 - b = 0.85d0 - end if -! - end subroutine color_grayscale -! -! ---------------------------------------------------------------------- -! - subroutine color_sym_grayscale(rnorm, r, g, b) -! - real(kind = kreal), intent(in) :: rnorm - real(kind = kreal), intent(inout) :: r, g, b -! - real(kind = kreal), parameter :: black = zero - real(kind = kreal), parameter :: white = one - real(kind = kreal), parameter :: half = one / two -! -! - if (rnorm .lt. zero ) then - r = zero - g = zero - b = zero - else if (rnorm .ge. zero .and. rnorm.lt.half) then - r = 0.85d0*two*rnorm - g = 0.85d0*two*rnorm - b = 0.85d0*two*rnorm - else if (rnorm .ge. half .and. rnorm.lt.white) then - r = 0.85d0*two*(one - rnorm) - g = 0.85d0*two*(one - rnorm) - b = 0.85d0*two*(one - rnorm) - else if (rnorm .ge. white ) then - r = zero - g = zero - b = zero - end if -! - end subroutine color_sym_grayscale -! -! ---------------------------------------------------------------------- ! end module set_rgb_colors