20use,
INTRINSIC :: iso_c_binding
24INTEGER,
PARAMETER :: lencharattr=40, nshp=4, tshp=shpt_polygonz
26TYPE(shpfileobject) :: shphandle
27TYPE(shpobject) :: shpobj
29CHARACTER(len=1024) :: filename
31INTEGER :: nshpr, tshpr, nfield, nrec, nd
32REAL(kind=c_double) :: minbound(4), maxbound(4)
33CHARACTER(len=lencharattr) :: charattrr
35REAL(kind=c_double) :: doubleattrr
48shphandle = shpcreate(trim(filename), tshp)
50IF (shpfileisnull(shphandle) .OR. dbffileisnull(shphandle))
THEN
51 print*,
'Error opening ',trim(filename),
' for writing'
56j = dbfaddfield(shphandle,
'name', ftstring, lencharattr, 0)
58 print*,
'Error in dbfaddfield',0,j
61j = dbfaddfield(shphandle,
'number', ftinteger, 10, 0)
63 print*,
'Error in dbfaddfield',1,j
66j = dbfaddfield(shphandle,
'size', ftdouble, 30, 20)
68 print*,
'Error in dbfaddfield',2,j
74 print*,
'Creating shape',i
79 shpobj = shpcreatesimpleobject(tshp, &
80 SIZE(makesimpleshp(i, 0)), &
81 makesimpleshp(i, 0), &
82 makesimpleshp(i, 1), &
87 j = shpwriteobject(shphandle, -1, shpobj)
89 print*,
'Error in shpwriteobject',i,j
94 CALL shpdestroyobject(shpobj)
102 print*,
'Error in dbfwriteattribute, char',j
107 print*,
'Error in dbfwriteattribute, int',j
112 print*,
'Warning in dbfwriteattribute, double',j
118CALL shpclose(shphandle)
125shphandle = shpopen(trim(filename),
'rb')
127IF (shpfileisnull(shphandle) .OR. dbffileisnull(shphandle))
THEN
128 print*,
'Error opening ',trim(filename),
' for reading'
133CALL shpgetinfo(shphandle, nshpr, tshpr, minbound, maxbound, nfield, nrec)
134IF (nshpr /= nshp)
THEN
135 print*,
'Error in shpgetinfo, wrong number of shapes',nshp,nshpr
138IF (tshpr /= tshp)
THEN
139 print*,
'Error in shpgetinfo, wrong type of shapes',tshp,tshpr
143 print*,
'Error in shpgetinfo, wrong number of fields',3,nfield
146IF (nrec /= nshp)
THEN
147 print*,
'Error in shpgetinfo, wrong number of records',nshp,nrec
153 print*,
'Checking shape',i
155 shpobj = shpreadobject(shphandle, i)
157 IF (shpisnull(shpobj))
THEN
158 print*,
'Error in shpreadobject',i
164 IF (shpobj%nvertices /=
SIZE(makesimpleshp(i,0)))
THEN
165 print*,
'Error in shpreadobject, wrong number of vertices',i,&
166 SIZE(makesimpleshp(i,0)),shpobj%nvertices
170 IF (any(shpobj%padfx(:) /= makesimpleshp(i,0)))
THEN
171 print*,
'Error in shpreadobject, discrepancies in x',i
172 print*,makesimpleshp(i,0)
173 print*,shpobj%padfx(:)
177 IF (any(shpobj%padfy(:) /= makesimpleshp(i,1)))
THEN
178 print*,
'Error in shpreadobject, discrepancies in y',i
179 print*,makesimpleshp(i,1)
180 print*,shpobj%padfy(:)
184 IF (any(shpobj%padfz(:) /= makesimpleshp(i,2)))
THEN
185 print*,
'Error in shpreadobject, discrepancies in z',i
186 print*,makesimpleshp(i,2)
187 print*,shpobj%padfz(:)
193 CALL shpdestroyobject(shpobj)
198 IF (charattrr /= makechardbf(i))
THEN
199 print*,
'Error in dbfreadattribute, discrepancies in char'
200 print*,makechardbf(i)
206 IF (intattrr /= makeintdbf(i))
THEN
207 print*,
'Error in dbfreadattribute, discrepancies in int'
214 IF (doubleattrr /= makedoubledbf(i))
THEN
216 print*,
'Warning in dbfreadattribute, discrepancies in double'
217 print*,makedoubledbf(i)
224IF (dbfisattributenull(shphandle, 0, 0))
THEN
225 print*,
'Error in dbfisattributenull, non null attribute returned null'
228IF (.NOT.dbfisattributenull(shphandle, 3, 0))
THEN
229 print*,
'Error in dbfisattributenull, null attribute returned non null'
234CALL shpclose(shphandle)
239FUNCTION makesimpleshp(nshp, ncoord)
RESULT(shp)
240INTEGER,
INTENT(in) :: nshp, ncoord
241REAL(kind=c_double) :: shp(nshp+2)
245shp(:) = (/(-100.0_c_double + &
246 10.0_c_double*i + 100.0_c_double*nshp + 1000.0_c_double*ncoord, &
249END FUNCTION makesimpleshp
251FUNCTION makechardbf(nshp)
RESULT(dbf)
252INTEGER,
INTENT(in) :: nshp
253CHARACTER(len=lencharattr) :: dbf
261 dbf(i:i) = char(32 + mod(i+2*nshp,32))
266END FUNCTION makechardbf
268FUNCTION makeintdbf(nshp)
RESULT(dbf)
269INTEGER,
INTENT(in) :: nshp
274END FUNCTION makeintdbf
276FUNCTION makedoubledbf(nshp)
RESULT(dbf)
277INTEGER,
INTENT(in) :: nshp
278REAL(kind=c_double) :: dbf
280dbf = -5.894823e+12_c_double + 8.4827943e+11*nshp
282END FUNCTION makedoubledbf
284END PROGRAM shapelib_test
Interface to SUBROUTINEs for reading dbf attributes.
Interface to FUNCTIONs for setting dbf attributes.
Fortran 2003 interface to the shapelib http://shapelib.maptools.org/ library.