FortranGIS Version 3.0
shapelib.F90
1! Copyright 2011 Davide Cesari <dcesari69 at gmail dot com>
2!
3! This file is part of FortranGIS.
4!
5! FortranGIS is free software: you can redistribute it and/or modify
6! it under the terms of the GNU Lesser General Public License as
7! published by the Free Software Foundation, either version 3 of the
8! License, or (at your option) any later version.
9!
10! FortranGIS is distributed in the hope that it will be useful, but
11! WITHOUT ANY WARRANTY; without even the implied warranty of
12! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13! Lesser General Public License for more details.
14!
15! You should have received a copy of the GNU Lesser General Public
16! License along with FortranGIS. If not, see
17! <http://www.gnu.org/licenses/>.
18
19!> Fortran 2003 interface to the shapelib http://shapelib.maptools.org/
20!! library.
21!! This module defines an API which reflects the original shapelib C
22!! API with some modifications:
23!!
24!! - \a shpopen, \a shpcreate and \a shpclose functions act also on
25!! .dbf files
26!! - \a shpgetinfo accesses also .dbf information
27!! - the \a DBFRead*Attribute and \a DBWrite*Attribute are converted
28!! into two f90 interfaces called \a dbfreadattribute and \a
29!! dbwriteattribute respectively.
30!!
31!! The module defines two derived types: \a shpfileobject associated
32!! to a shapefile dataset, and \a shpobject associated to a single
33!! shape within a dataset. Access to database (.dbf) information is
34!! done by accessing the file object only.
35!!
36!! For an example of application of the \a shapelib module, please
37!! refer to the following test program, which creates a shapefile and
38!! successively reads it:
39!! \include shapelib_test.F90
40!!
41!! \ingroup libfortrangis
42MODULE shapelib
43use,INTRINSIC :: iso_c_binding
44USE fortranc
45IMPLICIT NONE
46
47INTEGER,PARAMETER :: shpt_null = 0 !< Series of constants for specifying type of new shape datasets with \a shpcreate, null shape
48INTEGER,PARAMETER :: shpt_point = 1 !< points
49INTEGER,PARAMETER :: shpt_arc = 3 !< arcs (Polylines, possible in parts)
50INTEGER,PARAMETER :: shpt_polygon = 5 !< polygons (possible in parts)
51INTEGER,PARAMETER :: shpt_multipoint = 8 !< multiPoint (related points)
52INTEGER,PARAMETER :: shpt_pointz = 11 !< 3D (+ measure) points
53INTEGER,PARAMETER :: shpt_arcz = 13 !< 3D (+ measure) arcs
54INTEGER,PARAMETER :: shpt_polygonz = 15 !< 3D (+ measure) polygons
55INTEGER,PARAMETER :: shpt_multipointz = 18 !< 3D (+ measure) multiPoint
56INTEGER,PARAMETER :: shpt_pointm = 21 !< 2D + measure points
57INTEGER,PARAMETER :: shpt_arcm = 23 !< 2D + measure arcs
58INTEGER,PARAMETER :: shpt_polygonm = 25 !< 2D + measure polygons
59INTEGER,PARAMETER :: shpt_multipointm = 28 !< 2D + measure multiPoint
61INTEGER,PARAMETER :: shpt_multipatch = 31 !< complex (TIN-like) with Z, and Measure
63INTEGER,PARAMETER :: ftstring = 0 !< Series of constants for specifying dbf field type, fixed length string field
64INTEGER,PARAMETER :: ftinteger = 1 !< numeric field with no decimals
65INTEGER,PARAMETER :: ftdouble = 2 !< numeric field with decimals
66INTEGER,PARAMETER :: ftlogical = 3 !< LOGICAL field
67INTEGER,PARAMETER :: ftinvalid = 4 !< not a recognised field TYPE
70!> Object describing a shapefile dataset.
71!! Its components are private so they should not be manipulated
72!! directly.
74 PRIVATE
75 TYPE(c_ptr) :: shpfile_orig=c_null_ptr
76 TYPE(c_ptr) :: dbffile_orig=c_null_ptr
79
80!> Object describing the geometrical properties of a shape.
81!! It is used for reading a shape, or for manipulating a newly created
82!! shape; in the latter case the single values can be changed, but not
83!! the size of the arrays.
85 TYPE(c_ptr) :: shpobject_orig=c_null_ptr !< pointer to C information, it should not be used
86 INTEGER :: nshptype=0 !< shape type, one of the \a shpt_* constants defined
87 INTEGER :: nshapeid=-1 !< shape number (-1 is unknown/unassigned)
88 INTEGER :: nparts=0 !< number of parts (0 implies single part with no info)
89 INTEGER,POINTER :: panpartstart(:)=>null() !< starting vertex of each part
90 INTEGER,POINTER :: panparttype(:)=>null() !< part type (SHPP_RING if not SHPT_MULTIPATCH)
91 INTEGER :: nvertices !< number of vertices
92 REAL(kind=c_double),POINTER :: padfx(:)=>null() !< x coordinates of vertices
93 REAL(kind=c_double),POINTER :: padfy(:)=>null() !< y coordinates of vertices
94 REAL(kind=c_double),POINTER :: padfz(:)=>null() !< z coordinates of vertices
95 REAL(kind=c_double),POINTER :: padfm(:)=>null() !< measure of vertices
96 REAL(kind=c_double) :: dfxmin=0.0_c_double !< lower bound in x dimension
97 REAL(kind=c_double) :: dfymin=0.0_c_double !< lower bound in y dimension
98 REAL(kind=c_double) :: dfzmin=0.0_c_double !< lower bound in z dimension
99 REAL(kind=c_double) :: dfmmin=0.0_c_double !< lower bound in measure dimension
100 REAL(kind=c_double) :: dfxmax=0.0_c_double !< upper bound in x dimension
101 REAL(kind=c_double) :: dfymax=0.0_c_double !< upper bound in y dimension
102 REAL(kind=c_double) :: dfzmax=0.0_c_double !< upper bound in z dimension
103 REAL(kind=c_double) :: dfmmax=0.0_c_double !< upper bound in measure dimension
104END TYPE shpobject
106!TYPE(shpfileobject),PARAMETER :: shpfileobject_null = shpfileobject(0, 0)
107TYPE(shpobject),PARAMETER :: shpobject_null = shpobject(c_null_ptr, &
108 0, -1, 0, &
109 null(), null(), 0, null(), null(), null(), null(), &
110 0.0_c_double, 0.0_c_double, 0.0_c_double, 0.0_c_double, &
111 0.0_c_double, 0.0_c_double, 0.0_c_double, 0.0_c_double)
113!> Interface to SUBROUTINEs for reading dbf attributes.
114!! The type of the attribute can be either INTEGER,
115!! REAL(kind=c_double) (double) or CHARACTER. In case of CHARACTER
116!! attributes it is important that the length of the string passed is
117!! big enough to contain the attribute. The maximum length for each
118!! field can be obtained with the \a dbfgetfieldinfo function, but it
119!! is limited anyway to a maximum of 512 characters. The type of the
120!! attribute requested may not coincide with the native type of the
121!! field, if possible a conversion will be performed.
122!!
123!! \param hshp TYPE(shpfileobject),INTENT(inout) shapefile object to query
124!! \param ishape INTEGER,INTENT(in) the number of shape to query
125!! \param ifield INTEGER,INTENT(in) the number of field to query
126!! \param attr INTEGER, CHARACTER or REAL(kind=c_double), INTENT(out) the value of the attribute
127INTERFACE dbfreadattribute
128 MODULE PROCEDURE dbfreadintegerattribute_f, dbfreaddoubleattribute_f, &
129 dbfreadstringattribute_f
130END INTERFACE
131
132
133!> Interface to FUNCTIONs for setting dbf attributes.
134!! The type of the attribute can be either INTEGER,
135!! REAL(kind=c_double) (double) or CHARACTER. The type of the
136!! attribute provided may not coincide with the native type of the
137!! field, if possible a conversion will be performed. If the \a attr
138!! parameter is not provided the attribute will be set to a null
139!! value.
140!!
141!! \param hshp TYPE(shpfileobject),INTENT(inout) shapefile object to set
142!! \param ishape INTEGER,INTENT(in) the number of shape to set
143!! \param ifield INTEGER,INTENT(in) the number of field to set
144!! \param attr INTEGER, CHARACTER or REAL(kind=c_double), INTENT(in) the value of the attribute to set
145INTERFACE dbfwriteattribute
146 MODULE PROCEDURE dbfwriteintegerattribute_f, dbfwritedoubleattribute_f, &
147 dbfwritestringattribute_f, dbfwritenullattribute_f
148END INTERFACE
149
150
151INTERFACE
152 FUNCTION shpopen_orig(pszlayer, pszaccess) bind(C,name='SHPOpen')
153 IMPORT
154 CHARACTER(kind=c_char) :: pszlayer(*)
155 CHARACTER(kind=c_char) :: pszaccess(*)
156 TYPE(c_ptr) :: shpopen_orig
157 END FUNCTION shpopen_orig
158
159 SUBROUTINE shpclose_orig(psshp) bind(C,name='SHPClose')
160 IMPORT
161 TYPE(c_ptr),VALUE :: psshp
162 END SUBROUTINE shpclose_orig
163
164 SUBROUTINE shpgetinfo_orig(psshp, pnentities, pnshapetype, padfminbound, padfmaxbound) bind(C,name='SHPGetInfo')
165 IMPORT
166 TYPE(c_ptr),VALUE :: psshp
167 INTEGER(kind=c_int) :: pnentities
168 INTEGER(kind=c_int) :: pnshapetype
169 REAL(kind=c_double) :: padfminbound(*)
170 REAL(kind=c_double) :: padfmaxbound(*)
171 END SUBROUTINE shpgetinfo_orig
172
173 FUNCTION shpcreate_orig(pszlayer, nshapetype) bind(C,name='SHPCreate')
174 IMPORT
175 CHARACTER(kind=c_char) :: pszlayer(*)
176 INTEGER(kind=c_int),VALUE :: nshapetype
177 TYPE(c_ptr) :: shpcreate_orig
178 END FUNCTION shpcreate_orig
179
180 SUBROUTINE shpcomputeextents_int(psobject, ftnobject) bind(C,name='SHPComputeExtentsInt')
181 IMPORT
182 TYPE(c_ptr),VALUE :: psobject
183 TYPE(c_ptr),VALUE :: ftnobject
184 END SUBROUTINE shpcomputeextents_int
185
186 FUNCTION shpcreateobject_int(nshptype, nshapeid, nparts, panpartstart, panparttype, &
187 nvertices, padfx, padfy, padfz, padfm, ftnobject) bind(C,name='SHPCreateObjectInt')
188 IMPORT
189 INTEGER(kind=c_int),VALUE :: nshptype
190 INTEGER(kind=c_int),VALUE :: nshapeid
191 INTEGER(kind=c_int),VALUE :: nparts
192 INTEGER(kind=c_int) :: panpartstart(*)
193 INTEGER(kind=c_int) :: panparttype(*)
194 INTEGER(kind=c_int),VALUE :: nvertices
195 REAL(kind=c_double) :: padfx(*)
196 REAL(kind=c_double) :: padfy(*)
197 REAL(kind=c_double) :: padfz(*)
198 REAL(kind=c_double) :: padfm(*)
199 TYPE(c_ptr),VALUE :: ftnobject
200 INTEGER(kind=c_int) :: shpcreateobject_int
201 END FUNCTION shpcreateobject_int
202
203 FUNCTION shpcreatesimpleobject_int(nshptype, nvertices, padfx, padfy, padfz, ftnobject) bind(C,name='SHPCreateSimpleObjectInt')
204 IMPORT
205 INTEGER(kind=c_int),VALUE :: nshptype
206 INTEGER(kind=c_int),VALUE :: nvertices
207 REAL(kind=c_double) :: padfx(*)
208 REAL(kind=c_double) :: padfy(*)
209 REAL(kind=c_double) :: padfz(*)
210 TYPE(c_ptr),VALUE :: ftnobject
211 INTEGER(kind=c_int) :: shpcreatesimpleobject_int
212 END FUNCTION shpcreatesimpleobject_int
213
214 FUNCTION shpwriteobject_orig(psshp, nshapeid, psobject) bind(C,name='SHPWriteObject')
215 IMPORT
216 TYPE(c_ptr),VALUE :: psshp
217 INTEGER(kind=c_int),VALUE :: nshapeid
218 TYPE(c_ptr),VALUE :: psobject
219 INTEGER(kind=c_int) :: shpwriteobject_orig
220 END FUNCTION shpwriteobject_orig
221
222 FUNCTION shpreadobject_int(psshp, hentity, ftnobject) bind(C,name='SHPReadObjectInt')
223 IMPORT
224 TYPE(c_ptr),VALUE :: psshp
225 INTEGER(kind=c_int),VALUE :: hentity
226 TYPE(c_ptr),VALUE :: ftnobject
227 INTEGER(kind=c_int) :: shpreadobject_int
228 END FUNCTION shpreadobject_int
229
230 SUBROUTINE shpdestroyobject_orig(psshape) bind(C,name='SHPDestroyObject')
231 IMPORT
232 TYPE(c_ptr),VALUE :: psshape
233 END SUBROUTINE shpdestroyobject_orig
234
235#ifndef SHAPELIB_PRE10
236 FUNCTION shprewindobject_int(hshp, psobject, ftnobject) bind(C,name='SHPRewindObjectInt')
237 IMPORT
238 TYPE(c_ptr),VALUE :: hshp
239 TYPE(c_ptr),VALUE :: psobject
240 TYPE(c_ptr),VALUE :: ftnobject
241 INTEGER(kind=c_int) :: shprewindobject_int
242 END FUNCTION shprewindobject_int
243#endif
244END INTERFACE
245
246INTERFACE
247 FUNCTION dbfopen(pszfilename, pszaccess) bind(C,name='DBFOpen')
248 IMPORT
249 CHARACTER(kind=c_char) :: pszfilename(*)
250 CHARACTER(kind=c_char) :: pszaccess(*)
251 TYPE(c_ptr) :: dbfopen
252 END FUNCTION dbfopen
253
254 SUBROUTINE dbfclose(psdbf) bind(C,name='DBFClose')
255 IMPORT
256 TYPE(c_ptr),VALUE :: psdbf
257 END SUBROUTINE dbfclose
258
259 FUNCTION dbfcreate(pszfilename) bind(C,name='DBFCreate')
260 IMPORT
261 CHARACTER(kind=c_char) :: pszfilename(*)
262 TYPE(c_ptr) :: dbfcreate
263 END FUNCTION dbfcreate
264
265 FUNCTION dbfaddfield_orig(psdbf, pszfieldname, etype, nwidth, ndecimals) bind(C,name='DBFAddField')
266 IMPORT
267 TYPE(c_ptr),VALUE :: psdbf
268 CHARACTER(kind=c_char) :: pszfieldname(*)
269 INTEGER(kind=c_int),VALUE :: etype
270 INTEGER(kind=c_int),VALUE :: nwidth
271 INTEGER(kind=c_int),VALUE :: ndecimals
272 INTEGER(kind=c_int) :: dbfaddfield_orig
273 END FUNCTION dbfaddfield_orig
274
275 FUNCTION dbfreadintegerattribute_orig(psdbf, irecord, ifield) bind(C,name='DBFReadIntegerAttribute')
276 IMPORT
277 TYPE(c_ptr),VALUE :: psdbf
278 INTEGER(kind=c_int),VALUE :: irecord
279 INTEGER(kind=c_int),VALUE :: ifield
280 INTEGER(kind=c_int) :: dbfreadintegerattribute_orig
281 END FUNCTION dbfreadintegerattribute_orig
282
283 FUNCTION dbfreaddoubleattribute_orig(psdbf, irecord, ifield) bind(C,name='DBFReadDoubleAttribute')
284 IMPORT
285 TYPE(c_ptr),VALUE :: psdbf
286 INTEGER(kind=c_int),VALUE :: irecord
287 INTEGER(kind=c_int),VALUE :: ifield
288 REAL(kind=c_double) :: dbfreaddoubleattribute_orig
289 END FUNCTION dbfreaddoubleattribute_orig
290
291 FUNCTION dbfreadstringattribute_orig(psdbf, irecord, ifield) bind(C,name='DBFReadStringAttribute')
292 IMPORT
293 TYPE(c_ptr),VALUE :: psdbf
294 INTEGER(kind=c_int),VALUE :: irecord
295 INTEGER(kind=c_int),VALUE :: ifield
296 TYPE(c_ptr) :: dbfreadstringattribute_orig
297 END FUNCTION dbfreadstringattribute_orig
298
299 SUBROUTINE dbfreadstringattribute_int(psdbf, irecord, ifield, attr, lattr) bind(C,name='DBFReadStringAttributeInt')
300 IMPORT
301 TYPE(c_ptr),VALUE :: psdbf
302 INTEGER(kind=c_int),VALUE :: irecord
303 INTEGER(kind=c_int),VALUE :: ifield
304 CHARACTER(kind=c_char) :: attr(*)
305 INTEGER(kind=c_int),VALUE :: lattr
306 END SUBROUTINE dbfreadstringattribute_int
307
308 FUNCTION dbfreadlogicalattribute(psdbf, irecord, ifield) bind(C,name='DBFReadLogicalAttribute')
309 IMPORT
310 TYPE(c_ptr),VALUE :: psdbf
311 INTEGER(kind=c_int),VALUE :: irecord
312 INTEGER(kind=c_int),VALUE :: ifield
313 CHARACTER(kind=c_char) :: dbfreadlogicalattribute
314 END FUNCTION dbfreadlogicalattribute
315
316#ifndef SHAPELIB_PRE10
317 FUNCTION dbfisattributenull_orig(psdbf, irecord, ifield) bind(C,name='DBFIsAttributeNULL')
318 IMPORT
319 TYPE(c_ptr),VALUE :: psdbf
320 INTEGER(kind=c_int),VALUE :: irecord
321 INTEGER(kind=c_int),VALUE :: ifield
322 INTEGER(kind=c_int) :: dbfisattributenull_orig
323 END FUNCTION dbfisattributenull_orig
324#endif
325
326 FUNCTION dbfgetfieldcount(psdbf) bind(C,name='DBFGetFieldCount')
327 IMPORT
328 TYPE(c_ptr),VALUE :: psdbf
329 INTEGER(kind=c_int) :: dbfgetfieldcount
330 END FUNCTION dbfgetfieldcount
331
332 FUNCTION dbfgetrecordcount(psdbf) bind(C,name='DBFGetRecordCount')
333 IMPORT
334 TYPE(c_ptr),VALUE :: psdbf
335 INTEGER(kind=c_int) :: dbfgetrecordcount
336 END FUNCTION dbfgetrecordcount
337
338 FUNCTION dbfgetfieldinfo_orig(psdbf, ifield, pszfieldname, pnwidth, pndecimals) bind(C,name='DBFGetFieldInfo')
339 IMPORT
340 TYPE(c_ptr),VALUE :: psdbf
341 INTEGER(kind=c_int),VALUE :: ifield
342 CHARACTER(kind=c_char) :: pszfieldname(*)
343 INTEGER(kind=c_int) :: pnwidth
344 INTEGER(kind=c_int) :: pndecimals
345 INTEGER(kind=c_int) :: dbfgetfieldinfo_orig
346 END FUNCTION dbfgetfieldinfo_orig
347
348 FUNCTION dbfwritedoubleattribute(psdbf, irecord, ifield, dvalue) bind(C,name='DBFWriteDoubleAttribute')
349 IMPORT
350 TYPE(c_ptr),VALUE :: psdbf
351 INTEGER(kind=c_int),VALUE :: irecord
352 INTEGER(kind=c_int),VALUE :: ifield
353 REAL(kind=c_double),VALUE :: dvalue
354 INTEGER(kind=c_int) :: dbfwritedoubleattribute
355 END FUNCTION dbfwritedoubleattribute
356
357 FUNCTION dbfwriteintegerattribute(psdbf, irecord, ifield, nvalue) bind(C,name='DBFWriteIntegerAttribute')
358 IMPORT
359 TYPE(c_ptr),VALUE :: psdbf
360 INTEGER(kind=c_int),VALUE :: irecord
361 INTEGER(kind=c_int),VALUE :: ifield
362 INTEGER(kind=c_int),VALUE :: nvalue
363 INTEGER(kind=c_int) :: dbfwriteintegerattribute
364 END FUNCTION dbfwriteintegerattribute
365
366 FUNCTION dbfwritestringattribute(psdbf, irecord, ifield, pszvalue) bind(C,name='DBFWriteStringAttribute')
367 IMPORT
368 TYPE(c_ptr),VALUE :: psdbf
369 INTEGER(kind=c_int),VALUE :: irecord
370 INTEGER(kind=c_int),VALUE :: ifield
371 CHARACTER(kind=c_char) :: pszvalue(*)
372 INTEGER(kind=c_int) :: dbfwritestringattribute
373 END FUNCTION dbfwritestringattribute
374
375 FUNCTION dbfwritenullattribute(psdbf, irecord, ifield) bind(C,name='DBFWriteNULLAttribute')
376 IMPORT
377 TYPE(c_ptr),VALUE :: psdbf
378 INTEGER(kind=c_int),VALUE :: irecord
379 INTEGER(kind=c_int),VALUE :: ifield
380 INTEGER(kind=c_int) :: dbfwritenullattribute
381 END FUNCTION dbfwritenullattribute
382
383 FUNCTION dbfwritelogicalattribute(psdbf, irecord, ifield, lvalue) bind(C,name='DBFWriteLogicalAttribute')
384 IMPORT
385 TYPE(c_ptr),VALUE :: psdbf
386 INTEGER(kind=c_int),VALUE :: irecord
387 INTEGER(kind=c_int),VALUE :: ifield
388 CHARACTER(kind=c_char),VALUE :: lvalue
389 INTEGER(kind=c_int) :: dbfwritelogicalattribute
390 END FUNCTION dbfwritelogicalattribute
391
392#ifndef SHAPELIB_PRE10
393 FUNCTION dbfgetnativefieldtype_orig(psdbf, ifield) bind(C,name='DBFGetNativeFieldType')
394 IMPORT
395 TYPE(c_ptr),VALUE :: psdbf
396 INTEGER(kind=c_int),VALUE :: ifield
397 INTEGER(kind=c_signed_char) :: dbfgetnativefieldtype_orig
398 END FUNCTION dbfgetnativefieldtype_orig
399
400 FUNCTION dbfgetfieldindex_orig(psdbf, pszfieldname) bind(C,name='DBFGetFieldIndex')
401 IMPORT
402 TYPE(c_ptr),VALUE :: psdbf
403 CHARACTER(kind=c_char) :: pszfieldname(*)
404 INTEGER(kind=c_int) :: dbfgetfieldindex_orig
405 END FUNCTION dbfgetfieldindex_orig
406#endif
407
408END INTERFACE
409
410PRIVATE
411PUBLIC shpt_null, shpt_point, shpt_arc, shpt_polygon, shpt_multipoint, &
412 shpt_pointz, shpt_arcz, shpt_polygonz, shpt_multipointz, shpt_pointm, &
413 shpt_arcm, shpt_polygonm, shpt_multipointm, shpt_multipatch, &
414 ftstring, ftinteger, ftdouble, ftlogical, ftinvalid
417PUBLIC shpopen, shpfileisnull, dbffileisnull, shpcreate, shpgetinfo, &
418 shpreadobject, shpisnull, shpclose, shpcreatesimpleobject, shpcreateobject, &
419 shpcomputeextents, shpwriteobject, shpdestroyobject, &
420 dbfgetfieldindex, dbfgetfieldinfo, dbfaddfield, dbfisattributenull, &
421 dbfgetnativefieldtype
422
423CONTAINS
424
425
426!> It tries to open the files composing a shapefile dataset.
427!! The filename should be provided without the extension
428!! (.shp/.shx/.dbf). It tries to open all files associated, but it
429!! does not fail if part of the files are missing, so that it is
430!! possible to work on datasets not including .shp/.shx or .dbf parts.
431!! The access mode should be "rb" for reading or "rb+" for updating a
432!! file. It returns an object of type \a shpfileobject to be used in
433!! the subsequent calls for obtaining both shp and dbf information
434!! from the dataset. The function should not be used for creating a
435!! shapefile dataset from scratch, in that case \a shpcreate should be
436!! used.
437FUNCTION shpopen(pszshapefile, pszaccess)
438CHARACTER(len=*),INTENT(in) :: pszshapefile !< filename without extension
439CHARACTER(len=*),INTENT(in) :: pszaccess !< file access mode
440TYPE(shpfileobject) :: shpopen
441
442shpopen%shpfile_orig = shpopen_orig(fchartrimtostr(pszshapefile), fchartrimtostr(pszaccess))
443shpopen%dbffile_orig = dbfopen(fchartrimtostr(pszshapefile), fchartrimtostr(pszaccess))
444
445END FUNCTION shpopen
446
447
448!> It returns \c .TRUE. if the provided shapefile object is correctly
449!! associated with .shp/.shx file pair. It can be called after \a
450!! shpopen to test whether .shp/.shx files have been successfully
451!! opened.
452FUNCTION shpfileisnull(hshp) RESULT(isnull)
453TYPE(shpfileobject),INTENT(in) :: hshp !< shapefile object to test
454LOGICAL :: isnull
455
456isnull = .NOT.c_associated(hshp%shpfile_orig)
458END FUNCTION shpfileisnull
459
460
461!> It returns \c .TRUE. if the provided shapefile object is correctly
462!! associated with a .dbf file. It can be called after \a shpopen to
463!! test whether .dbf file has been successfully opened.
464FUNCTION dbffileisnull(hshp) RESULT(isnull)
465TYPE(shpfileobject),INTENT(in) :: hshp !< shapefile object to test
466LOGICAL :: isnull
467
468isnull = .NOT.c_associated(hshp%dbffile_orig)
470END FUNCTION dbffileisnull
471
472
473!> It creates a new, empty set of files composing a shapefile dataset.
474!! The filename should be provided without the extension
475!! (.shp/.shx/.dbf). If the files already exist, they will be
476!! overwritten. The type of shapes should be specified using one of
477!! the constants \a shpt_*. It returns an object of type \a
478!! shpfileobject to be used in the subsequent calls for populating the
479!! dataset both with shp and dbf information.
480FUNCTION shpcreate(pszshapefile, nshapetype)
481CHARACTER(len=*),INTENT(in) :: pszshapefile !< filename without extension
482INTEGER,INTENT(in) :: nshapetype !< type of shapes in the dataset
483TYPE(shpfileobject) :: shpcreate
484
485shpcreate%shpfile_orig = shpcreate_orig(fchartrimtostr(pszshapefile), nshapetype)
486shpcreate%dbffile_orig = dbfcreate(fchartrimtostr(pszshapefile))
487
488END FUNCTION shpcreate
489
490
491!> It gets information about the shapefile database, including dbf.
492!! If a part of the dataset has not been correctly opened
493!! (e.g. .shp/.shx or .dbf files), the corresponding information, in
494!! particular \a nentities or \a dbfrecordcount will be zero.
495SUBROUTINE shpgetinfo(hshp, nentities, shapetype, minbound, maxbound, &
496 dbffieldcount, dbfrecordcount)
497TYPE(shpfileobject),INTENT(in) :: hshp !< shapefile object to query
498INTEGER,INTENT(out) :: nentities !< number of shapes
499INTEGER,INTENT(out) :: shapetype !< type of shapes in the file, one of the \a shpt_* constants
500REAL(kind=c_double),INTENT(out) :: minbound(4) !< lower bounds of shape values
501REAL(kind=c_double),INTENT(out) :: maxbound(4) !< upper bounds of shape values
502INTEGER,INTENT(out) :: dbffieldcount !< number of dbf fields
503INTEGER,INTENT(out) :: dbfrecordcount !< number of dbf records, it should be equal to \a nentities, but it is not guaranteed
504
505IF (.NOT.shpfileisnull(hshp)) THEN
506 CALL shpgetinfo_orig(hshp%shpfile_orig, nentities, shapetype, minbound, maxbound)
507ELSE
508 nentities = 0
509 shapetype = 0
510 minbound(:) = 0.0d0
511 maxbound(:) = 0.0d0
512ENDIF
513IF (.NOT.dbffileisnull(hshp)) THEN
514 dbffieldcount = dbfgetfieldcount(hshp%dbffile_orig)
515 dbfrecordcount = dbfgetrecordcount(hshp%dbffile_orig)
516ELSE
517 dbffieldcount = 0
518 dbfrecordcount = 0
519ENDIF
520
521END SUBROUTINE shpgetinfo
522
523
524!> It reads a single shape from a shapefile.
525!! This function reads a single shape from a shapefile dataset (only
526!! .shp/.shx part) and it returns an object of type \a shpobject
527!! containing all the information read. The value of \a ishape should
528!! be in the range 0, \a nentites (as returned from \a shpgetinfo).
529!! The shape object returned should be destroyed with the \a
530!! shpdestroyobject subroutine before being reused, in order to avoid
531!! memory leaks.
532FUNCTION shpreadobject(hshp, ishape)
533TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object to read from
534INTEGER :: ishape !< number of shape to be read
535TYPE(shpobject),TARGET :: shpreadobject
536
537TYPE(shpobject) :: lshpobject
538
539INTEGER :: ier
540
541IF (.NOT.shpfileisnull(hshp)) THEN
542 ier = shpreadobject_int(hshp%shpfile_orig, ishape, c_loc(shpreadobject))
543ELSE ! initialize to empty
544 shpreadobject = shpobject_null
545ENDIF
546
547END FUNCTION shpreadobject
548
549
550!> It returns \c .TRUE. if the provided shape object is not valid.
551!! It can be called after \a shpreadobject to test whether
552!! a valid shape has ben read.
553FUNCTION shpisnull(psobject) RESULT(isnull)
554TYPE(shpobject),INTENT(in) :: psobject !< shape object to test
555LOGICAL :: isnull
556
557isnull = .NOT.c_associated(psobject%shpobject_orig)
559END FUNCTION shpisnull
560
561
562!> It closes all the files associated with the shapefile dataset.
563SUBROUTINE shpclose(hshp)
564TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object to be closed
565
566IF (.NOT.shpfileisnull(hshp)) THEN
567 CALL shpclose_orig(hshp%shpfile_orig)
568 hshp%shpfile_orig = c_null_ptr
569ENDIF
570IF (.NOT.dbffileisnull(hshp)) THEN
571 CALL dbfclose(hshp%dbffile_orig)
572 hshp%dbffile_orig = c_null_ptr
573ENDIF
574
575END SUBROUTINE shpclose
576
577
578!> It creates a new shape object, simple version.
579!! It creates a new shape object and returns it as a variable of type
580!! \a shpobject; the object has x,y,z coordinates with no measure and
581!! a single part. The successful creation can be checked with the
582!! function \a shpisnull.
583FUNCTION shpcreatesimpleobject(nshptype, nvertices, padfx, padfy, padfz)
584INTEGER :: nshptype !< type of shape, one of the \a shpt_* constants
585INTEGER :: nvertices !< number of vertices
586REAL(kind=c_double) :: padfx(nvertices) !< x coordinates
587REAL(kind=c_double) :: padfy(nvertices) !< y coordinates
588REAL(kind=c_double),OPTIONAL :: padfz(nvertices) !< z coordinates, it can be skipped
589TYPE(shpobject),TARGET :: shpcreatesimpleobject
590
591TYPE(shpobject) :: lshpobject
592
593IF (shpcreatesimpleobject_int(nshptype, nvertices, padfx, padfy, padfz, &
594 c_loc(shpcreatesimpleobject)) /= 0) THEN
595 shpcreatesimpleobject = shpobject_null
596ENDIF
597
598END FUNCTION shpcreatesimpleobject
599
600
601!> It creates a new shape object, full version.
602!! It creates a new shape object and returns it as a variable of type
603!! \a shpobject; the object has x,y,z coordinates with measure and
604!! possibly multiple parts. The successful creation can be checked
605!! with the function \a shpisnull.
606FUNCTION shpcreateobject(nshptype, ishape, nparts, panpartstart, panparttype, &
607 nvertices, padfx, padfy, padfz, padfm)
608INTEGER :: nshptype !< type of shape, one of the \a shpt_* constants
609INTEGER :: ishape !< shapeid to be recorded with this shape
610INTEGER :: nparts !< number of parts
611INTEGER :: nvertices !< number of vertices
612INTEGER :: panpartstart(nparts) !< start indices of each part
613INTEGER :: panparttype(nparts) !< type of each of the parts, this is only meaningful for \a MULTIPATCH files, for all other cases it will be assumed to be \a SHPP_RING
614REAL(kind=c_double) :: padfx(nvertices) !< x coordinates
615REAL(kind=c_double) :: padfy(nvertices) !< y coordinates
616REAL(kind=c_double),OPTIONAL :: padfz(nvertices) !< z coordinates, it can be skipped
617REAL(kind=c_double),OPTIONAL :: padfm(nvertices) !< measure, it can be skipped
618TYPE(shpobject),TARGET :: shpcreateobject
619
620TYPE(shpobject) :: lshpobject
621
622IF (shpcreateobject_int(nshptype, ishape, nparts, panpartstart, panparttype, &
623 nvertices, padfx, padfy, padfz, padfm, c_loc(shpcreateobject)) /= 0) THEN
624 shpcreateobject = shpobject_null
625ENDIF
626
627END FUNCTION shpcreateobject
628
629
630!> It recomputes the extents of a shape.
631!! This subroutine replaces the existing values of the dfXMin, dfYMin,
632!! dfZMin, dfMMin, dfXMax, dfYMax, dfZMax, and dfMMax with updated
633!! values based on the current set of vertices for the shape. It is
634!! automatically called by shpcreateobject, but if the vertices of an
635!! existing object are altered it should be called again to fix up the
636!! extents.
637SUBROUTINE shpcomputeextents(psobject)
638TYPE(shpobject),TARGET :: psobject !< shape object to update
639
640CALL shpcomputeextents_int(psobject%shpobject_orig, c_loc(psobject))
641
642END SUBROUTINE shpcomputeextents
643
644
645!> It writes a shape object to a file.
646!! It returns the number of shape written, starting from 0, or -1 in
647!! case of failure.
648FUNCTION shpwriteobject(hshp, ishape, psobject)
649TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object where to write
650INTEGER :: ishape !< number of shape to write in the file, starting from 0, -1 to append to existing shapes
651TYPE(shpobject) :: psobject !< shape object to be written
652INTEGER :: shpwriteobject
654IF (.NOT.shpfileisnull(hshp)) THEN
655 shpwriteobject = shpwriteobject_orig(hshp%shpfile_orig, ishape, psobject%shpobject_orig)
656ELSE
657 shpwriteobject = 0
658ENDIF
659
660END FUNCTION shpwriteobject
661
662
663!> It destroys a shape object for subsequent reuse or when not used anymore.
664SUBROUTINE shpdestroyobject(psobject)
665TYPE(shpobject) :: psobject !< shape object to be destroyed
666
667IF (c_associated(psobject%shpobject_orig)) THEN
668 CALL shpdestroyobject_orig(psobject%shpobject_orig)
669ENDIF
670psobject = shpobject_null
671
672END SUBROUTINE shpdestroyobject
673
674
675#ifndef SHAPELIB_PRE10
676!> It sets the correct ring order.
677!! This function will reverse any ring necessary in order to enforce
678!! the shapefile restrictions on the required order of inner and outer
679!! rings in the Shapefile specification. It returns TRUE if a change
680!! is made and FALSE if no change is made. Only polygon objects will
681!! be affected though any object may be passed.
682!! This procedure is available only with shapelib version 1.2.10 or
683!! later.
684FUNCTION shprewindobject(hshp, psobject)
685TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object (not used)
686TYPE(shpobject),INTENT(inout),TARGET :: psobject !< shape object to be rewound
687LOGICAL :: shprewindobject
688
689shprewindobject = shprewindobject_int(hshp%shpfile_orig, psobject%shpobject_orig, &
690 c_loc(psobject)) /= 0
691
692END FUNCTION shprewindobject
693
694
695!> It returns the index of the field matching the name.
696!! The comparison is case insensitive, however lengths must match
697!! exactly. It returns -1 if the field is not found or if the shape
698!! object is not valid.
699!! This procedure is available only with shapelib version 1.2.10 or
700!! later.
701FUNCTION dbfgetfieldindex(hshp, pszfieldname)
702TYPE(shpfileobject),INTENT(in) :: hshp !< shape object to query
703CHARACTER(len=*),INTENT(in) :: pszfieldname !< field name to search
704INTEGER :: dbfgetfieldindex
706IF (.NOT.dbffileisnull(hshp)) THEN
707 dbfgetfieldindex = dbfgetfieldindex_orig(hshp%dbffile_orig, fchartrimtostr(pszfieldname))
708ELSE
709 dbfgetfieldindex = -1
710ENDIF
711
712END FUNCTION dbfgetfieldindex
713#endif
714
715
716!> It returns information about a dbf field.
717!! The return value is the type of the requested field, which is one
718!! of the \a ft* constants. The field type returned does not
719!! correspond one to one with the xBase field types. For instance the
720!! xBase field type for Date will just be returned as being
721!! ftinteger. It returns -1 if the shape object is not valid.
722FUNCTION dbfgetfieldinfo(hshp, ifield, pszfieldname, pnwidth, pndecimals)
723TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object to query
724INTEGER,INTENT(in) :: ifield !< number of field to query, in the interval 0, nfield - 1
725CHARACTER(len=*),INTENT(out) :: pszfieldname !< the name of the field, it can be up to 11 characters long
726INTEGER,INTENT(out) :: pnwidth !< the width of the field in characters
727INTEGER,INTENT(out) :: pndecimals !< the number of decimals in a floating point representation, nonzero only for fields of type \a ftdouble
728INTEGER :: dbfgetfieldinfo
729
730CHARACTER(len=11) :: lpszfieldname
731
732IF (.NOT.dbffileisnull(hshp)) THEN
733 dbfgetfieldinfo = dbfgetfieldinfo_orig(hshp%dbffile_orig, ifield, &
734 lpszfieldname, pnwidth, pndecimals)
735 pszfieldname = lpszfieldname ! must strip null here!
736ELSE
737 dbfgetfieldinfo = -1
738ENDIF
739
740END FUNCTION dbfgetfieldinfo
741
742
743!> It adds a new field to an existing dataset.
744!! Note that fields can only be added to datasets with no dbf records,
745!! though this is limitation of this API, not of the file format. This
746!! function returns the number of the new field, starting from 0, or
747!! -1 in case of error.
748FUNCTION dbfaddfield(hshp, pszfieldname, etype, nwidth, ndecimals)
749TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object to update
750CHARACTER(len=*),INTENT(in) :: pszfieldname !< the name of the new field, at most 11 characters will be used
751INTEGER,INTENT(in) :: etype !< the type of the new field, one of the \a ft* constants
752INTEGER,INTENT(in) :: nwidth !< the width of the field to be created in characters
753INTEGER,INTENT(in) :: ndecimals !< the number of decimals in a floating point representation for fields of type \a ftdouble, for the other types it should be 0
754INTEGER :: dbfaddfield
755
756IF (.NOT.dbffileisnull(hshp)) THEN
757 dbfaddfield = dbfaddfield_orig(hshp%dbffile_orig, fchartrimtostr(pszfieldname), &
758 etype, nwidth, ndecimals)
759ELSE
760 dbfaddfield = -1
761ENDIF
762
763END FUNCTION dbfaddfield
764
765
766SUBROUTINE dbfreadintegerattribute_f(hshp, ishape, ifield, attr)
767TYPE(shpfileobject),INTENT(inout) :: hshp
768INTEGER,INTENT(in) :: ishape, ifield
769INTEGER,INTENT(out) :: attr
770
771IF (.NOT.dbffileisnull(hshp)) THEN
772 attr = dbfreadintegerattribute_orig(hshp%dbffile_orig, ishape, ifield)
773ELSE
774 attr = 0
775ENDIF
776
777END SUBROUTINE dbfreadintegerattribute_f
778
779
780SUBROUTINE dbfreaddoubleattribute_f(hshp, ishape, ifield, attr)
781TYPE(shpfileobject),INTENT(inout) :: hshp
782INTEGER,INTENT(in) :: ishape, ifield
783REAL(kind=c_double),INTENT(out) :: attr
784
785IF (.NOT.dbffileisnull(hshp)) THEN
786 attr = dbfreaddoubleattribute_orig(hshp%dbffile_orig, ishape, ifield)
787ELSE
788 attr = 0.0_c_double
789ENDIF
790
791END SUBROUTINE dbfreaddoubleattribute_f
792
793
794SUBROUTINE dbfreadstringattribute_f(hshp, ishape, ifield, attr)
795TYPE(shpfileobject),INTENT(inout) :: hshp
796INTEGER,INTENT(in) :: ishape, ifield
797CHARACTER(len=*),INTENT(out) :: attr
798
799IF (.NOT.dbffileisnull(hshp)) THEN
800 attr = strtofchar(dbfreadstringattribute_orig(hshp%dbffile_orig, ishape, ifield), len(attr))
801ELSE
802 attr = ''
803ENDIF
804
805END SUBROUTINE dbfreadstringattribute_f
806
807
808#ifndef SHAPELIB_PRE10
809!> It returns \c .TRUE. if the requested attribute is NULL valued.
810!! Note that NULL fields are represented in the .dbf file as having
811!! all spaces in the field. Reading NULL fields will result in a value
812!! of 0.0 or an empty string with the dbfreadattribute interface.
813!! It returns \c .TRUE. in case of error as well.
814!! This procedure is available only with shapelib version 1.2.10 or
815!! later.
816FUNCTION dbfisattributenull(hshp, ishape, ifield)
817TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object to query
818INTEGER,INTENT(in) :: ishape !< number of shape (record) to query
819INTEGER,INTENT(in) :: ifield !< number of field to query
820LOGICAL :: dbfisattributenull
821
822IF (.NOT.dbffileisnull(hshp)) THEN
823 dbfisattributenull = dbfisattributenull_orig(hshp%dbffile_orig, ishape, ifield) /= 0
824ELSE ! force to null
825 dbfisattributenull = .false.
826ENDIF
827
828END FUNCTION dbfisattributenull
829#endif
830
831
832FUNCTION dbfwriteintegerattribute_f(hshp, ishape, ifield, attr) RESULT(dbfwriteattribute)
833TYPE(shpfileobject),INTENT(inout) :: hshp
834INTEGER,INTENT(in) :: ishape, ifield
835INTEGER,INTENT(in) :: attr
836INTEGER :: dbfwriteattribute
837
838IF (.NOT.dbffileisnull(hshp)) THEN
839 dbfwriteattribute = dbfwriteintegerattribute(hshp%dbffile_orig, ishape, ifield, attr)
840ELSE
842ENDIF
843
844END FUNCTION dbfwriteintegerattribute_f
845
846
847FUNCTION dbfwritedoubleattribute_f(hshp, ishape, ifield, attr) RESULT(dbfwriteattribute)
848TYPE(shpfileobject),INTENT(inout) :: hshp
849INTEGER,INTENT(in) :: ishape, ifield
850REAL(kind=c_double),INTENT(in) :: attr
851INTEGER :: dbfwriteattribute
852
853IF (.NOT.dbffileisnull(hshp)) THEN
854 dbfwriteattribute = dbfwritedoubleattribute(hshp%dbffile_orig, ishape, ifield, attr)
855ELSE
857ENDIF
858
859END FUNCTION dbfwritedoubleattribute_f
860
861
862FUNCTION dbfwritestringattribute_f(hshp, ishape, ifield, attr) RESULT(dbfwriteattribute)
863TYPE(shpfileobject),INTENT(inout) :: hshp
864INTEGER,INTENT(in) :: ishape, ifield
865CHARACTER(len=*),INTENT(in) :: attr
866INTEGER :: dbfwriteattribute
867
868IF (.NOT.dbffileisnull(hshp)) THEN
869 dbfwriteattribute = dbfwritestringattribute(hshp%dbffile_orig, ishape, ifield, fchartostr(attr))
870ELSE
872ENDIF
873
874END FUNCTION dbfwritestringattribute_f
875
876
877FUNCTION dbfwritenullattribute_f(hshp, ishape, ifield) RESULT(dbfwriteattribute)
878TYPE(shpfileobject),INTENT(inout) :: hshp
879INTEGER,INTENT(in) :: ishape, ifield
880INTEGER :: dbfwriteattribute
881
882IF (.NOT.dbffileisnull(hshp)) THEN
883 dbfwriteattribute = dbfwritenullattribute(hshp%dbffile_orig, ishape, ifield)
884ELSE
886ENDIF
887
888END FUNCTION dbfwritenullattribute_f
889
890
891#ifndef SHAPELIB_PRE10
892!> It returns the dbf type code of the requested field.
893!! The return value is a single character and it can assume the
894!! following values:
895!!
896!! - 'C' (String)
897!! - 'D' (Date)
898!! - 'F' (Float)
899!! - 'N' (Numeric, with or without decimal)
900!! - 'L' (Logical)
901!! - 'M' (Memo: 10 digits .DBT block ptr)
902!! - ' ' (field out of range or other error)
903!!
904!! This procedure is available only with shapelib version 1.2.10 or
905!! later.
906FUNCTION dbfgetnativefieldtype(hshp, ifield)
907TYPE(shpfileobject),INTENT(inout) :: hshp !< shapefile object to query
908INTEGER,INTENT(in) :: ifield !< number of field to query
909CHARACTER(len=1) :: dbfgetnativefieldtype
910
911IF (.NOT.dbffileisnull(hshp)) THEN
912 dbfgetnativefieldtype = char(dbfgetnativefieldtype_orig(hshp%dbffile_orig, ifield))
913ELSE ! force to null
914 dbfgetnativefieldtype = ' '
915ENDIF
916
917END FUNCTION dbfgetnativefieldtype
918#endif
919
920
921SUBROUTINE shpsetobjectfortran(ftnobject, cobject, nshptype, nshapeid, &
922 nparts, panpartstart, panparttype, &
923 nvertices, padfx, padfy, padfz, padfm, &
924 dfxmin, dfymin, dfzmin, dfmmin, dfxmax, dfymax, dfzmax, dfmmax) &
925 bind(c,name='SHPSetObjectFortran')
926TYPE(c_ptr),VALUE :: ftnobject
927TYPE(c_ptr),VALUE :: cobject
928INTEGER(kind=c_int) :: nshptype ! Shape Type (SHPT_* - see list above)
929INTEGER(kind=c_int) :: nshapeid ! Shape Number (-1 is unknown/unassigned)
930INTEGER(kind=c_int) :: nparts ! # of Parts (0 implies single part with no info)
931INTEGER(kind=c_int),TARGET :: panpartstart(nparts), & ! Start Vertex of part
932 panparttype(nparts) ! Part Type (SHPP_RING if not SHPT_MULTIPATCH)
933INTEGER(kind=c_int) :: nvertices ! Vertex list
934REAL(kind=c_double),TARGET :: padfx(nvertices), padfy(nvertices), &
935 padfz(nvertices), padfm(nvertices) ! (all zero if not provided)
936REAL(kind=c_double) :: & ! Bounds in X, Y, Z and M dimensions
937 dfxmin, dfymin, dfzmin, dfmmin, dfxmax, dfymax, dfzmax, dfmmax
938
939TYPE(shpobject),POINTER :: obj
940
941CALL c_f_pointer(ftnobject, obj)
942
943obj%shpobject_orig = cobject
944obj%nshptype = nshptype
945obj%nshapeid = nshapeid
946obj%nparts = nparts
947obj%panpartstart => panpartstart
948obj%panparttype => panparttype
949obj%nvertices = nvertices
950obj%padfx => padfx
951obj%padfy => padfy
952obj%padfz => padfz
953obj%padfm => padfm
954obj%dfxmin = dfxmin
955obj%dfymin = dfymin
956obj%dfzmin = dfzmin
957obj%dfmmin = dfmmin
958obj%dfxmax = dfxmax
959obj%dfymax = dfymax
960obj%dfzmax = dfzmax
961obj%dfmmax = dfmmax
962
963END SUBROUTINE shpsetobjectfortran
964
965END MODULE shapelib
966
Convert a null-terminated C string into a Fortran CHARACTER variable of the proper length.
Definition fortranc.F90:174
Interface to SUBROUTINEs for reading dbf attributes.
Definition shapelib.F90:138
Interface to FUNCTIONs for setting dbf attributes.
Definition shapelib.F90:156
Utility module for supporting Fortran 2003 C language interface module.
Definition fortranc.F90:103
Fortran 2003 interface to the shapelib http://shapelib.maptools.org/ library.
Definition shapelib.F90:53
Object describing a shapefile dataset.
Definition shapelib.F90:84
Object describing the geometrical properties of a shape.
Definition shapelib.F90:95