43 use,
INTRINSIC :: iso_c_binding
47 INTEGER,
PARAMETER :: shpt_null = 0
48 INTEGER,
PARAMETER :: shpt_point = 1
49 INTEGER,
PARAMETER :: shpt_arc = 3
50 INTEGER,
PARAMETER :: shpt_polygon = 5
51 INTEGER,
PARAMETER :: shpt_multipoint = 8
52 INTEGER,
PARAMETER :: shpt_pointz = 11
53 INTEGER,
PARAMETER :: shpt_arcz = 13
54 INTEGER,
PARAMETER :: shpt_polygonz = 15
55 INTEGER,
PARAMETER :: shpt_multipointz = 18
56 INTEGER,
PARAMETER :: shpt_pointm = 21
57 INTEGER,
PARAMETER :: shpt_arcm = 23
58 INTEGER,
PARAMETER :: shpt_polygonm = 25
59 INTEGER,
PARAMETER :: shpt_multipointm = 28
61 INTEGER,
PARAMETER :: shpt_multipatch = 31
63 INTEGER,
PARAMETER :: ftstring = 0
64 INTEGER,
PARAMETER :: ftinteger = 1
65 INTEGER,
PARAMETER :: ftdouble = 2
66 INTEGER,
PARAMETER :: ftlogical = 3
67 INTEGER,
PARAMETER :: ftinvalid = 4
75 TYPE(c_ptr) :: shpfile_orig=c_null_ptr
76 TYPE(c_ptr) :: dbffile_orig=c_null_ptr
85 TYPE(c_ptr) :: shpobject_orig=c_null_ptr
87 INTEGER :: nshapeid=-1
89 INTEGER,
POINTER :: panpartstart(:)=>null()
90 INTEGER,
POINTER :: panparttype(:)=>null()
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
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)
128 MODULE PROCEDURE dbfreadintegerattribute_f, dbfreaddoubleattribute_f, &
129 dbfreadstringattribute_f
146 MODULE PROCEDURE dbfwriteintegerattribute_f, dbfwritedoubleattribute_f, &
147 dbfwritestringattribute_f, dbfwritenullattribute_f
152 FUNCTION shpopen_orig(pszlayer, pszaccess) bind(C,name='SHPOpen')
154 CHARACTER(kind=c_char) :: pszlayer(*)
155 CHARACTER(kind=c_char) :: pszaccess(*)
156 TYPE(c_ptr) :: shpopen_orig
157 END FUNCTION shpopen_orig
159 SUBROUTINE shpclose_orig(psshp) bind(C,name='SHPClose')
161 TYPE(c_ptr),
VALUE :: psshp
162 END SUBROUTINE shpclose_orig
164 SUBROUTINE shpgetinfo_orig(psshp, pnentities, pnshapetype, padfminbound, padfmaxbound) bind(C,name='SHPGetInfo')
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
173 FUNCTION shpcreate_orig(pszlayer, nshapetype) bind(C,name='SHPCreate')
175 CHARACTER(kind=c_char) :: pszlayer(*)
176 INTEGER(kind=c_int),
VALUE :: nshapetype
177 TYPE(c_ptr) :: shpcreate_orig
178 END FUNCTION shpcreate_orig
180 SUBROUTINE shpcomputeextents_int(psobject, ftnobject) bind(C,name='SHPComputeExtentsInt')
182 TYPE(c_ptr),
VALUE :: psobject
183 TYPE(c_ptr),
VALUE :: ftnobject
184 END SUBROUTINE shpcomputeextents_int
186 FUNCTION shpcreateobject_int(nshptype, nshapeid, nparts, panpartstart, panparttype, &
187 nvertices, padfx, padfy, padfz, padfm, ftnobject) bind(C,name='SHPCreateObjectInt')
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
203 FUNCTION shpcreatesimpleobject_int(nshptype, nvertices, padfx, padfy, padfz, ftnobject) bind(C,name='SHPCreateSimpleObjectInt')
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
214 FUNCTION shpwriteobject_orig(psshp, nshapeid, psobject) bind(C,name='SHPWriteObject')
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
222 FUNCTION shpreadobject_int(psshp, hentity, ftnobject) bind(C,name='SHPReadObjectInt')
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
230 SUBROUTINE shpdestroyobject_orig(psshape) bind(C,name='SHPDestroyObject')
232 TYPE(c_ptr),
VALUE :: psshape
233 END SUBROUTINE shpdestroyobject_orig
235 #ifndef SHAPELIB_PRE10
236 FUNCTION shprewindobject_int(hshp, psobject, ftnobject) bind(C,name='SHPRewindObjectInt')
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
247 FUNCTION dbfopen(pszfilename, pszaccess) bind(C,name='DBFOpen')
249 CHARACTER(kind=c_char) :: pszfilename(*)
250 CHARACTER(kind=c_char) :: pszaccess(*)
251 TYPE(c_ptr) :: dbfopen
254 SUBROUTINE dbfclose(psdbf) bind(C,name='DBFClose')
256 TYPE(c_ptr),
VALUE :: psdbf
257 END SUBROUTINE dbfclose
259 FUNCTION dbfcreate(pszfilename) bind(C,name='DBFCreate')
261 CHARACTER(kind=c_char) :: pszfilename(*)
262 TYPE(c_ptr) :: dbfcreate
263 END FUNCTION dbfcreate
265 FUNCTION dbfaddfield_orig(psdbf, pszfieldname, etype, nwidth, ndecimals) bind(C,name='DBFAddField')
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
275 FUNCTION dbfreadintegerattribute_orig(psdbf, irecord, ifield) bind(C,name='DBFReadIntegerAttribute')
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
283 FUNCTION dbfreaddoubleattribute_orig(psdbf, irecord, ifield) bind(C,name='DBFReadDoubleAttribute')
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
291 FUNCTION dbfreadstringattribute_orig(psdbf, irecord, ifield) bind(C,name='DBFReadStringAttribute')
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
299 SUBROUTINE dbfreadstringattribute_int(psdbf, irecord, ifield, attr, lattr) bind(C,name='DBFReadStringAttributeInt')
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
308 FUNCTION dbfreadlogicalattribute(psdbf, irecord, ifield) bind(C,name='DBFReadLogicalAttribute')
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
316 #ifndef SHAPELIB_PRE10
317 FUNCTION dbfisattributenull_orig(psdbf, irecord, ifield) bind(C,name='DBFIsAttributeNULL')
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
326 FUNCTION dbfgetfieldcount(psdbf) bind(C,name='DBFGetFieldCount')
328 TYPE(c_ptr),
VALUE :: psdbf
329 INTEGER(kind=c_int) :: dbfgetfieldcount
330 END FUNCTION dbfgetfieldcount
332 FUNCTION dbfgetrecordcount(psdbf) bind(C,name='DBFGetRecordCount')
334 TYPE(c_ptr),
VALUE :: psdbf
335 INTEGER(kind=c_int) :: dbfgetrecordcount
336 END FUNCTION dbfgetrecordcount
338 FUNCTION dbfgetfieldinfo_orig(psdbf, ifield, pszfieldname, pnwidth, pndecimals) bind(C,name='DBFGetFieldInfo')
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
348 FUNCTION dbfwritedoubleattribute(psdbf, irecord, ifield, dvalue) bind(C,name='DBFWriteDoubleAttribute')
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
357 FUNCTION dbfwriteintegerattribute(psdbf, irecord, ifield, nvalue) bind(C,name='DBFWriteIntegerAttribute')
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
366 FUNCTION dbfwritestringattribute(psdbf, irecord, ifield, pszvalue) bind(C,name='DBFWriteStringAttribute')
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
375 FUNCTION dbfwritenullattribute(psdbf, irecord, ifield) bind(C,name='DBFWriteNULLAttribute')
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
383 FUNCTION dbfwritelogicalattribute(psdbf, irecord, ifield, lvalue) bind(C,name='DBFWriteLogicalAttribute')
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
392 #ifndef SHAPELIB_PRE10
393 FUNCTION dbfgetnativefieldtype_orig(psdbf, ifield) bind(C,name='DBFGetNativeFieldType')
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
400 FUNCTION dbfgetfieldindex_orig(psdbf, pszfieldname) bind(C,name='DBFGetFieldIndex')
402 TYPE(c_ptr),
VALUE :: psdbf
403 CHARACTER(kind=c_char) :: pszfieldname(*)
404 INTEGER(kind=c_int) :: dbfgetfieldindex_orig
405 END FUNCTION dbfgetfieldindex_orig
411 PUBLIC 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
417 PUBLIC shpopen, shpfileisnull, dbffileisnull, shpcreate, shpgetinfo, &
418 shpreadobject, shpisnull, shpclose, shpcreatesimpleobject, shpcreateobject, &
419 shpcomputeextents, shpwriteobject, shpdestroyobject, &
420 dbfgetfieldindex, dbfgetfieldinfo, dbfaddfield, dbfisattributenull, &
421 dbfgetnativefieldtype
437 FUNCTION shpopen(pszshapefile, pszaccess)
438 CHARACTER(len=*),
INTENT(in) :: pszshapefile
439 CHARACTER(len=*),
INTENT(in) :: pszaccess
440 TYPE(shpfileobject) :: shpopen
442 shpopen%shpfile_orig = shpopen_orig(fchartrimtostr(pszshapefile), fchartrimtostr(pszaccess))
443 shpopen%dbffile_orig = dbfopen(fchartrimtostr(pszshapefile), fchartrimtostr(pszaccess))
452 FUNCTION shpfileisnull(hshp)
RESULT(isnull)
456 isnull = .NOT.c_associated(hshp%shpfile_orig)
458 END FUNCTION shpfileisnull
464 FUNCTION dbffileisnull(hshp)
RESULT(isnull)
468 isnull = .NOT.c_associated(hshp%dbffile_orig)
470 END FUNCTION dbffileisnull
480 FUNCTION shpcreate(pszshapefile, nshapetype)
481 CHARACTER(len=*),
INTENT(in) :: pszshapefile
482 INTEGER,
INTENT(in) :: nshapetype
485 shpcreate%shpfile_orig = shpcreate_orig(fchartrimtostr(pszshapefile), nshapetype)
486 shpcreate%dbffile_orig = dbfcreate(fchartrimtostr(pszshapefile))
488 END FUNCTION shpcreate
495 SUBROUTINE shpgetinfo(hshp, nentities, shapetype, minbound, maxbound, &
496 dbffieldcount, dbfrecordcount)
498 INTEGER,
INTENT(out) :: nentities
499 INTEGER,
INTENT(out) :: shapetype
500 REAL(kind=c_double),
INTENT(out) :: minbound(4)
501 REAL(kind=c_double),
INTENT(out) :: maxbound(4)
502 INTEGER,
INTENT(out) :: dbffieldcount
503 INTEGER,
INTENT(out) :: dbfrecordcount
505 IF (.NOT.shpfileisnull(hshp))
THEN
506 CALL shpgetinfo_orig(hshp%shpfile_orig, nentities, shapetype, minbound, maxbound)
513 IF (.NOT.dbffileisnull(hshp))
THEN
514 dbffieldcount = dbfgetfieldcount(hshp%dbffile_orig)
515 dbfrecordcount = dbfgetrecordcount(hshp%dbffile_orig)
521 END SUBROUTINE shpgetinfo
532 FUNCTION shpreadobject(hshp, ishape)
541 IF (.NOT.shpfileisnull(hshp))
THEN
542 ier = shpreadobject_int(hshp%shpfile_orig, ishape, c_loc(shpreadobject))
544 shpreadobject = shpobject_null
547 END FUNCTION shpreadobject
553 FUNCTION shpisnull(psobject)
RESULT(isnull)
557 isnull = .NOT.c_associated(psobject%shpobject_orig)
559 END FUNCTION shpisnull
563 SUBROUTINE shpclose(hshp)
566 IF (.NOT.shpfileisnull(hshp))
THEN
567 CALL shpclose_orig(hshp%shpfile_orig)
568 hshp%shpfile_orig = c_null_ptr
570 IF (.NOT.dbffileisnull(hshp))
THEN
571 CALL dbfclose(hshp%dbffile_orig)
572 hshp%dbffile_orig = c_null_ptr
575 END SUBROUTINE shpclose
583 FUNCTION shpcreatesimpleobject(nshptype, nvertices, padfx, padfy, padfz)
586 REAL(kind=c_double) :: padfx(nvertices)
587 REAL(kind=c_double) :: padfy(nvertices)
588 REAL(kind=c_double),
OPTIONAL :: padfz(nvertices)
589 TYPE(
shpobject),
TARGET :: shpcreatesimpleobject
593 IF (shpcreatesimpleobject_int(nshptype, nvertices, padfx, padfy, padfz, &
594 c_loc(shpcreatesimpleobject)) /= 0)
THEN
595 shpcreatesimpleobject = shpobject_null
598 END FUNCTION shpcreatesimpleobject
606 FUNCTION shpcreateobject(nshptype, ishape, nparts, panpartstart, panparttype, &
607 nvertices, padfx, padfy, padfz, padfm)
612 INTEGER :: panpartstart(nparts)
613 INTEGER :: panparttype(nparts)
614 REAL(kind=c_double) :: padfx(nvertices)
615 REAL(kind=c_double) :: padfy(nvertices)
616 REAL(kind=c_double),
OPTIONAL :: padfz(nvertices)
617 REAL(kind=c_double),
OPTIONAL :: padfm(nvertices)
618 TYPE(
shpobject),
TARGET :: shpcreateobject
622 IF (shpcreateobject_int(nshptype, ishape, nparts, panpartstart, panparttype, &
623 nvertices, padfx, padfy, padfz, padfm, c_loc(shpcreateobject)) /= 0)
THEN
624 shpcreateobject = shpobject_null
627 END FUNCTION shpcreateobject
637 SUBROUTINE shpcomputeextents(psobject)
640 CALL shpcomputeextents_int(psobject%shpobject_orig, c_loc(psobject))
642 END SUBROUTINE shpcomputeextents
648 FUNCTION shpwriteobject(hshp, ishape, psobject)
652 INTEGER :: shpwriteobject
654 IF (.NOT.shpfileisnull(hshp))
THEN
655 shpwriteobject = shpwriteobject_orig(hshp%shpfile_orig, ishape, psobject%shpobject_orig)
660 END FUNCTION shpwriteobject
664 SUBROUTINE shpdestroyobject(psobject)
667 IF (c_associated(psobject%shpobject_orig))
THEN
668 CALL shpdestroyobject_orig(psobject%shpobject_orig)
670 psobject = shpobject_null
672 END SUBROUTINE shpdestroyobject
675 #ifndef SHAPELIB_PRE10
684 FUNCTION shprewindobject(hshp, psobject)
686 TYPE(
shpobject),
INTENT(inout),
TARGET :: psobject
687 LOGICAL :: shprewindobject
689 shprewindobject = shprewindobject_int(hshp%shpfile_orig, psobject%shpobject_orig, &
690 c_loc(psobject)) /= 0
692 END FUNCTION shprewindobject
701 FUNCTION dbfgetfieldindex(hshp, pszfieldname)
703 CHARACTER(len=*),
INTENT(in) :: pszfieldname
704 INTEGER :: dbfgetfieldindex
706 IF (.NOT.dbffileisnull(hshp))
THEN
707 dbfgetfieldindex = dbfgetfieldindex_orig(hshp%dbffile_orig, fchartrimtostr(pszfieldname))
709 dbfgetfieldindex = -1
712 END FUNCTION dbfgetfieldindex
722 FUNCTION dbfgetfieldinfo(hshp, ifield, pszfieldname, pnwidth, pndecimals)
724 INTEGER,
INTENT(in) :: ifield
725 CHARACTER(len=*),
INTENT(out) :: pszfieldname
726 INTEGER,
INTENT(out) :: pnwidth
727 INTEGER,
INTENT(out) :: pndecimals
728 INTEGER :: dbfgetfieldinfo
730 CHARACTER(len=11) :: lpszfieldname
732 IF (.NOT.dbffileisnull(hshp))
THEN
733 dbfgetfieldinfo = dbfgetfieldinfo_orig(hshp%dbffile_orig, ifield, &
734 lpszfieldname, pnwidth, pndecimals)
735 pszfieldname = lpszfieldname
740 END FUNCTION dbfgetfieldinfo
748 FUNCTION dbfaddfield(hshp, pszfieldname, etype, nwidth, ndecimals)
750 CHARACTER(len=*),
INTENT(in) :: pszfieldname
751 INTEGER,
INTENT(in) :: etype
752 INTEGER,
INTENT(in) :: nwidth
753 INTEGER,
INTENT(in) :: ndecimals
754 INTEGER :: dbfaddfield
756 IF (.NOT.dbffileisnull(hshp))
THEN
757 dbfaddfield = dbfaddfield_orig(hshp%dbffile_orig, fchartrimtostr(pszfieldname), &
758 etype, nwidth, ndecimals)
763 END FUNCTION dbfaddfield
766 SUBROUTINE dbfreadintegerattribute_f(hshp, ishape, ifield, attr)
768 INTEGER,
INTENT(in) :: ishape, ifield
769 INTEGER,
INTENT(out) :: attr
771 IF (.NOT.dbffileisnull(hshp))
THEN
772 attr = dbfreadintegerattribute_orig(hshp%dbffile_orig, ishape, ifield)
777 END SUBROUTINE dbfreadintegerattribute_f
780 SUBROUTINE dbfreaddoubleattribute_f(hshp, ishape, ifield, attr)
782 INTEGER,
INTENT(in) :: ishape, ifield
783 REAL(kind=c_double),
INTENT(out) :: attr
785 IF (.NOT.dbffileisnull(hshp))
THEN
786 attr = dbfreaddoubleattribute_orig(hshp%dbffile_orig, ishape, ifield)
791 END SUBROUTINE dbfreaddoubleattribute_f
794 SUBROUTINE dbfreadstringattribute_f(hshp, ishape, ifield, attr)
796 INTEGER,
INTENT(in) :: ishape, ifield
797 CHARACTER(len=*),
INTENT(out) :: attr
799 IF (.NOT.dbffileisnull(hshp))
THEN
800 attr =
strtofchar(dbfreadstringattribute_orig(hshp%dbffile_orig, ishape, ifield), len(attr))
805 END SUBROUTINE dbfreadstringattribute_f
808 #ifndef SHAPELIB_PRE10
816 FUNCTION dbfisattributenull(hshp, ishape, ifield)
818 INTEGER,
INTENT(in) :: ishape
819 INTEGER,
INTENT(in) :: ifield
820 LOGICAL :: dbfisattributenull
822 IF (.NOT.dbffileisnull(hshp))
THEN
823 dbfisattributenull = dbfisattributenull_orig(hshp%dbffile_orig, ishape, ifield) /= 0
825 dbfisattributenull = .false.
828 END FUNCTION dbfisattributenull
832 FUNCTION dbfwriteintegerattribute_f(hshp, ishape, ifield, attr)
RESULT(dbfwriteattribute)
834 INTEGER,
INTENT(in) :: ishape, ifield
835 INTEGER,
INTENT(in) :: attr
838 IF (.NOT.dbffileisnull(hshp))
THEN
839 dbfwriteattribute = dbfwriteintegerattribute(hshp%dbffile_orig, ishape, ifield, attr)
844 END FUNCTION dbfwriteintegerattribute_f
847 FUNCTION dbfwritedoubleattribute_f(hshp, ishape, ifield, attr)
RESULT(dbfwriteattribute)
849 INTEGER,
INTENT(in) :: ishape, ifield
850 REAL(kind=c_double),
INTENT(in) :: attr
853 IF (.NOT.dbffileisnull(hshp))
THEN
854 dbfwriteattribute = dbfwritedoubleattribute(hshp%dbffile_orig, ishape, ifield, attr)
859 END FUNCTION dbfwritedoubleattribute_f
862 FUNCTION dbfwritestringattribute_f(hshp, ishape, ifield, attr)
RESULT(dbfwriteattribute)
864 INTEGER,
INTENT(in) :: ishape, ifield
865 CHARACTER(len=*),
INTENT(in) :: attr
868 IF (.NOT.dbffileisnull(hshp))
THEN
869 dbfwriteattribute = dbfwritestringattribute(hshp%dbffile_orig, ishape, ifield, fchartostr(attr))
874 END FUNCTION dbfwritestringattribute_f
877 FUNCTION dbfwritenullattribute_f(hshp, ishape, ifield)
RESULT(dbfwriteattribute)
879 INTEGER,
INTENT(in) :: ishape, ifield
882 IF (.NOT.dbffileisnull(hshp))
THEN
888 END FUNCTION dbfwritenullattribute_f
891 #ifndef SHAPELIB_PRE10
906 FUNCTION dbfgetnativefieldtype(hshp, ifield)
908 INTEGER,
INTENT(in) :: ifield
909 CHARACTER(len=1) :: dbfgetnativefieldtype
911 IF (.NOT.dbffileisnull(hshp))
THEN
912 dbfgetnativefieldtype = char(dbfgetnativefieldtype_orig(hshp%dbffile_orig, ifield))
914 dbfgetnativefieldtype =
' '
917 END FUNCTION dbfgetnativefieldtype
921 SUBROUTINE 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')
926 TYPE(c_ptr),
VALUE :: ftnobject
927 TYPE(c_ptr),
VALUE :: cobject
928 INTEGER(kind=c_int) :: nshptype
929 INTEGER(kind=c_int) :: nshapeid
930 INTEGER(kind=c_int) :: nparts
931 INTEGER(kind=c_int),
TARGET :: panpartstart(nparts), &
933 INTEGER(kind=c_int) :: nvertices
934 REAL(kind=c_double),
TARGET :: padfx(nvertices), padfy(nvertices), &
935 padfz(nvertices), padfm(nvertices)
936 REAL(kind=c_double) :: &
937 dfxmin, dfymin, dfzmin, dfmmin, dfxmax, dfymax, dfzmax, dfmmax
941 CALL c_f_pointer(ftnobject, obj)
943 obj%shpobject_orig = cobject
944 obj%nshptype = nshptype
945 obj%nshapeid = nshapeid
947 obj%panpartstart => panpartstart
948 obj%panparttype => panparttype
949 obj%nvertices = nvertices
963 END SUBROUTINE shpsetobjectfortran
Convert a null-terminated C string into a Fortran CHARACTER variable of the proper length.
Interface to SUBROUTINEs for reading dbf attributes.
Interface to FUNCTIONs for setting dbf attributes.
Utility module for supporting Fortran 2003 C language interface module.
Fortran 2003 interface to the shapelib http://shapelib.maptools.org/ library.
Object describing a shapefile dataset.
Object describing the geometrical properties of a shape.