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