plplot_single.f90

Go to the documentation of this file.

!***********************************************************************
!  plplot_single.f90
!
!  Copyright (C) 2005-2016  Arjen Markus
!  Copyright (C) 2006-2016 Alan W. Irwin
!
!  This file is part of PLplot.
!
!  PLplot is free software; you can redistribute it and/or modify
!  it under the terms of the GNU Library General Public License as published
!  by the Free Software Foundation; either version 2 of the License, or
!  (at your option) any later version.
!
!  PLplot is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU Library General Public License for more details.
!
!  You should have received a copy of the GNU Library General Public License
!  along with PLplot; if not, write to the Free Software
!  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
!
!
!***********************************************************************

module plplot_single
    use iso_c_binding, only: c_ptr, c_char, c_null_char, c_null_ptr, c_loc,  c_funptr, c_null_funptr, c_funloc, &
        c_associated
    use iso_fortran_env, only: error_unit
    use plplot_types, only: private_plflt, private_plint, private_plbool, private_single, plcgrid, plfgrid
    use plplot_private_exposed
    use plplot_private_utilities, only: character_array_to_c
    implicit none

    integer, parameter :: wp = private_single
    private :: c_ptr, c_char, c_null_char, c_null_ptr, c_loc, c_funptr, c_null_funptr, c_funloc
    private :: error_unit
    private :: private_plflt, private_plint, private_plbool, private_single, plcgrid, plfgrid
    private :: character_array_to_c
    private :: wp

    ! Private interfaces for wp-precision callbacks
    private :: plmapformf2c, pllabelerf2c, pllabelerf2c_data, pltransformf2c, pltransformf2c_data

    include 'included_plplot_real_interfaces.f90'

    ! plflt-precision callback routines that are called from C and which wrap a call to wp-precision Fortran routines.

    subroutine plmapformf2c( n, x, y ) bind(c, name = 'plplot_single_private_plmapformf2c')
        integer(kind=private_plint), value, intent(in) :: n
        real(kind=private_plflt), dimension(n), intent(inout) :: x, y

        real(kind=wp), dimension(:), allocatable :: x_inout, y_inout

        allocate(x_inout(n), y_inout(n))

        x_inout = real(x, kind=wp)
        y_inout = real(y, kind=wp)

        call plmapform( x_inout, y_inout )
        x = real(x_inout, kind=private_plflt)
        y = real(y_inout, kind=private_plflt)
    end subroutine plmapformf2c

    subroutine pllabelerf2c( axis, value, label, length, data ) bind(c, name = 'plplot_single_private_pllabelerf2c')
        integer(kind=private_plint), value, intent(in) :: axis, length
        real(kind=private_plflt), value, intent(in) :: value
        character(len=1), dimension(*), intent(out) :: label
        type(c_ptr), value, intent(in) :: data

        character(len=:), allocatable :: label_out
        integer :: trimmed_length

        if ( c_associated(data) ) then
            write(*,*) 'PLPlot: error in pllabelerf2c - data argument should be NULL'
            stop
        endif

        allocate(character(length) :: label_out)
        call pllabeler( int(axis), real(value,kind=wp), label_out )
        trimmed_length = min(length,len_trim(label_out) + 1)
        label(1:trimmed_length) = transfer(trim(label_out(1:length))//c_null_char, " ", trimmed_length)
        deallocate(label_out)
    end subroutine pllabelerf2c

    subroutine pllabelerf2c_data( axis, value, label, length, data ) bind(c, name = 'plplot_single_private_pllabelerf2c_data')
        integer(kind=private_plint), value, intent(in) :: axis, length
        real(kind=private_plflt), value, intent(in) :: value
        character(len=1), dimension(*), intent(out) :: label
        type(c_ptr), value, intent(in) :: data

        character(len=:), allocatable :: label_out
        integer :: trimmed_length

        allocate(character(length) :: label_out)
        call pllabeler_data( int(axis), real(value,kind=wp), label_out, data )
        trimmed_length = min(length,len_trim(label_out) + 1)
        label(1:trimmed_length) = transfer(trim(label_out(1:length))//c_null_char, " ", trimmed_length)
        deallocate(label_out)
    end subroutine pllabelerf2c_data

    subroutine pltransformf2c( x, y, tx, ty, data ) bind(c, name = 'plplot_single_private_pltransformf2c')
        real(kind=private_plflt), value, intent(in) :: x, y
        real(kind=private_plflt), intent(out) :: tx, ty
        type(c_ptr), value, intent(in) :: data

        real(kind=wp) :: tx_out, ty_out

        if ( c_associated(data) ) then
            write(*,*) 'PLPlot: error in pltransfrom2c - data argument should be NULL'
            stop
        endif

        call pltransform( real(x,kind=wp), real(y,kind=wp), tx_out, ty_out )
        tx = tx_out
        ty = ty_out
    end subroutine pltransformf2c

    subroutine pltransformf2c_data( x, y, tx, ty, data ) bind(c, name = 'plplot_single_private_pltransformf2c_data')
        real(kind=private_plflt), value, intent(in) :: x, y
        real(kind=private_plflt), intent(out) :: tx, ty
        type(c_ptr), value, intent(in) :: data

        real(kind=wp) :: tx_out, ty_out

        call pltransform_data( real(x,kind=wp), real(y,kind=wp), tx_out, ty_out, data )
        tx = tx_out
        ty = ty_out
    end subroutine pltransformf2c_data

end module plplot_single