You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
355 lines
12 KiB
355 lines
12 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
|
C
|
|
C See packages/seacas/LICENSE for details
|
|
|
|
C=======================================================================
|
|
SUBROUTINE HIDPAR (LINSET, IPSET, NPART, IEDSET, NEDGES,
|
|
& LENF, NLNKE, NLNKF, LINKF, XN, YN, ZN, HIDEF,
|
|
& HIDENP, TVHMAX, ICROSS, XP, YP, ZP)
|
|
C=======================================================================
|
|
|
|
C --*** HIDPAR *** (MESH) Create new nodes for partial lines
|
|
C -- Written by Amy Gilkey - revised 02/24/88
|
|
C --
|
|
C --HIDPAR finds the amount of a partial line that is hidden. It then
|
|
C --creates a new node at the last visible point and changes the LINSET(3,x)
|
|
C --to point to the new node.
|
|
C --
|
|
C --Parameters:
|
|
C -- LINSET - I/O - the sorted line set
|
|
C -- IPSET - I/O - the indices of the partial line set
|
|
C -- NPART - I/O - the number of lines in the partial line set
|
|
C -- IEDSET - IN - the edge line set;
|
|
C -- (0) = face defining edge; 0 to delete edge
|
|
C -- NEDGES - I/O - the number of lines in the edge set
|
|
C -- LENF - IN - the cumulative face counts by element block
|
|
C -- NLNKE - IN - the number of nodes per element
|
|
C -- NLNKF - IN - the number of nodes per face
|
|
C -- LINKF - IN - the connectivity for all faces
|
|
C -- XN,YN,ZN - IN - the nodal coordinates
|
|
C -- HIDEF(i) - IN - true iff face i is hidden
|
|
C -- HIDENP - I/O - node status (as in HIDDEN)
|
|
C -- TVHMAX - SCR - size is NPART
|
|
C -- CROSS - SCR - size is NPART
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NUMNPF, LLNSET of /D3NUMS/
|
|
|
|
PARAMETER (KFVIS=0, KFNODH=10, KFPOUT=20, KFOUT=90, KFAWAY=100)
|
|
PARAMETER (KNVIS=0, KNFOVR=10, KNHID=100)
|
|
|
|
PARAMETER (EPS = .001)
|
|
C --EPS is a normalized error allowance
|
|
|
|
include 'debug.blk'
|
|
include 'dbnums.blk'
|
|
include 'd3nums.blk'
|
|
include 'sizes.blk'
|
|
|
|
INTEGER LINSET(LLNSET,*)
|
|
INTEGER IPSET(*)
|
|
INTEGER IEDSET(0:2,*)
|
|
INTEGER LENF(0:NELBLK)
|
|
INTEGER NLNKE(NELBLK)
|
|
INTEGER NLNKF(NELBLK)
|
|
INTEGER LINKF(*)
|
|
REAL XN(*), YN(*), ZN(*)
|
|
INTEGER HIDEF(*)
|
|
INTEGER HIDENP(*)
|
|
REAL TVHMAX(*)
|
|
INTEGER ICROSS(*)
|
|
REAL XP(*), YP(*), ZP(*)
|
|
|
|
LOGICAL CKCROS
|
|
|
|
C --Clear out partial line parameter
|
|
|
|
CALL INIREA (NPART, -99.0, TVHMAX)
|
|
CALL INIINT (NPART, 0, ICROSS)
|
|
|
|
C --Find an epsilon based on the average edge size
|
|
|
|
XLEN = 0.0
|
|
YLEN = 0.0
|
|
DO 100 IEDG = 1, NEDGES
|
|
IF (IEDSET(0,IEDG) .EQ. 0) GOTO 100
|
|
N1 = IEDSET(1,IEDG)
|
|
N2 = IEDSET(2,IEDG)
|
|
X1 = XN(N1)
|
|
X2 = XN(N2)
|
|
Y1 = YN(N1)
|
|
Y2 = YN(N2)
|
|
XLEN = XLEN + ABS (X2-X1)
|
|
YLEN = YLEN + ABS (Y2-Y1)
|
|
100 CONTINUE
|
|
|
|
IF (NEDGES .GT. 0) THEN
|
|
XLEN = XLEN / NEDGES
|
|
YLEN = YLEN / NEDGES
|
|
EPSDAT = SQRT (XLEN**2 + YLEN**2) * .01
|
|
END IF
|
|
|
|
C --Check each edge line against each partial line for overlap
|
|
|
|
NOLDPT = NPART
|
|
|
|
nhid = 0
|
|
DO 130 IEDG = 1, NEDGES
|
|
IFAC = IEDSET(0,IEDG)
|
|
IF (IFAC .EQ. 0) GOTO 130
|
|
N1 = IEDSET(1,IEDG)
|
|
N2 = IEDSET(2,IEDG)
|
|
|
|
C --Calculate X-Y-Z box enclosing edge line
|
|
|
|
X1 = XN(N1)
|
|
X2 = XN(N2)
|
|
XMIN = MIN (X1, X2) - EPSDAT
|
|
XMAX = MAX (X1, X2) + EPSDAT
|
|
Y1 = YN(N1)
|
|
Y2 = YN(N2)
|
|
YMIN = MIN (Y1, Y2) - EPSDAT
|
|
YMAX = MAX (Y1, Y2) + EPSDAT
|
|
Z1 = ZN(N1)
|
|
Z2 = ZN(N2)
|
|
ZMIN = MIN (Z1, Z2) - EPSDAT
|
|
ZMAX = MAX (Z1, Z2) + EPSDAT
|
|
|
|
XLN = X2 - X1
|
|
YLN = Y2 - Y1
|
|
|
|
IP = 1
|
|
110 CONTINUE
|
|
IF (IP .LE. NPART) THEN
|
|
IH = LINSET(2,IPSET(IP))
|
|
IV = LINSET(1,IPSET(IP))
|
|
|
|
C --Determine if partial line is within X-Y-Z box enclosing edge line
|
|
|
|
X0 = XN(IH)
|
|
XV = XN(IV)
|
|
IF (XMAX .LT. MIN (X0, XV)) GOTO 120
|
|
IF (XMIN .GT. MAX (X0, XV)) GOTO 120
|
|
Y0 = YN(IH)
|
|
YV = YN(IV)
|
|
IF (YMAX .LT. MIN (Y0, YV)) GOTO 120
|
|
IF (YMIN .GT. MAX (Y0, YV)) GOTO 120
|
|
Z0 = ZN(IH)
|
|
ZV = ZN(IV)
|
|
IF (ZMAX .LT. MIN (Z0, ZV)) GOTO 120
|
|
|
|
IF ((N1 .EQ. IV) .OR. (N2 .EQ. IV)) THEN
|
|
IF (N2 .NE. IH) ICROSS(IP) = IEDG
|
|
GOTO 120
|
|
END IF
|
|
IF (N2 .EQ. IH) GOTO 120
|
|
|
|
C --Calculate the intersection of the edge and the partial line
|
|
C --Solve the simultaneous equations:
|
|
C -- X = X0 + (XV - X0) * TVH = X1 + (X2 - X1) * TLN
|
|
C -- Y = Y0 + (YV - Y0) * TVH = Y1 + (Y2 - Y1) * TLN
|
|
|
|
XVH = XV - X0
|
|
YVH = YV - Y0
|
|
XLH = X1 - X0
|
|
YLH = Y1 - Y0
|
|
DET = XVH * (-YLN) - YVH * (-XLN)
|
|
IF (DET .EQ. 0.0) GOTO 120
|
|
|
|
TVH = (-YLN * XLH + XLN * YLH) / DET
|
|
IF ((TVH .GE. 0) .AND. (TVH .LE. 1+EPS)) THEN
|
|
TLN = (-YVH * XLH + XVH * YLH) / DET
|
|
IF ((TLN .GE. -EPS) .AND. (TLN .LE. 1+EPS)) THEN
|
|
|
|
C --Save the overlap farthest from the hidden node
|
|
|
|
IF (TVHMAX(IP) .LT. TVH) THEN
|
|
IF (ZMIN .GT. Z0) THEN
|
|
TVHNEW = TVH
|
|
ELSE
|
|
ZCR = Z0 + (ZV - Z0) * TVH
|
|
ZCLN = Z1 + (Z2 - Z1) * TLN
|
|
IF (ZCR .LE. ZCLN) THEN
|
|
TVHNEW = TVH
|
|
ELSE
|
|
TVHNEW = TVHMAX(IP)
|
|
END IF
|
|
END IF
|
|
|
|
C --Delete totally hidden lines from partial set
|
|
|
|
IF (TVHNEW .GE. 1-EPS) THEN
|
|
IF (TLN .LE. 0.5) THEN
|
|
N = N1
|
|
ELSE
|
|
N = N2
|
|
END IF
|
|
IELB = 0
|
|
IXL = IDBLNK (IELB, IFAC, LENF, NLNKF)
|
|
IF (CKCROS (N, IH, NLNKF(IELB), LINKF(IXL),
|
|
& XN, YN, ZN)) THEN
|
|
|
|
C --If face hides the line, move partial line to totally
|
|
C --hidden list
|
|
|
|
I = IPSET(IP)
|
|
IPSET(IP) = IPSET(NPART)
|
|
IPSET(NPART) = I
|
|
TVHMAX(IP) = TVHMAX(NPART)
|
|
ICROSS(IP) = ICROSS(NPART)
|
|
NPART = NPART - 1
|
|
IP = IP - 1
|
|
ELSE IF (ICROSS(IP) .EQ. 0) THEN
|
|
ICROSS(IP) = IEDG
|
|
END IF
|
|
|
|
ELSE IF ((TLN .GE. 0.0) .AND. (TLN .LE. 1.0)) THEN
|
|
TVHMAX(IP) = TVHNEW
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
120 CONTINUE
|
|
IP = IP + 1
|
|
GOTO 110
|
|
END IF
|
|
130 CONTINUE
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'invisible lines =', noldpt-npart
|
|
|
|
C --Group those partial lines which may end on an edge
|
|
|
|
NNPART = NPART
|
|
DO 140 IP = NNPART, 1, -1
|
|
IF ((ICROSS(IP) .NE. 0) .OR. (TVHMAX(IP) .LT. EPS)) THEN
|
|
I = IPSET(IP)
|
|
IPSET(IP) = IPSET(NPART)
|
|
IPSET(NPART) = I
|
|
T = TVHMAX(IP)
|
|
TVHMAX(IP) = TVHMAX(NPART)
|
|
TVHMAX(NPART) = T
|
|
I = ICROSS(IP)
|
|
ICROSS(IP) = ICROSS(NPART)
|
|
ICROSS(NPART) = I
|
|
NPART = NPART - 1
|
|
END IF
|
|
140 CONTINUE
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'questionable lines =', NNPART-npart
|
|
|
|
C --Find the midpoint of the questionable partial lines
|
|
|
|
DO 150 IP = NPART+1, NNPART
|
|
IH = LINSET(2,IPSET(IP))
|
|
IV = LINSET(1,IPSET(IP))
|
|
TVH = TVHMAX(IP)
|
|
if (tvh .lt. 0) tvh = 0.0
|
|
XP(IP) = 0.5 * (XN(IV) + XN(IH) + (XN(IV) - XN(IH)) * TVH)
|
|
YP(IP) = 0.5 * (YN(IV) + YN(IH) + (YN(IV) - YN(IH)) * TVH)
|
|
ZP(IP) = 0.5 * (ZN(IV) + ZN(IH) + (ZN(IV) - ZN(IH)) * TVH)
|
|
150 CONTINUE
|
|
|
|
C --Find out if the midpoint of the questionable partial lines are
|
|
C --hidden by a visible face
|
|
|
|
NQUES = NNPART - NPART
|
|
IQUES = NPART+1
|
|
DO 170 IELB = 1, NELBLK
|
|
IF (NLNKE(IELB) .GE. 4) THEN
|
|
IXL = IDBLNK (IELB, 0, LENF, NLNKF)
|
|
DO 160 IFAC = LENF(IELB-1)+1, LENF(IELB)
|
|
IF (HIDEF(IFAC) .LT. KFOUT) THEN
|
|
CALL HIDMID (NLNKF(IELB), LINKF(IXL),
|
|
& XN, YN, ZN, LINSET,
|
|
& IPSET(IQUES), TVHMAX(IQUES), ICROSS(IQUES),
|
|
& XP(IQUES), YP(IQUES), ZP(IQUES), NQUES)
|
|
END IF
|
|
IXL = IXL + NLNKF(IELB)
|
|
160 CONTINUE
|
|
END IF
|
|
170 CONTINUE
|
|
NPART = NPART + NQUES
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'invisible lines =', NNPART-npart
|
|
|
|
C --Delete the edges which are totally hidden lines
|
|
|
|
nhid = 0
|
|
DO 190 IP = NPART+1, NOLDPT
|
|
IV = LINSET(1,IPSET(IP))
|
|
IH = LINSET(2,IPSET(IP))
|
|
DO 180 IEDG = 1, NEDGES
|
|
IF (IEDSET(1,IEDG) .EQ. IV) THEN
|
|
IF (IEDSET(2,IEDG) .EQ. IH) THEN
|
|
IEDSET(0,IEDG) = 0
|
|
nhid = nhid + 1
|
|
GOTO 190
|
|
END IF
|
|
END IF
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'invisible edges =', nhid
|
|
|
|
C --Delete totally visible lines from partial set
|
|
|
|
nwhole = 0
|
|
DO 200 IP = IQUES, NPART
|
|
IF (TVHMAX(IP) .LT. 0.001) THEN
|
|
C --Line is totally visible, so delete from partial line set as visible
|
|
C --and mark hidden node as visible
|
|
nwhole = nwhole + 1
|
|
IH = LINSET(2,IPSET(IP))
|
|
HIDENP(IH) = KNVIS
|
|
LINSET(3,IPSET(IP)) = 1
|
|
END IF
|
|
200 CONTINUE
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'whole lines =', nwhole
|
|
|
|
C --Calculate the visible part of each partial line, put coordinates into
|
|
C --XP, YP, ZP (cannot overwrite coordinates until done using them
|
|
C --for partial line calculation)
|
|
|
|
DO 210 IP = 1, NPART
|
|
IF (LINSET(3,IPSET(IP)) .EQ. 0) THEN
|
|
IH = LINSET(2,IPSET(IP))
|
|
IV = LINSET(1,IPSET(IP))
|
|
TVH = TVHMAX(IP)
|
|
XP(IP) = XN(IH) + (XN(IV) - XN(IH)) * TVH
|
|
YP(IP) = YN(IH) + (YN(IV) - YN(IH)) * TVH
|
|
ZP(IP) = ZN(IH) + (ZN(IV) - ZN(IH)) * TVH
|
|
END IF
|
|
210 CONTINUE
|
|
|
|
C --Make new partial line nodes by filling in coordinates of hidden nodes
|
|
C --and pointing LINSET(3,i) to these nodes
|
|
|
|
C --Skip node 1 since LINSET(3,x) = 1 is reserved for whole lines
|
|
IPART = NUMNPF
|
|
|
|
DO 230 IP = 1, NPART
|
|
IF (LINSET(3,IPSET(IP)) .EQ. 0) THEN
|
|
IPART = IPART + 1
|
|
IF (IPART .GT. NPSIZ) THEN
|
|
WRITE (*, 10000) 'ERROR in HIDPAR', IP, IPART, NUMNPF
|
|
10000 FORMAT (1X, A, 3I5)
|
|
GOTO 240
|
|
END IF
|
|
LINSET(3,IPSET(IP)) = IPART
|
|
XN(IPART) = XP(IP)
|
|
YN(IPART) = YP(IP)
|
|
ZN(IPART) = ZP(IP)
|
|
END IF
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'partial lines =', npart
|
|
|
|
C --Reset partial line set to include totally KNVISible lines
|
|
NPART = NNPART
|
|
|
|
RETURN
|
|
END
|
|
|