PLplot: plplot_small_modules.f90 Source File

PLplot 5.15.0

plplot_small_modules.f90
Go to the documentation of this file.
1 !***********************************************************************
2 ! plplot_small_modules.f90
3 !
4 ! Copyright (C) 2005-2016 Arjen Markus
5 ! Copyright (C) 2006-2018 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
26 module plplot_types
27 use iso_c_binding, only: c_ptr, c_int32_t, c_float, c_double
28 implicit none
29 private :: c_ptr, c_int32_t, c_float, c_double
30
31 ! Specify Fortran types used by the various modules below.
32
33 ! N.B. It is those modules' responsibility to keep these precision values
34 ! private.
35
36 ! These types are used along with function overloading so that
37 ! applications do not need a specific real type at all (under the
38 ! constraint that all real arguments must have consistent real type
39 ! for a particular call to a routine in the Fortran binding of
40 ! PLplot.)
41
42 ! This include file only defines the private_plflt parameter at the
43 ! moment which is configured to be either c_float or c_double
44 ! to agree with the configured real precision (PLFLT) of the PLplot
45 ! C library.
46 include 'included_plplot_configured_types.f90'
47
48 ! The idea here is to match the Fortran integer type with the
49 ! corresponding C types for PLINT (normally int32_t), PLBOOL
50 ! (currently typedefed to PLINT) and PLUNICODE (normally
51 ! uint32_t). In the past we have used 4 for this purpose with
52 ! good success for both the gfortran and Intel compilers. That
53 ! is, kind=4 corresponded to 4-byte integers for those compilers.
54 ! But kind=4 may not do that for other compilers so we are now
55 ! using a more standards-compliant approach as recommended by
56 ! Wadud Miah of the NAG group.
57
58 ! The kind c_int32_t defined in ISO_C_BINDING is meant to match the
59 ! C type int32_t, which is used for PLINT and PLBOOL. As there
60 ! is no equivalent for unsigned integers in Fortran, we use this
61 ! kind for PLUNICODE as well.
62 integer, parameter :: private_plint = c_int32_t
63 integer, parameter :: private_plbool = c_int32_t
64 integer, parameter :: private_plunicode = c_int32_t
65
66 ! Define parameters for specific real precisions, so that we can
67 ! specify equivalent interfaces for all precisions (kinds)
68 integer, parameter :: private_single = c_float
69 integer, parameter :: private_double = c_double
70
71 ! The PLfGrid and PLcGrid types transfer information about a multidimensional
72 ! array to the plcontour/plshade family of routines.
73
74 type, bind(c) :: plfgrid
75 type(c_ptr) :: f
76 integer(kind=private_plint) :: nx, ny, nz
77 end type plfgrid
78
79 type, bind(c) :: plcgrid
80 type(c_ptr) :: xg, yg, zg
81 integer(kind=private_plint) :: nx, ny, nz
82 end type plcgrid
83
84 end module plplot_types
85
86 module plplot_private_utilities
87 use iso_c_binding, only: c_ptr, c_char, c_null_char, c_loc, c_size_t, c_f_pointer
88 use iso_fortran_env, only: error_unit
89 implicit none
90 private :: c_ptr, c_char, c_null_char, c_loc, c_size_t, c_f_pointer, error_unit
91
92 ! Normally interface blocks describing the C routines that are
93 ! called by this Fortran binding are embedded as part of module
94 ! procedures, but when more than one module procedure uses such
95 ! interface blocks there is a requirement (enforced at least by
96 ! the nagfor compiler) that those interface blocks be consistent.
97 ! We could comply with that requirement by embedding such multiply
98 ! used interface blocks as part of module procedures using
99 ! duplicated code, but that is inefficient (in terms of the number
100 ! of lines of code to be compiled) and implies a maintenance issue
101 ! (to keep that code duplicated whenever there are changes on the
102 ! C side). To deal with those two potential issues we collect
103 ! here in alphabetical order all interface blocks describing C
104 ! routines that are called directly by more than one module
105 ! procedure below.
106 interface
107 ! Use standard C library function strlen to determine C string length excluding terminating NULL.
108 function interface_strlen(s) bind(c, name='strlen')
109 import c_ptr, c_size_t
110 implicit none
111 integer(c_size_t) :: interface_strlen
112 type(c_ptr), intent(in), value :: s
113 end function interface_strlen
114 end interface
115 private :: interface_strlen
116
117 contains
118
119 subroutine character_array_to_c( cstring_array, cstring_address, character_array )
120 ! Translate from Fortran character_array to an array of C strings (cstring_array), where the
121 ! address of the start of each C string is stored in the cstring_address vector.
122 ! N.B. cstring_array is only an argument to keep those allocatable data in scope for the calling
123 ! routine.
124 character(len=*), dimension(:), intent(in) :: character_array
125 character(len=1), dimension(:,:), allocatable, target, intent(out) :: cstring_array
126 type(c_ptr), dimension(:), allocatable, intent(out) :: cstring_address
127
128 integer :: j_local, length_local, number_local, length_column_local
129
130 ! length of character string
131 length_local = len(character_array)
132 ! number of character strings in array
133 number_local = size(character_array)
134
135 ! Leave room for trailing c_null_char if the Fortran character string is
136 ! filled with non-blank characters to the end.
137 allocate( cstring_array(length_local+1, number_local) )
138 allocate( cstring_address(number_local) )
139
140 do j_local = 1, number_local
141 length_column_local = len(trim(character_array(j_local))) + 1
142 ! Drop all trailing blanks in Fortran character string when converting to C string.
143 cstring_array(1:length_column_local, j_local) = &
144 transfer(trim(character_array(j_local))//c_null_char, " ", length_column_local)
145 cstring_address(j_local) = c_loc(cstring_array(1,j_local))
146 enddo
147
148 end subroutine character_array_to_c
149
150 function c_to_character_array( character_array, cstring_address_array )
151 ! Translate from an array of pointers to NULL-terminated C strings (cstring_address_array)
152 ! to a Fortran character array (character_array).
153 integer :: c_to_character_array
154 character(len=*), dimension(:), intent(out) :: character_array
155 type(c_ptr), dimension(:), intent(in) :: cstring_address_array
156
157 integer :: i_local, j_local, length_local, number_local, length_column_local
158 ! Array for accessing string pointed to by an element of cstring_address_array
159 character(kind=c_char), pointer :: string_ptr(:)
160
161 length_local = len(character_array)
162 number_local = size(cstring_address_array)
163 if(number_local > size(character_array)) then
164 write(error_unit, *) "Error in c_to_character_array: size of character_array too small to hold converted result."
165 endif
166
167 do j_local = 1, number_local
168 length_column_local = interface_strlen(cstring_address_array(j_local))
169 if(length_column_local > length_local) then
170 write(error_unit, *) &
171 "Error in c_to_character_array: length of character_array too small to hold converted result."
172 c_to_character_array = 1
173 return
174 endif
175 ! Copy contents of string addressed by cstring_address_array(j_local) and of
176 ! length length_column_local to string_ptr pointer array which
177 ! is dynamically allocated as needed.
178 call c_f_pointer(cstring_address_array(j_local), string_ptr, [length_column_local])
179 do i_local = 1, length_column_local
180 character_array(j_local)(i_local:i_local) = string_ptr(i_local)
181 enddo
182 ! append blanks to character_array element
183 character_array(j_local)(length_column_local+1:) = " "
184 enddo
185 c_to_character_array = 0
186 end function c_to_character_array
187
188 subroutine copystring2f( fstring, cstring )
189 character(len=*), intent(out) :: fstring
190 character(len=1), dimension(:), intent(in) :: cstring
191
192 integer :: i_local
193
194 fstring = ' '
195 do i_local = 1,min(len(fstring),size(cstring))
196 if ( cstring(i_local) /= c_null_char ) then
197 fstring(i_local:i_local) = cstring(i_local)
198 else
199 exit
200 endif
201 enddo
202 end subroutine copystring2f
203
204 function max_cstring_length(cstring_address_array)
205 ! Find maximum length (excluding the NULL-terminating character)
206 ! of the C strings pointed to by cstring_address_array
207 integer :: max_cstring_length
208 type(c_ptr), dimension(:), intent(in) :: cstring_address_array
209
210 integer :: j_local, number_local
211 number_local = size(cstring_address_array)
212
213 max_cstring_length = 0
214 do j_local = 1, number_local
215 max_cstring_length = max(max_cstring_length, interface_strlen(cstring_address_array(j_local)))
216 enddo
217 end function max_cstring_length
218
219 end module plplot_private_utilities
220
221 module plplot_graphics
222 use plplot_types, only: private_plint, private_plflt, private_double
223 use plplot_private_utilities, only: copystring2f
224 implicit none
225 private :: private_plint, private_plflt, private_double
226
227 ! This is a public derived Fortran type that contains all the
228 ! information in private_PLGraphicsIn below, but in standard
229 ! Fortran form rather than C form.
230 type :: plgraphicsin
231 integer :: type ! of event (CURRENTLY UNUSED)
232 integer :: state ! key or button mask
233 integer :: keysym ! key selected
234 integer :: button ! mouse button selected
235 integer :: subwindow ! subwindow (alias subpage, alias subplot) number
236 character(len=16) :: string ! Fortran character string
237 integer :: px, py ! absolute device coordinates of pointer
238 real(kind=private_double) :: dx, dy ! relative device coordinates of pointer
239 real(kind=private_double) :: wx, wy ! world coordinates of pointer
240 end type plgraphicsin
241
242 interface plgetcursor
243 module procedure plgetcursor_impl
244 end interface plgetcursor
245 private :: plgetcursor_impl
246
247 contains
248
249 function plgetcursor_impl( gin )
250
251 ! According to a gfortran build error message the combination of bind(c) and
252 ! private attributes is not allowed for a derived type so to keep
253 ! private_PLGraphicsIn actually private declare it inside the function
254 ! rather than before the contains.
255
256 ! This derived type is a direct equivalent of the C struct because
257 ! of the bind(c) attribute and interoperable nature of all the
258 ! types. (See <https://gcc.gnu.org/onlinedocs/gfortran/Derived-Types-and-struct.html> for
259 ! further discussion.)
260
261 ! Note the good alignment (offset is a multiple of 8 bytes) of the
262 ! trailing dX, dY, wX, and wY for the case when private_plflt refers
263 ! to double precision.
264 type, bind(c) :: private_PLGraphicsIn
265 integer(kind=private_plint) :: type ! of event (CURRENTLY UNUSED)
266 integer(kind=private_plint) :: state ! key or button mask
267 integer(kind=private_plint) :: keysym ! key selected
268 integer(kind=private_plint) :: button ! mouse button selected
269 integer(kind=private_plint) :: subwindow ! subwindow (alias subpage, alias subplot) number
270 character(len=1), dimension(16) :: string ! NULL-terminated character string
271 integer(kind=private_plint) :: pX, pY ! absolute device coordinates of pointer
272 real(kind=private_plflt) :: dX, dY ! relative device coordinates of pointer
273 real(kind=private_plflt) :: wX, wY ! world coordinates of pointer
274 end type private_plgraphicsin
275
276
277 type(plgraphicsin), intent(out) :: gin
278 integer :: plGetCursor_impl !function type
279
280 type(private_plgraphicsin) :: gin_out
281
282 interface
283 function interface_plgetcursor( gin ) bind(c,name='plGetCursor')
284 import :: private_plgraphicsin, private_plint
285 implicit none
286 integer(kind=private_plint) :: interface_plGetCursor !function type
287 type(private_plgraphicsin), intent(out) :: gin
288 end function interface_plgetcursor
289 end interface
290
291 plgetcursor_impl = int(interface_plgetcursor( gin_out ))
292 ! Copy all gin_out elements to corresponding gin elements with
293 ! appropriate type conversions.
294 gin%type = int(gin_out%type)
295 gin%state = int(gin_out%state)
296 gin%keysym = int(gin_out%keysym)
297 gin%button = int(gin_out%button)
298 gin%subwindow = int(gin_out%subwindow)
299 call copystring2f( gin%string, gin_out%string )
300 gin%pX = int(gin_out%pX)
301 gin%pY = int(gin_out%pY)
302 gin%dX = real(gin_out%dx, kind=private_double)
303 gin%dY = real(gin_out%dy, kind=private_double)
304 gin%wX = real(gin_out%wx, kind=private_double)
305 gin%wY = real(gin_out%wy, kind=private_double)
306 end function plgetcursor_impl
307
308 end module plplot_graphics
309
310 ! The bind(c) attribute exposes the pltr routine which ought to be private
311 module plplot_private_exposed
312 use iso_c_binding, only: c_ptr, c_f_pointer
313 use plplot_types, only: private_plflt
314 implicit none
315 private :: c_ptr, private_plflt
316 contains
317 subroutine plplot_private_pltr( x, y, tx, ty, tr_in ) bind(c)
318 real(kind=private_plflt), value, intent(in) :: x, y
319 real(kind=private_plflt), intent(out) :: tx, ty
320 type(c_ptr), value, intent(in) :: tr_in
321
322 real(kind=private_plflt), dimension(:), pointer :: tr
323
324 call c_f_pointer( tr_in, tr, [6] )
325
326 tx = tr(1) * x + tr(2) * y + tr(3)
327 ty = tr(4) * x + tr(5) * y + tr(6)
328 end subroutine plplot_private_pltr
329
330 end module plplot_private_exposed
plplot_types::private_single
integer, parameter private_single
Definition: plplot_small_modules.f90:68
plplot_types::plcgrid
Definition: plplot_small_modules.f90:79
plplot_graphics::plgetcursor
Definition: plplot_small_modules.f90:242
plplot_graphics::plgraphicsin
Definition: plplot_small_modules.f90:230
plplot_types::private_double
integer, parameter private_double
Definition: plplot_small_modules.f90:69
plplot_types::private_plunicode
integer, parameter private_plunicode
Definition: plplot_small_modules.f90:64
plplot_private_utilities::interface_strlen
Definition: plplot_small_modules.f90:108
plplot_types::plfgrid
Definition: plplot_small_modules.f90:74
plplot_private_utilities::max_cstring_length
integer function max_cstring_length(cstring_address_array)
Definition: plplot_small_modules.f90:205
plplot_private_exposed
Definition: plplot_small_modules.f90:311
plplot_types::private_plbool
integer, parameter private_plbool
Definition: plplot_small_modules.f90:63
plplot_private_exposed::plplot_private_pltr
subroutine plplot_private_pltr(x, y, tx, ty, tr_in)
Definition: plplot_small_modules.f90:318
plplot_types
Definition: plplot_small_modules.f90:26
plplot_types::private_plint
integer, parameter private_plint
Definition: plplot_small_modules.f90:62
plplot_private_utilities::copystring2f
subroutine copystring2f(fstring, cstring)
Definition: plplot_small_modules.f90:189
plplot_graphics::plgetcursor_impl
integer function, private plgetcursor_impl(gin)
Definition: plplot_small_modules.f90:250
plplot_private_utilities
Definition: plplot_small_modules.f90:86
plplot_private_utilities::character_array_to_c
subroutine character_array_to_c(cstring_array, cstring_address, character_array)
Definition: plplot_small_modules.f90:120
min
#define min(x, y)
Definition: nnpi.c:87
max
#define max(x, y)
Definition: nnpi.c:88
plplot_private_utilities::c_to_character_array
integer function c_to_character_array(character_array, cstring_address_array)
Definition: plplot_small_modules.f90:151
plplot_graphics
Definition: plplot_small_modules.f90:221