subroutine rmesh(ne,id,x,ec,e,a,cc,hsh,ind,me,mc,nh,ixyz)
implicit none
integer ne,ixyz
integer me,mc,nh
character*5 id(me)
double precision x(3,me)
double precision a(mc)
integer ec(me)
integer e(2,mc)
integer cc(2,mc)
integer hsh(nh)
integer ind(me)
double precision x1, y1, z1
double precision xhi, yhi, zhi
double precision xlo, ylo, zlo
character*5 wrd, wrd2
integer i
integer ihash
integer locat
integer nc
integer ne1
integer ne2
integer nu1
integer nu2
open(unit=1,file='MESH',status='old')
read(1,'(a)',end=10) wrd
if(wrd .ne. 'eleme' .and. wrd .ne. 'ELEME') then
stop 'no eleme in MESH'
endif
ne = 0
locat = 1
20 read(1,'(a,45x,3e10.4)',end=10) id(ne + 1),x1,y1,z1
x(1,ne+1) = x1
x(2,ne+1) = y1
x(3,ne+1) = z1
if(id(ne+1) .ne. ' ') then
ne = ne + 1
ind(ne) = ne
if(x1 .ne. 0.0 .or. y1 .ne. 0.0 .or. z1 .ne. 0.0) locat = 0
goto 20
endif
call hash(id,ind,hsh,ne,nh,ec)
if(locat .ne. 0) then
do i = 1, ne
x(1,i) = -999.d0
x(2,i) = -999.d0
enddo
open(unit=2,file='locat',status='old')
read(2,'(a)',end=50) wrd
if(wrd .ne. 'locat' .and. wrd .ne. 'LOCAT') then
stop 'no locat in locat'
endif
60 read(2,'(a5,5x,2f20.0)',end=50) wrd, x1, y1
if(wrd .ne. ' ') then
nu1 = ihash(wrd, id,ind,hsh,ne,nh)
if(nu1 .eq. 0) then
goto 60
endif
x(1,nu1) = x1
x(2,nu1) = y1
goto 60
endif
close(unit=2)
endif
ne1 = 0
ne2 = ne
do while(ne1 .lt. ne2)
x1 = x(1,ne1+1)
y1 = x(2,ne1+1)
z1 = x(3,ne1+1)
if(x1 .ne. -999.d0 .or. y1 .ne. -999.d0) then
if(ne1 .eq. 0) then
xhi = x1
xlo = x1
yhi = y1
ylo = y1
zhi = z1
zlo = z1
else
xhi = max(xhi,x1)
xlo = min(xlo,x1)
yhi = max(yhi,y1)
ylo = min(ylo,y1)
zhi = max(zhi,z1)
zlo = min(zhi,z1)
endif
ne1 = ne1 + 1
else if(x(1,ne2) .eq. -999.d0 .and. x(2,ne2) .eq. -999.d0) then
ne2 = ne2 - 1
else
wrd = id(ne1+1)
x(1,ne1+1) = x(1,ne2)
x(2,ne1+1) = x(2,ne2)
x(3,ne1+1) = x(3,ne2)
id(ne1+1) = id(ne2)
x(1,ne2) = x1
x(2,ne2) = y1
x(3,ne2) = z1
id(ne2) = wrd
endif
enddo
if(ixyz .eq. 0) then
xhi = xhi - xlo
yhi = yhi - ylo
zhi = zhi - zlo
if(zhi .le. min(xhi,yhi)) then
ixyz = 3
else if (yhi .le. min(xhi,zhi)) then
ixyz = 2
else
ixyz = 1
endif
endif
if(ixyz .eq. 2) then
do i = 1, ne1
x(2,i) = x(3,i)
enddo
elseif(ixyz .eq. 1) then
do i = 1, ne1
x(1,i) = x(2,i)
x(2,i) = x(3,i)
enddo
endif
call hash(id,ind,hsh,ne,nh,ec)
read(1,'(a)',end=10) wrd
if(wrd .ne. 'conne' .and. wrd .ne. 'CONNE') then
stop 'no conne in MESH'
endif
nc = 0
30 read(1,'(2a,40x,f10.0)',end=10) wrd,wrd2,a(nc+1)
if(wrd .ne. ' ' .and. wrd .ne. '+++ ') then
nc = nc + 1
nu1 = ihash(wrd, id,ind,hsh,ne,nh)
nu2 = ihash(wrd2,id,ind,hsh,ne,nh)
if(nu1 .eq. 0) then
c write(6,40) wrd,nc
goto 30
else if(nu2 .eq. 0) then
c write(6,40) wrd2,nc
goto 30
endif
e(1,nc) = nu1
e(2,nc) = nu2
if(nu1 .gt. ne1 .or. nu2 .gt. ne1) goto 30
cc(1,nc) = ec(nu1)
cc(2,nc) = ec(nu2)
ec(nu1) = nc
ec(nu2) = nc
goto 30
endif
close(unit=1)
ne = ne1
return
10 stop 'Premature EOF on MESH'
50 stop 'Premature EOF on locat'
40 format(' Unknown element "',a,'" at connection',i5)
end
subroutine hash(id,ind,hsh,ne,nh,h)
implicit none
integer ne, nh
character*5 id(ne)
integer ind(ne)
integer h(ne)
integer hsh(nh)
character*5 w1
integer i,i1,i2,j,k,n
do j = 1, ne
ccc--the following one line is added by G. Chen on 9/28/95
if(id(j)(4:4) .eq. '0') id(j)(4:4) = ' '
w1 = id(j)
n = 0
do i = 1, 5
n = n + i * ichar(w1(i:i))
enddo
h(j) = mod(n,nh) + 1
enddo
i1 = 0
do i = 1, nh
ccc--the following one line is changed by G. Chen on 9/28/95
i2 = i1 + 1
c-origin i2 = i1
do j = i2, ne
k = ind(j)
if(h(k) .eq. i) then
h(k) = 0
i1 = i1 + 1
ind(j) = ind(i1)
ind(i1) = k
endif
enddo
hsh(i) = i1
enddo
return
end
integer function ihash(wrd,id,ind,hsh,ne,nh)
implicit none
integer ne, nh
character*5 id(ne)
integer ind(ne)
integer hsh(nh)
character*5 wrd, w1
integer i,i1,i2,n
w1 = wrd
if(w1(4:4) .eq. '0') w1(4:4) = ' '
n = 0
do i = 1, 5
n = n + i * ichar(w1(i:i))
enddo
n = mod(n,nh) + 1
i1 = 1
if(n .gt. 1) i1 = hsh(n - 1) + 1
i2 = hsh(n)
do i = i1, i2
ihash = ind(i)
if(w1 .eq. id(ihash)) then
if(ihash .gt. ne) ihash = 0
return
endif
enddo
ihash = 0
return
end