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
42MODULE shapelib
43use,INTRINSIC :: iso_c_binding
44USE fortranc
45IMPLICIT NONE
46
47INTEGER,PARAMETER :: shpt_null = 0
48INTEGER,PARAMETER :: shpt_point = 1
49INTEGER,PARAMETER :: shpt_arc = 3
50INTEGER,PARAMETER :: shpt_polygon = 5
51INTEGER,PARAMETER :: shpt_multipoint = 8
52INTEGER,PARAMETER :: shpt_pointz = 11
53INTEGER,PARAMETER :: shpt_arcz = 13
54INTEGER,PARAMETER :: shpt_polygonz = 15
55INTEGER,PARAMETER :: shpt_multipointz = 18
56INTEGER,PARAMETER :: shpt_pointm = 21
57INTEGER,PARAMETER :: shpt_arcm = 23
58INTEGER,PARAMETER :: shpt_polygonm = 25
59INTEGER,PARAMETER :: shpt_multipointm = 28
61INTEGER,PARAMETER :: shpt_multipatch = 31
63INTEGER,PARAMETER :: ftstring = 0
64INTEGER,PARAMETER :: ftinteger = 1
65INTEGER,PARAMETER :: ftdouble = 2
66INTEGER,PARAMETER :: ftlogical = 3
67INTEGER,PARAMETER :: ftinvalid = 4
74 PRIVATE
75 TYPE(c_ptr) :: shpfile_orig=c_null_ptr
76 TYPE(c_ptr) :: dbffile_orig=c_null_ptr
79
85 TYPE(c_ptr) :: shpobject_orig=c_null_ptr
86 INTEGER :: nshptype=0
87 INTEGER :: nshapeid=-1
88 INTEGER :: nparts=0
89 INTEGER,POINTER :: panpartstart(:)=>null()
90 INTEGER,POINTER :: panparttype(:)=>null()
91 INTEGER :: nvertices
92 REAL(kind=c_double),POINTER :: padfx(:)=>null()
93 REAL(kind=c_double),POINTER :: padfy(:)=>null()
94 REAL(kind=c_double),POINTER :: padfz(:)=>null()
95 REAL(kind=c_double),POINTER :: padfm(:)=>null()
96 REAL(kind=c_double) :: dfxmin=0.0_c_double
97 REAL(kind=c_double) :: dfymin=0.0_c_double
98 REAL(kind=c_double) :: dfzmin=0.0_c_double
99 REAL(kind=c_double) :: dfmmin=0.0_c_double
100 REAL(kind=c_double) :: dfxmax=0.0_c_double
101 REAL(kind=c_double) :: dfymax=0.0_c_double
102 REAL(kind=c_double) :: dfzmax=0.0_c_double
103 REAL(kind=c_double) :: dfmmax=0.0_c_double
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)
127INTERFACE dbfreadattribute
128 MODULE PROCEDURE dbfreadintegerattribute_f, dbfreaddoubleattribute_f, &
129 dbfreadstringattribute_f
130END INTERFACE
131
132
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
437FUNCTION shpopen(pszshapefile, pszaccess)
438CHARACTER(len=*),INTENT(in) :: pszshapefile
439CHARACTER(len=*),INTENT(in) :: pszaccess
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
452FUNCTION shpfileisnull(hshp) RESULT(isnull)
453TYPE(shpfileobject),INTENT(in) :: hshp
454LOGICAL :: isnull
455
456isnull = .NOT.c_associated(hshp%shpfile_orig)
458END FUNCTION shpfileisnull
459
460
464FUNCTION dbffileisnull(hshp) RESULT(isnull)
465TYPE(shpfileobject),INTENT(in) :: hshp
466LOGICAL :: isnull
467
468isnull = .NOT.c_associated(hshp%dbffile_orig)
470END FUNCTION dbffileisnull
471
472
480FUNCTION shpcreate(pszshapefile, nshapetype)
481CHARACTER(len=*),INTENT(in) :: pszshapefile
482INTEGER,INTENT(in) :: nshapetype
483TYPE(shpfileobject) :: shpcreate
484
485shpcreate%shpfile_orig = shpcreate_orig(fchartrimtostr(pszshapefile), nshapetype)
486shpcreate%dbffile_orig = dbfcreate(fchartrimtostr(pszshapefile))
487
488END FUNCTION shpcreate
489
490
495SUBROUTINE shpgetinfo(hshp, nentities, shapetype, minbound, maxbound, &
496 dbffieldcount, dbfrecordcount)
497TYPE(shpfileobject),INTENT(in) :: hshp
498INTEGER,INTENT(out) :: nentities
499INTEGER,INTENT(out) :: shapetype
500REAL(kind=c_double),INTENT(out) :: minbound(4)
501REAL(kind=c_double),INTENT(out) :: maxbound(4)
502INTEGER,INTENT(out) :: dbffieldcount
503INTEGER,INTENT(out) :: dbfrecordcount
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
532FUNCTION shpreadobject(hshp, ishape)
533TYPE(shpfileobject),INTENT(inout) :: hshp
534INTEGER :: ishape
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
553FUNCTION shpisnull(psobject) RESULT(isnull)
554TYPE(shpobject),INTENT(in) :: psobject
555LOGICAL :: isnull
556
557isnull = .NOT.c_associated(psobject%shpobject_orig)
559END FUNCTION shpisnull
560
561
563SUBROUTINE shpclose(hshp)
564TYPE(shpfileobject),INTENT(inout) :: hshp
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
583FUNCTION shpcreatesimpleobject(nshptype, nvertices, padfx, padfy, padfz)
584INTEGER :: nshptype
585INTEGER :: nvertices
586REAL(kind=c_double) :: padfx(nvertices)
587REAL(kind=c_double) :: padfy(nvertices)
588REAL(kind=c_double),OPTIONAL :: padfz(nvertices)
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
606FUNCTION shpcreateobject(nshptype, ishape, nparts, panpartstart, panparttype, &
607 nvertices, padfx, padfy, padfz, padfm)
608INTEGER :: nshptype
609INTEGER :: ishape
610INTEGER :: nparts
611INTEGER :: nvertices
612INTEGER :: panpartstart(nparts)
613INTEGER :: panparttype(nparts)
614REAL(kind=c_double) :: padfx(nvertices)
615REAL(kind=c_double) :: padfy(nvertices)
616REAL(kind=c_double),OPTIONAL :: padfz(nvertices)
617REAL(kind=c_double),OPTIONAL :: padfm(nvertices)
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
637SUBROUTINE shpcomputeextents(psobject)
638TYPE(shpobject),TARGET :: psobject
639
640CALL shpcomputeextents_int(psobject%shpobject_orig, c_loc(psobject))
641
642END SUBROUTINE shpcomputeextents
643
644
648FUNCTION shpwriteobject(hshp, ishape, psobject)
649TYPE(shpfileobject),INTENT(inout) :: hshp
650INTEGER :: ishape
651TYPE(shpobject) :: psobject
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
664SUBROUTINE shpdestroyobject(psobject)
665TYPE(shpobject) :: psobject
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
684FUNCTION shprewindobject(hshp, psobject)
685TYPE(shpfileobject),INTENT(inout) :: hshp
686TYPE(shpobject),INTENT(inout),TARGET :: psobject
687LOGICAL :: shprewindobject
688
689shprewindobject = shprewindobject_int(hshp%shpfile_orig, psobject%shpobject_orig, &
690 c_loc(psobject)) /= 0
691
692END FUNCTION shprewindobject
693
694
701FUNCTION dbfgetfieldindex(hshp, pszfieldname)
702TYPE(shpfileobject),INTENT(in) :: hshp
703CHARACTER(len=*),INTENT(in) :: pszfieldname
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
722FUNCTION dbfgetfieldinfo(hshp, ifield, pszfieldname, pnwidth, pndecimals)
723TYPE(shpfileobject),INTENT(inout) :: hshp
724INTEGER,INTENT(in) :: ifield
725CHARACTER(len=*),INTENT(out) :: pszfieldname
726INTEGER,INTENT(out) :: pnwidth
727INTEGER,INTENT(out) :: pndecimals
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
748FUNCTION dbfaddfield(hshp, pszfieldname, etype, nwidth, ndecimals)
749TYPE(shpfileobject),INTENT(inout) :: hshp
750CHARACTER(len=*),INTENT(in) :: pszfieldname
751INTEGER,INTENT(in) :: etype
752INTEGER,INTENT(in) :: nwidth
753INTEGER,INTENT(in) :: ndecimals
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
816FUNCTION dbfisattributenull(hshp, ishape, ifield)
817TYPE(shpfileobject),INTENT(inout) :: hshp
818INTEGER,INTENT(in) :: ishape
819INTEGER,INTENT(in) :: ifield
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
906FUNCTION dbfgetnativefieldtype(hshp, ifield)
907TYPE(shpfileobject),INTENT(inout) :: hshp
908INTEGER,INTENT(in) :: ifield
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