PLplot 5.15.0
plplot_single.f90
Go to the documentation of this file.
1!***********************************************************************
2! plplot_single.f90
3!
4! Copyright (C) 2005-2016 Arjen Markus
5! Copyright (C) 2006-2016 Alan W. Irwin
6!
7! This file is part of PLplot.
8!
9! PLplot is free software; you can redistribute it and/or modify
10! it under the terms of the GNU Library General Public License as published
11! by the Free Software Foundation; either version 2 of the License, or
12! (at your option) any later version.
13!
14! PLplot is distributed in the hope that it will be useful,
15! but WITHOUT ANY WARRANTY; without even the implied warranty of
16! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17! GNU Library General Public License for more details.
18!
19! You should have received a copy of the GNU Library General Public License
20! along with PLplot; if not, write to the Free Software
21! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22!
23!
24!***********************************************************************
25
27 use iso_c_binding, only: c_ptr, c_char, c_null_char, c_null_ptr, c_loc, c_funptr, c_null_funptr, c_funloc, &
28 c_associated
29 use iso_fortran_env, only: error_unit
33 implicit none
34
35 integer, parameter :: wp = private_single
36 private :: c_ptr, c_char, c_null_char, c_null_ptr, c_loc, c_funptr, c_null_funptr, c_funloc
37 private :: error_unit
38 private :: private_plflt, private_plint, private_plbool, private_single, plcgrid, plfgrid
39 private :: character_array_to_c
40 private :: wp
41
42 ! Private interfaces for wp-precision callbacks
44
45 include 'included_plplot_real_interfaces.f90'
46
47 ! plflt-precision callback routines that are called from C and which wrap a call to wp-precision Fortran routines.
48
49 subroutine plmapformf2c( n, x, y ) bind(c, name = 'plplot_single_private_plmapformf2c')
50 integer(kind=private_plint), value, intent(in) :: n
51 real(kind=private_plflt), dimension(n), intent(inout) :: x, y
52
53 real(kind=wp), dimension(:), allocatable :: x_inout, y_inout
54
55 allocate(x_inout(n), y_inout(n))
56
57 x_inout = real(x, kind=wp)
58 y_inout = real(y, kind=wp)
59
60 call plmapform( x_inout, y_inout )
61 x = real(x_inout, kind=private_plflt)
62 y = real(y_inout, kind=private_plflt)
63 end subroutine plmapformf2c
64
65 subroutine pllabelerf2c( axis, value, label, length, data ) bind(c, name = 'plplot_single_private_pllabelerf2c')
66 integer(kind=private_plint), value, intent(in) :: axis, length
67 real(kind=private_plflt), value, intent(in) :: value
68 character(len=1), dimension(*), intent(out) :: label
69 type(c_ptr), value, intent(in) :: data
70
71 character(len=:), allocatable :: label_out
72 integer :: trimmed_length
73
74 if ( c_associated(data) ) then
75 write(*,*) 'PLPlot: error in pllabelerf2c - data argument should be NULL'
76 stop
77 endif
78
79 allocate(character(length) :: label_out)
80 call pllabeler( int(axis), real(value,kind=wp), label_out )
81 trimmed_length = min(length,len_trim(label_out) + 1)
82 label(1:trimmed_length) = transfer(trim(label_out(1:length))//c_null_char, " ", trimmed_length)
83 deallocate(label_out)
84 end subroutine pllabelerf2c
85
86 subroutine pllabelerf2c_data( axis, value, label, length, data ) bind(c, name = 'plplot_single_private_pllabelerf2c_data')
87 integer(kind=private_plint), value, intent(in) :: axis, length
88 real(kind=private_plflt), value, intent(in) :: value
89 character(len=1), dimension(*), intent(out) :: label
90 type(c_ptr), value, intent(in) :: data
91
92 character(len=:), allocatable :: label_out
93 integer :: trimmed_length
94
95 allocate(character(length) :: label_out)
96 call pllabeler_data( int(axis), real(value,kind=wp), label_out, data )
97 trimmed_length = min(length,len_trim(label_out) + 1)
98 label(1:trimmed_length) = transfer(trim(label_out(1:length))//c_null_char, " ", trimmed_length)
99 deallocate(label_out)
100 end subroutine pllabelerf2c_data
101
102 subroutine pltransformf2c( x, y, tx, ty, data ) bind(c, name = 'plplot_single_private_pltransformf2c')
103 real(kind=private_plflt), value, intent(in) :: x, y
104 real(kind=private_plflt), intent(out) :: tx, ty
105 type(c_ptr), value, intent(in) :: data
106
107 real(kind=wp) :: tx_out, ty_out
108
109 if ( c_associated(data) ) then
110 write(*,*) 'PLPlot: error in pltransfrom2c - data argument should be NULL'
111 stop
112 endif
113
114 call pltransform( real(x,kind=wp), real(y,kind=wp), tx_out, ty_out )
115 tx = tx_out
116 ty = ty_out
117 end subroutine pltransformf2c
118
119 subroutine pltransformf2c_data( x, y, tx, ty, data ) bind(c, name = 'plplot_single_private_pltransformf2c_data')
120 real(kind=private_plflt), value, intent(in) :: x, y
121 real(kind=private_plflt), intent(out) :: tx, ty
122 type(c_ptr), value, intent(in) :: data
123
124 real(kind=wp) :: tx_out, ty_out
125
126 call pltransform_data( real(x,kind=wp), real(y,kind=wp), tx_out, ty_out, data )
127 tx = tx_out
128 ty = ty_out
129 end subroutine pltransformf2c_data
130
131end module plplot_single
subroutine character_array_to_c(cstring_array, cstring_address, character_array)
integer, parameter, private wp
subroutine, private pltransformf2c_data(x, y, tx, ty, data)
subroutine, private pllabelerf2c_data(axis, value, label, length, data)
subroutine, private pltransformf2c(x, y, tx, ty, data)
subroutine, private pllabelerf2c(axis, value, label, length, data)
subroutine, private plmapformf2c(n, x, y)
integer, parameter private_plbool
integer, parameter private_plint
integer, parameter private_single
#define min(x, y)
Definition: nnpi.c:87