13CHARACTER(len=1024) :: filein, fileout
14TYPE(shpobject) :: shapes
15TYPE(shpfileobject) :: shapefile
16INTEGER,
ALLOCATABLE :: shapesize(:)
17INTEGER :: i, j, dot, nshape, id
18DOUBLE PRECISION,
ALLOCATABLE :: shp(:,:)
20CALL get_command_argument(1, filein)
21dot = index(filein,
'.', back=.true.)
23 fileout = trim(filein)//
'_out'
24ELSE IF (dot == 1)
THEN
27 fileout = filein(:dot-1)
33DO WHILE(read_ungenerate_shape(10) >= 0)
38 print*,
'Error, bad number of shapes ',nshape,
' in file ',trim(filein)
41print*,
'Found ',nshape,
' shapes'
42ALLOCATE(shapesize(nshape))
47 shapesize(i) = read_ungenerate_shape(10)
48 IF (shapesize(i) < 0)
THEN
49 print*,
'Error, bad size of shape ',i,shapesize(i),
' in file ',trim(filein)
53print*,
'Counted shapes'
54ALLOCATE(shp(maxval(shapesize),2))
56shapefile = shpcreate(fileout, shpt_arc)
57IF (shpfileisnull(shapefile) .OR. dbffileisnull(shapefile))
THEN
58 print*,
'Error, opening output shapefile ',trim(fileout)
61j = dbfaddfield(shapefile,
'ID', ftinteger, 9, 0)
65 j = read_ungenerate_shape(10, shapeid=id, values=shp)
66 shapes = shpcreatesimpleobject(shpt_arc, shapesize(i), shp(1,1), shp(1,2))
67 j = shpwriteobject(shapefile, -1, shapes)
69 CALL shpdestroyobject(shapes)
73CALL shpclose(shapefile)
80FUNCTION read_ungenerate_shape(unit, shapeid, values)
RESULT(read_status)
81INTEGER,
INTENT(in) :: unit
82INTEGER,
INTENT(out),
OPTIONAL :: shapeid
83DOUBLE PRECISION,
INTENT(out),
OPTIONAL :: values(:,:)
86CHARACTER(len=1024) :: line
87INTEGER :: npts, nptsmax, lshapeid
88DOUBLE PRECISION :: x(2)
91IF (
PRESENT(values))
THEN
92 IF (
SIZE(values,2) >= 2)
THEN
93 nptsmax =
SIZE(values,1)
97READ(unit,
'(A)',
end=120,err=120)line
98IF (line ==
'END')
THEN
103READ(line,
'(I10.0)',
end=120,err=120) lshapeid
104IF (
PRESENT(shapeid)) shapeid = lshapeid
105IF (lshapeid < 0)
GOTO 120
109 READ(unit,
'(A)',
end=120,err=120)line
110 IF (line ==
'END')
THEN
114 READ(line,*,
end=120,err=120)x
116 IF (nptsmax >= npts) values(npts,1:2) = x(:)
125END FUNCTION read_ungenerate_shape
Interface to FUNCTIONs for setting dbf attributes.
Fortran 2003 interface to the shapelib http://shapelib.maptools.org/ library.