1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
C
C Written and copyright by:
C Barry Joe, Dept. of Computing Science, Univ. of Alberta
C Edmonton, Alberta, Canada T6G 2H1
C Phone: (403) 492-5757 Email: barry@cs.ualberta.ca
C
C Modifications by Jason Gobat (jgobat@ucsd.edu) to turn what
C was a main program into a subroutine to interface with the
C FElt system (this is the only Fortran routine that FElt calls).
C
SUBROUTINE GEOMPK(TOLIN,ANGSPC,ANGTOL,KAPPA,DMIN,NMIN,NTRID,NVC,
$ NCUR,NVBC,VCL,TIL,NTRI,ISTAT)
IMPLICIT LOGICAL (A-Z)
C
C Driver routine for interfacing the Geompack library
C
INTEGER ISTAT
INTEGER IERR,IPRT,MSGLVL
DOUBLE PRECISION PI,TOL
COMMON /GERROR/ IERR
COMMON /GCONST/ PI,TOL
COMMON /GPRINT/ IPRT,MSGLVL
C
INTEGER MAXHV,MAXIW,MAXNC,MAXPV,MAXTI,MAXVC,MAXWK
PARAMETER (MAXHV = 500)
PARAMETER (MAXIW = 2000)
PARAMETER (MAXNC = 60)
PARAMETER (MAXPV = 5000)
PARAMETER (MAXTI = 8000)
PARAMETER (MAXVC = 15000)
PARAMETER (MAXWK = 1500)
C
INTEGER HVL(MAXHV),IWK(MAXIW)
INTEGER NVBC(MAXNC),PVL(4,MAXPV),REGNUM(MAXHV),TIL(3,MAXTI)
INTEGER TSTART(MAXHV),VNUM(MAXPV),VSTART(MAXPV)
INTEGER IMEAS,IRDR,NCUR,NHOLA,NHOLE,NH
INTEGER NMIN,NPOLG,NTRI,NTRID,NVC,NVERT
C
DOUBLE PRECISION AREA(MAXHV),H(MAXHV),IANG(MAXPV),PSI(MAXHV)
DOUBLE PRECISION VCL(2,MAXVC),WK(MAXWK)
DOUBLE PRECISION ANGSPC,ANGTOL
DOUBLE PRECISION DMIN,KAPPA,TOLIN,UMDF2
LOGICAL HFLAG
EXTERNAL UMDF2
C
C Read in vertices of general polygonal region.
C CASE = 1 : simple polygon or multiply connected polygonal region
C
IRDR = 5
IMEAS = 7
CALL INITCB(TOLIN)
ANGSPC = ANGSPC*PI/180.0D0
ANGTOL = ANGTOL*PI/180.0D0
HFLAG = (KAPPA .GE. 0.0D0 .AND. KAPPA .LE. 1.0D0)
IF (NVC .GT. MAXVC) THEN
ISTAT = 24
RETURN
ELSE IF (NCUR .GT. MAXNC) THEN
ISTAT = 24
RETURN
ENDIF
C
C Call routine DSMCPR or DSPGDC to set data structures in arrays
C REGNUM, HVL, PVL, IANG, HOLV = IWK.
C
NHOLE = NCUR - 1
CALL DSMCPR(NHOLE,NVBC,VCL,MAXHV,MAXPV,MAXIW,NVC,NPOLG,NVERT,
$ NHOLA,REGNUM,HVL,PVL,IANG,IWK)
IF (IERR .NE. 0) THEN
ISTAT = IERR
RETURN
ENDIF
NH = NHOLE*2 + NHOLA
C
C Obtain simple and convex polygon decompositions, and print
C measurements.
C
CALL SPDEC2(ANGSPC,ANGTOL,NVC,NPOLG,NVERT,NHOLE,NHOLA,MAXVC,MAXHV,
$ MAXPV,MAXIW-NH,MAXWK,IWK,VCL,REGNUM,HVL,PVL,IANG,IWK(NH+1),WK)
CALL CVDEC2(ANGSPC,ANGTOL,NVC,NPOLG,NVERT,MAXVC,MAXHV,MAXPV,MAXIW,
$ MAXWK,VCL,REGNUM,HVL,PVL,IANG,IWK,WK)
IF (IERR .NE. 0) THEN
ISTAT = IERR
RETURN
ENDIF
C
C Obtain further convex polygon decomposition based on mesh
C distribution function, and triangle sizes for the polygons.
C Then print measurements.
C
CALL EQDIS2(HFLAG,UMDF2,KAPPA,ANGSPC,ANGTOL,DMIN,NMIN,NTRID,NVC,
$ NPOLG,NVERT,MAXVC,MAXHV,MAXPV,MAXIW,MAXWK,VCL,REGNUM,HVL,PVL,
$ IANG,AREA,PSI,H,IWK,WK)
IF (IERR .NE. 0) THEN
ISTAT = IERR
RETURN
ENDIF
C
C Triangulate each convex polygon in decomposition according to
C mesh spacings in H array.
C
CALL TRIPR2(NVC,NPOLG,NVERT,MAXVC,MAXTI,MAXIW,MAXWK,H,VCL,HVL,PVL,
$ IANG,NTRI,TIL,VSTART,VNUM,TSTART,IWK,WK)
IF (IERR .NE. 0) THEN
ISTAT = IERR
RETURN
ENDIF
C
C Check for errors, if none we succeeded
C
IF (IERR .NE. 0) THEN
ISTAT = IERR
RETURN
ENDIF
ISTAT = 0
610 FORMAT (1X,'*** ',A,' must be increased to',I8)
END
SUBROUTINE GEOMPK_(TOLIN,ANGSPC,ANGTOL,KAPPA,DMIN,NMIN,NTRID,NVC,
$ NCUR,NVBC,VCL,TIL,NTRI,ISTAT)
IMPLICIT LOGICAL (A-Z)
C
C Driver routine for interfacing the Geompack library
C
INTEGER ISTAT
INTEGER IERR,IPRT,MSGLVL
DOUBLE PRECISION PI,TOL
COMMON /GERROR/ IERR
COMMON /GCONST/ PI,TOL
COMMON /GPRINT/ IPRT,MSGLVL
C
INTEGER MAXHV,MAXIW,MAXNC,MAXPV,MAXTI,MAXVC,MAXWK
PARAMETER (MAXHV = 350)
PARAMETER (MAXIW = 900)
PARAMETER (MAXNC = 30)
PARAMETER (MAXPV = 2000)
PARAMETER (MAXTI = 8000)
PARAMETER (MAXVC = 5000)
PARAMETER (MAXWK = 1500)
C
INTEGER NVBC(MAXNC),TIL(3,MAXTI)
INTEGER NCUR
INTEGER NMIN,NTRI,NTRID,NVC
C
DOUBLE PRECISION VCL(2,MAXVC)
DOUBLE PRECISION ANGSPC,ANGTOL
DOUBLE PRECISION DMIN,KAPPA,TOLIN
C
CALL GEOMPK(TOLIN,ANGSPC,ANGTOL,KAPPA,DMIN,NMIN,NTRID,NVC,
$ NCUR,NVBC,VCL,TIL,NTRI,ISTAT)
END
|
