load Subroutine

private impure subroutine load(self, filename, zmin, zmax, reverse)

Load a .txt colormap with RGB integers separated by spaces on each line. Remark: if no path is indicated in filename, the .txt must be present at the root of the fpm project of the user.

Type Bound

Colormap

Arguments

Type IntentOptional Attributes Name
class(Colormap), intent(inout) :: self
character(len=*), intent(in) :: filename
real(kind=wp), intent(in) :: zmin
real(kind=wp), intent(in) :: zmax
logical, intent(in), optional :: reverse

Calls

proc~~load~~CallsGraph proc~load Colormap%load proc~check Colormap%check proc~load->proc~check proc~reverse Colormap%reverse proc~load->proc~reverse 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~~load~~CalledByGraph proc~load Colormap%load program~demo demo program~demo->proc~load program~demo_reverse demo_reverse program~demo_reverse->proc~load program~example1 example1 program~example1->proc~load

Source Code

    impure subroutine load(self, filename, zmin, zmax, reverse)
        class(Colormap), intent(inout) :: self
        character(*), intent(in) :: filename
        real(wp), intent(in) :: zmin, zmax
        logical, intent(in), optional :: reverse
        integer :: i, n
        integer :: red, green, blue
        logical :: file_found
        integer :: file_unit, ios

        inquire(file=filename, exist=file_found)

        if (file_found) then
            ! We first count the number of lines (RGB triplets):
            n = 0
            open(newunit=file_unit, file=filename)
            do
                read(file_unit, '(3I3)', iostat=ios) red, green, blue
                if (ios /= 0) exit
                n = n + 1
            end do
            close(file_unit)

            ! Is the colormap reseted?
            if (allocated(self%map)) then
                deallocate(self%map)
            end if
            allocate(self%map(0:n-1, 1:3))

            ! Then we read them and put them in the map:
            open(newunit=file_unit,  file=filename)
            do i = 0, n-1
                read(file_unit, *, iostat=ios) red, green, blue
                self%map(i, 1:3) = [red, green, blue]
                ! Should not happen:
                if (ios /= 0) exit
            end do
            close(file_unit)

            self%name   = trim(filename)
            self%zmin   = zmin
            self%zmax   = zmax
            self%levels = n

            call self%check(check_bounds=.true.)

            ! Reverse the colormap if requested
            if (present(reverse)) then
                if (reverse) call self%reverse()
            end if
        else
            stop "ERROR: COLORMAP FILE NOT FOUND!"
        end if
    end subroutine load