FortranGIS Version 3.0
ung2shp.F90
1PROGRAM ung2shp
2! Silly application that converts an Arc/Info ungenerate arc file
3! into a shapefile, the input file is passed as a command-line argument.
4!
5! Source of data in this format:
6! http://www.ngdc.noaa.gov/mgg/coast/
7! References:
8! http://www.grass-kr.org/html/v.in.arc.html
9! http://www.intevation.de/~jan/gen2shp/gen2shp.html
10USE shapelib
11IMPLICIT NONE
12
13CHARACTER(len=1024) :: filein, fileout
14TYPE(shpobject) :: shapes
15TYPE(shpfileobject) :: shapefile
16INTEGER,ALLOCATABLE :: shapesize(:)
17INTEGER :: i, j, dot, nshape, id
18DOUBLE PRECISION,ALLOCATABLE :: shp(:,:)
19
20CALL get_command_argument(1, filein)
21dot = index(filein, '.', back=.true.)
22IF (dot == 0) THEN
23 fileout = trim(filein)//'_out'
24ELSE IF (dot == 1) THEN
25 fileout = 'out'
26ELSE
27 fileout = filein(:dot-1)
28ENDIF
29
30OPEN(10, file=filein)
31! count shapes
32nshape = 0
33DO WHILE(read_ungenerate_shape(10) >= 0)
34 nshape = nshape + 1
35ENDDO
36
37IF (nshape <= 0) THEN
38 print*,'Error, bad number of shapes ',nshape,' in file ',trim(filein)
39 stop
40ENDIF
41print*,'Found ',nshape,' shapes'
42ALLOCATE(shapesize(nshape))
43
44rewind(10)
45! count size of each shape
46DO i = 1, 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)
50 stop
51 ENDIF
52ENDDO
53print*,'Counted shapes'
54ALLOCATE(shp(maxval(shapesize),2))
55
56shapefile = shpcreate(fileout, shpt_arc)
57IF (shpfileisnull(shapefile) .OR. dbffileisnull(shapefile)) THEN
58 print*,'Error, opening output shapefile ',trim(fileout)
59 stop
60ENDIF
61j = dbfaddfield(shapefile, 'ID', ftinteger, 9, 0)
62rewind(10)
63! import each shape
64DO i = 1, nshape
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)
68 j = dbfwriteattribute(shapefile, i-1, 0, id)
69 CALL shpdestroyobject(shapes)
70ENDDO
71
72CLOSE(10)
73CALL shpclose(shapefile)
74
75CONTAINS
76
77! Reads next shape from ungenerate file.
78! Returns the number of points in the shape, -1 for end of file or -2
79! in case of error.
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(:,:)
84INTEGER :: read_status
85
86CHARACTER(len=1024) :: line
87INTEGER :: npts, nptsmax, lshapeid
88DOUBLE PRECISION :: x(2)
89
90nptsmax = 0
91IF (PRESENT(values)) THEN
92 IF (SIZE(values,2) >= 2) THEN
93 nptsmax = SIZE(values,1)
94 ENDIF
95ENDIF
96
97READ(unit,'(A)',end=120,err=120)line
98IF (line == 'END') THEN ! end of file
99 read_status = -1
100 RETURN
101ENDIF
102
103READ(line,'(I10.0)',end=120,err=120) lshapeid
104IF (PRESENT(shapeid)) shapeid = lshapeid
105IF (lshapeid < 0) GOTO 120
106
107npts=0
108DO WHILE (.true.)
109 READ(unit,'(A)',end=120,err=120)line
110 IF (line == 'END') THEN ! end of shape
111 read_status = npts
112 RETURN
113 ELSE
114 READ(line,*,end=120,err=120)x
115 npts = npts + 1
116 IF (nptsmax >= npts) values(npts,1:2) = x(:)
117 ENDIF
118ENDDO
119
120RETURN ! never reached
121
122120 read_status = -2
123RETURN
124
125END FUNCTION read_ungenerate_shape
126
127END PROGRAM ung2shp
128
Interface to FUNCTIONs for setting dbf attributes.
Definition shapelib.F90:156
Fortran 2003 interface to the shapelib http://shapelib.maptools.org/ library.
Definition shapelib.F90:53