check Subroutine

private pure subroutine check(self, check_name, check_bounds, check_levels)

Uses

  • proc~~check~~UsesGraph proc~check Colormap%check module~forcolormap_info forcolormap_info proc~check->module~forcolormap_info module~colormap_parameters colormap_parameters module~forcolormap_info->module~colormap_parameters iso_fortran_env iso_fortran_env module~colormap_parameters->iso_fortran_env

Check validity of the colormap and fix it if necessary

Type Bound

Colormap

Arguments

Type IntentOptional Attributes Name
class(Colormap), intent(inout) :: self
logical, intent(in), optional :: check_name
logical, intent(in), optional :: check_bounds
logical, intent(in), optional :: check_levels

Calls

proc~~check~~CallsGraph proc~check Colormap%check proc~get_levels~2 Colormaps_info%get_levels proc~check->proc~get_levels~2 proc~get_name~2 Colormaps_info%get_name proc~check->proc~get_name~2 proc~get_ncolormaps Colormaps_info%get_ncolormaps proc~check->proc~get_ncolormaps proc~set_all Colormaps_info%set_all proc~check->proc~set_all proc~set_info table%set_info proc~set_all->proc~set_info

Called by

proc~~check~~CalledByGraph proc~check Colormap%check proc~create Colormap%create proc~create->proc~check proc~create_bezier Colormap%create_bezier proc~create_bezier->proc~check proc~create_lagrange Colormap%create_lagrange proc~create_lagrange->proc~check proc~load Colormap%load proc~load->proc~check proc~set Colormap%set proc~set->proc~check proc~set->proc~create proc~extract Colormap%extract proc~extract->proc~create program~create create program~create->proc~create_bezier program~create->proc~create_lagrange program~demo demo program~demo->proc~create program~demo->proc~load program~demo->proc~set program~demo_reverse demo_reverse program~demo_reverse->proc~create program~demo_reverse->proc~load program~demo_reverse->proc~set program~example1 example1 program~example1->proc~load program~extract extract program~extract->proc~set program~extract->proc~extract program~modify modify program~modify->proc~set

Source Code

    pure subroutine check(self,check_name, check_bounds, check_levels)
        use forcolormap_info, only: Colormaps_info

        class(Colormap), intent(inout) :: self
        logical, dimension(4) :: status
        logical, intent(in), optional :: check_name, check_bounds, check_levels
        real(wp) :: temp
        type(Colormaps_info) :: cmap_info
        integer :: input_levels, i, levels
        real(wp) :: input_zmin, input_zmax
        character(:), allocatable :: input_name

        interface
            pure subroutine error(status, input_name, input_zmin, input_zmax, input_levels)
                import wp
                logical, dimension(:), intent(in) :: status
                character(*), intent(in) :: input_name
                real(wp), intent(in) :: input_zmin, input_zmax
                integer, intent(in) :: input_levels
            end subroutine error
        end interface

        ! Save input parameters for error message
        input_levels = self%levels
        input_zmin = self%zmin
        input_zmax = self%zmax
        input_name = self%name

        ! Initialize status array
        status = .true.

        call cmap_info%set_all()

        if (present(check_name)) then
            if (check_name) then

                ! Check if the colormap is valid
                if (.not. any(self%name == colormaps_list)) status(1) = .false.

                ! Fix the colormap if it is not valid
                if (status(1) .eqv. .false.) self%name = "grayC"

                ! Find the number of levels of the colormap
                do i = 1, cmap_info%get_ncolormaps()
                    if (self%name == trim(cmap_info%get_name(i))) then
                        levels = cmap_info%get_levels(i)
                        exit
                    end if
                end do

                ! Check if the number of levels is valid
                if (levels /= self%levels .or. self%levels < 1) then
                    if (self%levels /= -256) then
                        if (levels /= -1) then
                            status(3) = .false.
                            self%levels = levels
                        end if
                    else
                        self%levels = 256
                    end if
                end if

                ! Fix the number of levels if it is not valid
                if (status(3) .eqv. .false.) then
                    self%levels = levels
                end if

            end if
        end if

        if (present(check_bounds)) then
            if (check_bounds) then
                ! Check validity of zmin and zmax
                if (self%zmin > self%zmax) status(2) = .false.

                ! Fix zmin and zmax if they are not valid
                if (status(2) .eqv. .false.) then
                    temp      = self%zmin
                    self%zmin = self%zmax
                    self%zmax = temp
                end if

            end if
        end if


        if (present(check_levels)) then
            if (check_levels) then
                ! Check if the number of levels is valid
                if (self%levels < 1) then
                    status(4) = .false.
                    self%levels = 256
                end if
            end if
        end if

        ! Call error subroutine if any status is false
        if (any(status .eqv. .false.))&
            call error(status, input_name, input_zmin, input_zmax, input_levels)

    end subroutine check