Subroutine CATALOG
subroutine catalog(ncat,cat,x,ec,e,cc,ne,mc)
implicit none
integer ncat,ne,mc
double precision x(3,ne)
integer ec(ne)
integer e(2,mc)
integer cc(2,mc)
integer cat(4,mc)
integer i
integer kc, kc1
integer n, n0, n1, n2, nc, nc0, nc1
integer mcat
double precision x0, y0, x1, y1, x2, y2
double precision xp, slope, slope0
double precision u, v, u0, v0
c
c set connection numbers negative until catalog is computed
c
nc = 0
do i = 1, ne
if(ec(i) .gt. nc) nc = ec(i)
ec(i) = -ec(i)
enddo
do i = 1, nc
cc(1,i) = -cc(1,i)
cc(2,i) = -cc(2,i)
enddo
c
c compute catalog
c
ncat = 0
do 20 n0 =1, ne
nc0 = ec(n0)
10 if(nc0 .lt. 0) then
nc0 = -nc0
ec(n0) = nc0
else if(nc0 .ne. 0) then
nc1 = nc0
i = (n0 - e(1,nc0))/(e(2,nc0) - e(1,nc0))
nc0 = cc(i+1,nc0)
if(nc0 .gt. 0) goto 10
nc0 = -nc0
cc(i+1,nc1) = nc0
endif
if(nc0 .eq. 0) goto 20
n1 = n0
i = (n1 - e(1,nc0))/(e(2,nc0) - e(1,nc0))
mcat = ncat + 1
cat(1,mcat) = n1
x1 = x(1,n1)
y1 = x(2,n1)
n2 = e(2-i,nc0)
n = 1
do while(n2 .ne. n0)
if(n .ge. 4) then
cat(1,mcat+1) = cat(1,mcat)
cat(2,mcat+1) = cat(n,mcat)
mcat = mcat + 1
n = 2
endif
x0 = x1
y0 = y1
n1 = n2
x1 = x(1,n1)
y1 = x(2,n1)
n = n + 1
cat(n,mcat) = n1
kc = 0
nc1 = 0
nc = ec(n1)
do while(nc .ne. 0)
if(nc .gt. 0) goto 30
nc = -nc
i = (n1 - e(1,nc))/(e(2,nc) - e(1,nc))
n2 = e(2-i,nc)
x2 = x(1,n2)
y2 = x(2,n2)
u0 = x0 - x1
v0 = y0 - y1
u = x2 - x1
v = y2 - y1
xp = v0*u - u0*v
if(xp .le. 0.) goto 30
slope = (u0*u + v0*v)/xp
if(kc .ne. 0 .and. slope .lt. slope0) goto 30
kc1 = nc1
kc = nc
slope0 = slope
goto 30
30 i = (n1 - e(1,nc))/(e(2,nc) - e(1,nc))
nc1 = nc
nc = cc(i+1,nc)
enddo
if(kc .eq. 0) goto 10
i = (n1 - e(1,kc))/(e(2,kc) - e(1,kc))
n2 = e(2-i,kc)
if(kc1 .eq. 0) then
ec(n1) = kc
else
i = (n1 - e(1,kc1))/(e(2,kc1) - e(1,kc1))
cc(i+1,kc1) = kc
endif
enddo
do while(n .lt. 4)
cat(n+1,mcat) = cat(n,mcat)
n = n + 1
enddo
ncat = mcat
goto 10
20 enddo
return
end