43use,
INTRINSIC :: iso_c_binding
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
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
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
437FUNCTION shpopen(pszshapefile, pszaccess)
438CHARACTER(len=*),
INTENT(in) :: pszshapefile
439CHARACTER(len=*),
INTENT(in) :: pszaccess
440TYPE(shpfileobject) :: shpopen
442shpopen%shpfile_orig = shpopen_orig(fchartrimtostr(pszshapefile), fchartrimtostr(pszaccess))
443shpopen%dbffile_orig = dbfopen(fchartrimtostr(pszshapefile), fchartrimtostr(pszaccess))
452FUNCTION shpfileisnull(hshp)
RESULT(isnull)
456isnull = .NOT.c_associated(hshp%shpfile_orig)
458END FUNCTION shpfileisnull
464FUNCTION dbffileisnull(hshp)
RESULT(isnull)
468isnull = .NOT.c_associated(hshp%dbffile_orig)
470END FUNCTION dbffileisnull
480FUNCTION shpcreate(pszshapefile, nshapetype)
481CHARACTER(len=*),
INTENT(in) :: pszshapefile
482INTEGER,
INTENT(in) :: nshapetype
485shpcreate%shpfile_orig = shpcreate_orig(fchartrimtostr(pszshapefile), nshapetype)
486shpcreate%dbffile_orig = dbfcreate(fchartrimtostr(pszshapefile))
488END FUNCTION shpcreate
495SUBROUTINE shpgetinfo(hshp, nentities, shapetype, minbound, maxbound, &
496 dbffieldcount, dbfrecordcount)
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
505IF (.NOT.shpfileisnull(hshp))
THEN
506 CALL shpgetinfo_orig(hshp%shpfile_orig, nentities, shapetype, minbound, maxbound)
513IF (.NOT.dbffileisnull(hshp))
THEN
514 dbffieldcount = dbfgetfieldcount(hshp%dbffile_orig)
515 dbfrecordcount = dbfgetrecordcount(hshp%dbffile_orig)
521END SUBROUTINE shpgetinfo
532FUNCTION shpreadobject(hshp, ishape)
541IF (.NOT.shpfileisnull(hshp))
THEN
542 ier = shpreadobject_int(hshp%shpfile_orig, ishape, c_loc(shpreadobject))
544 shpreadobject = shpobject_null
547END FUNCTION shpreadobject
553FUNCTION shpisnull(psobject)
RESULT(isnull)
557isnull = .NOT.c_associated(psobject%shpobject_orig)
559END FUNCTION shpisnull
563SUBROUTINE shpclose(hshp)
566IF (.NOT.shpfileisnull(hshp))
THEN
567 CALL shpclose_orig(hshp%shpfile_orig)
568 hshp%shpfile_orig = c_null_ptr
570IF (.NOT.dbffileisnull(hshp))
THEN
571 CALL dbfclose(hshp%dbffile_orig)
572 hshp%dbffile_orig = c_null_ptr
575END SUBROUTINE shpclose
583FUNCTION shpcreatesimpleobject(nshptype, nvertices, padfx, padfy, padfz)
586REAL(kind=c_double) :: padfx(nvertices)
587REAL(kind=c_double) :: padfy(nvertices)
588REAL(kind=c_double),
OPTIONAL :: padfz(nvertices)
589TYPE(
shpobject),
TARGET :: shpcreatesimpleobject
593IF (shpcreatesimpleobject_int(nshptype, nvertices, padfx, padfy, padfz, &
594 c_loc(shpcreatesimpleobject)) /= 0)
THEN
595 shpcreatesimpleobject = shpobject_null
598END FUNCTION shpcreatesimpleobject
606FUNCTION shpcreateobject(nshptype, ishape, nparts, panpartstart, panparttype, &
607 nvertices, padfx, padfy, padfz, padfm)
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)
622IF (shpcreateobject_int(nshptype, ishape, nparts, panpartstart, panparttype, &
623 nvertices, padfx, padfy, padfz, padfm, c_loc(shpcreateobject)) /= 0)
THEN
624 shpcreateobject = shpobject_null
627END FUNCTION shpcreateobject
637SUBROUTINE shpcomputeextents(psobject)
640CALL shpcomputeextents_int(psobject%shpobject_orig, c_loc(psobject))
642END SUBROUTINE shpcomputeextents
648FUNCTION shpwriteobject(hshp, ishape, psobject)
652INTEGER :: shpwriteobject
654IF (.NOT.shpfileisnull(hshp))
THEN
655 shpwriteobject = shpwriteobject_orig(hshp%shpfile_orig, ishape, psobject%shpobject_orig)
660END FUNCTION shpwriteobject
664SUBROUTINE shpdestroyobject(psobject)
667IF (c_associated(psobject%shpobject_orig))
THEN
668 CALL shpdestroyobject_orig(psobject%shpobject_orig)
670psobject = shpobject_null
672END SUBROUTINE shpdestroyobject
675#ifndef SHAPELIB_PRE10
684FUNCTION shprewindobject(hshp, psobject)
686TYPE(
shpobject),
INTENT(inout),
TARGET :: psobject
687LOGICAL :: shprewindobject
689shprewindobject = shprewindobject_int(hshp%shpfile_orig, psobject%shpobject_orig, &
690 c_loc(psobject)) /= 0
692END FUNCTION shprewindobject
701FUNCTION dbfgetfieldindex(hshp, pszfieldname)
703CHARACTER(len=*),
INTENT(in) :: pszfieldname
704INTEGER :: dbfgetfieldindex
706IF (.NOT.dbffileisnull(hshp))
THEN
707 dbfgetfieldindex = dbfgetfieldindex_orig(hshp%dbffile_orig, fchartrimtostr(pszfieldname))
709 dbfgetfieldindex = -1
712END FUNCTION dbfgetfieldindex
722FUNCTION dbfgetfieldinfo(hshp, ifield, pszfieldname, pnwidth, pndecimals)
724INTEGER,
INTENT(in) :: ifield
725CHARACTER(len=*),
INTENT(out) :: pszfieldname
726INTEGER,
INTENT(out) :: pnwidth
727INTEGER,
INTENT(out) :: pndecimals
728INTEGER :: dbfgetfieldinfo
730CHARACTER(len=11) :: lpszfieldname
732IF (.NOT.dbffileisnull(hshp))
THEN
733 dbfgetfieldinfo = dbfgetfieldinfo_orig(hshp%dbffile_orig, ifield, &
734 lpszfieldname, pnwidth, pndecimals)
735 pszfieldname = lpszfieldname
740END FUNCTION dbfgetfieldinfo
748FUNCTION dbfaddfield(hshp, pszfieldname, etype, nwidth, ndecimals)
750CHARACTER(len=*),
INTENT(in) :: pszfieldname
751INTEGER,
INTENT(in) :: etype
752INTEGER,
INTENT(in) :: nwidth
753INTEGER,
INTENT(in) :: ndecimals
754INTEGER :: dbfaddfield
756IF (.NOT.dbffileisnull(hshp))
THEN
757 dbfaddfield = dbfaddfield_orig(hshp%dbffile_orig, fchartrimtostr(pszfieldname), &
758 etype, nwidth, ndecimals)
763END FUNCTION dbfaddfield
766SUBROUTINE dbfreadintegerattribute_f(hshp, ishape, ifield, attr)
768INTEGER,
INTENT(in) :: ishape, ifield
769INTEGER,
INTENT(out) :: attr
771IF (.NOT.dbffileisnull(hshp))
THEN
772 attr = dbfreadintegerattribute_orig(hshp%dbffile_orig, ishape, ifield)
777END SUBROUTINE dbfreadintegerattribute_f
780SUBROUTINE dbfreaddoubleattribute_f(hshp, ishape, ifield, attr)
782INTEGER,
INTENT(in) :: ishape, ifield
783REAL(kind=c_double),
INTENT(out) :: attr
785IF (.NOT.dbffileisnull(hshp))
THEN
786 attr = dbfreaddoubleattribute_orig(hshp%dbffile_orig, ishape, ifield)
791END SUBROUTINE dbfreaddoubleattribute_f
794SUBROUTINE dbfreadstringattribute_f(hshp, ishape, ifield, attr)
796INTEGER,
INTENT(in) :: ishape, ifield
797CHARACTER(len=*),
INTENT(out) :: attr
799IF (.NOT.dbffileisnull(hshp))
THEN
800 attr =
strtofchar(dbfreadstringattribute_orig(hshp%dbffile_orig, ishape, ifield), len(attr))
805END SUBROUTINE dbfreadstringattribute_f
808#ifndef SHAPELIB_PRE10
816FUNCTION dbfisattributenull(hshp, ishape, ifield)
818INTEGER,
INTENT(in) :: ishape
819INTEGER,
INTENT(in) :: ifield
820LOGICAL :: dbfisattributenull
822IF (.NOT.dbffileisnull(hshp))
THEN
823 dbfisattributenull = dbfisattributenull_orig(hshp%dbffile_orig, ishape, ifield) /= 0
825 dbfisattributenull = .false.
828END FUNCTION dbfisattributenull
832FUNCTION dbfwriteintegerattribute_f(hshp, ishape, ifield, attr)
RESULT(dbfwriteattribute)
834INTEGER,
INTENT(in) :: ishape, ifield
835INTEGER,
INTENT(in) :: attr
838IF (.NOT.dbffileisnull(hshp))
THEN
839 dbfwriteattribute = dbfwriteintegerattribute(hshp%dbffile_orig, ishape, ifield, attr)
844END FUNCTION dbfwriteintegerattribute_f
847FUNCTION dbfwritedoubleattribute_f(hshp, ishape, ifield, attr)
RESULT(dbfwriteattribute)
849INTEGER,
INTENT(in) :: ishape, ifield
850REAL(kind=c_double),
INTENT(in) :: attr
853IF (.NOT.dbffileisnull(hshp))
THEN
854 dbfwriteattribute = dbfwritedoubleattribute(hshp%dbffile_orig, ishape, ifield, attr)
859END FUNCTION dbfwritedoubleattribute_f
862FUNCTION dbfwritestringattribute_f(hshp, ishape, ifield, attr)
RESULT(dbfwriteattribute)
864INTEGER,
INTENT(in) :: ishape, ifield
865CHARACTER(len=*),
INTENT(in) :: attr
868IF (.NOT.dbffileisnull(hshp))
THEN
869 dbfwriteattribute = dbfwritestringattribute(hshp%dbffile_orig, ishape, ifield, fchartostr(attr))
874END FUNCTION dbfwritestringattribute_f
877FUNCTION dbfwritenullattribute_f(hshp, ishape, ifield)
RESULT(dbfwriteattribute)
879INTEGER,
INTENT(in) :: ishape, ifield
882IF (.NOT.dbffileisnull(hshp))
THEN
888END FUNCTION dbfwritenullattribute_f
891#ifndef SHAPELIB_PRE10
906FUNCTION dbfgetnativefieldtype(hshp, ifield)
908INTEGER,
INTENT(in) :: ifield
909CHARACTER(len=1) :: dbfgetnativefieldtype
911IF (.NOT.dbffileisnull(hshp))
THEN
912 dbfgetnativefieldtype = char(dbfgetnativefieldtype_orig(hshp%dbffile_orig, ifield))
914 dbfgetnativefieldtype =
' '
917END FUNCTION dbfgetnativefieldtype
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
929INTEGER(kind=c_int) :: nshapeid
930INTEGER(kind=c_int) :: nparts
931INTEGER(kind=c_int),
TARGET :: panpartstart(nparts), &
933INTEGER(kind=c_int) :: nvertices
934REAL(kind=c_double),
TARGET :: padfx(nvertices), padfy(nvertices), &
935 padfz(nvertices), padfm(nvertices)
936REAL(kind=c_double) :: &
937 dfxmin, dfymin, dfzmin, dfmmin, dfxmax, dfymax, dfzmax, dfmmax
941CALL c_f_pointer(ftnobject, obj)
943obj%shpobject_orig = cobject
944obj%nshptype = nshptype
945obj%nshapeid = nshapeid
947obj%panpartstart => panpartstart
948obj%panparttype => panparttype
949obj%nvertices = nvertices
963END 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.