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.
339 lines
11 KiB
339 lines
11 KiB
2 years ago
|
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 PAINTF (CNTR0, CNTR1, VARNP, NLNKF, LINKF1,
|
||
|
|
& XN, YN, ZN, XF, YF, ZF)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** PAINTF *** (DETOUR) Paint face contour for a face
|
||
|
|
C -- Modified by John H. Glick - 10/26/88
|
||
|
|
C -- Written by Amy Gilkey - revised 10/22/87
|
||
|
|
C --
|
||
|
|
C --PAINTF paints a contour section for a face. The contour algorithm
|
||
|
|
C --assumes that the elements do not contain internal nodes.
|
||
|
|
C --The element interpolation field is approximated by logically drawing
|
||
|
|
C --lines from each node to the element center and, thusly, dividing the
|
||
|
|
C --element into triangles. Contour sections are then drawn by connecting
|
||
|
|
C --the intersection points of the sub-element edges and the contour
|
||
|
|
C --plane.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- CNTR0, CNTR1 - the contour values delimiting the contour section
|
||
|
|
C -- VARNP - IN - the contour function values
|
||
|
|
C -- NLNKF - IN - the number of nodes per face
|
||
|
|
C -- LINKF1 - IN - the connectivity for the face
|
||
|
|
C -- XN, YN, ZN - IN - the nodal coordinates
|
||
|
|
C -- XF, YF, ZF - IN - the face center coordinates
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses IS3DIM of /D3NUMS/
|
||
|
|
|
||
|
|
PARAMETER (KDONE=0, KERR1=-1, KERR2=-2, KERR3=-3,
|
||
|
|
& KCORNR=1, KISIDE=2, KMIDDL=3, KOSIDE=4, KFINDS=5)
|
||
|
|
|
||
|
|
COMMON /D3NUMS/ IS3DIM, NNPSUR, NUMNPF, LLNSET
|
||
|
|
LOGICAL IS3DIM
|
||
|
|
|
||
|
|
REAL VARNP(*)
|
||
|
|
INTEGER LINKF1(NLNKF)
|
||
|
|
REAL XN(*), YN(*), ZN(*)
|
||
|
|
|
||
|
|
LOGICAL INTERP_BL
|
||
|
|
LOGICAL INTERC, INTEQC
|
||
|
|
LOGICAL ISDONE(8)
|
||
|
|
REAL XPTS(24), YPTS(24)
|
||
|
|
|
||
|
|
ICNVS (I) = MOD (I+NNPF-1, NNPF) + 1
|
||
|
|
C --ICNVS converts out of range side numbers (1..NLNKF)
|
||
|
|
|
||
|
|
INTERC (CN, C0, C1) = (C0 .LT. CN) .AND. (CN .LT. C1)
|
||
|
|
C --INTERC returns true iff corner is within two contours
|
||
|
|
INTEQC (CN, CNN, C0, C1) = (CN .EQ. CNN)
|
||
|
|
& .AND. ((CN .EQ. C0) .OR. (CN .EQ. C1))
|
||
|
|
C --INTEQC returns true iff corners are equal to each other and a contour
|
||
|
|
|
||
|
|
if (nlnkf .eq. 4) then
|
||
|
|
C -- Most common case for 3D
|
||
|
|
C -- Compute center function value and coordinates
|
||
|
|
|
||
|
|
FM = (varnp(linkf1(1)) + varnp(linkf1(2)) + varnp(linkf1(3)) +
|
||
|
|
* varnp(linkf1(4))) / 4.0
|
||
|
|
XM = XF
|
||
|
|
YM = YF
|
||
|
|
NTRI = NLNKF
|
||
|
|
NNPF = NLNKF
|
||
|
|
MAXPT = 12
|
||
|
|
|
||
|
|
else IF (NLNKF .EQ. 3) THEN
|
||
|
|
|
||
|
|
C --Special case - triangle element
|
||
|
|
|
||
|
|
N = LINKF1(2)
|
||
|
|
FM = VARNP(N)
|
||
|
|
XM = XN(N)
|
||
|
|
YM = YN(N)
|
||
|
|
IFL = 0
|
||
|
|
NTRI = 1
|
||
|
|
NNPF = NLNKF
|
||
|
|
|
||
|
|
ELSE IF ((.NOT. IS3DIM) .AND. (NLNKF .EQ. 8)) THEN
|
||
|
|
|
||
|
|
C --Compute center function value and coordinates
|
||
|
|
|
||
|
|
FM = -0.25 * (varnp(linkf1(1)) + varnp(linkf1(3)) +
|
||
|
|
* varnp(linkf1(5)) + varnp(linkf1(7))) + 0.5 *
|
||
|
|
* (varnp(linkf1(2)) + varnp(linkf1(4)) +
|
||
|
|
* varnp(linkf1(6)) + varnp(linkf1(8)))
|
||
|
|
FM = FM
|
||
|
|
XM = XF
|
||
|
|
YM = YF
|
||
|
|
NTRI = NLNKF
|
||
|
|
NNPF = NLNKF
|
||
|
|
MAXPT = 24
|
||
|
|
|
||
|
|
ELSE IF ((.NOT. IS3DIM) .AND. (NLNKF .EQ. 9)) THEN
|
||
|
|
|
||
|
|
C --Compute center function value and coordinates
|
||
|
|
|
||
|
|
FM = VARNP(LINKF1(9))
|
||
|
|
XM = XN(LINKF1(9))
|
||
|
|
YM = YN(LINKF1(9))
|
||
|
|
NTRI = NLNKF - 1
|
||
|
|
NNPF = NLNKF - 1
|
||
|
|
MAXPT = 24
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C --Compute center function value and coordinates
|
||
|
|
|
||
|
|
FM = 0.0
|
||
|
|
DO 120 K = 1, NLNKF
|
||
|
|
FM = FM + VARNP(LINKF1(K))
|
||
|
|
120 CONTINUE
|
||
|
|
FM = FM / NLNKF
|
||
|
|
XM = XF
|
||
|
|
YM = YF
|
||
|
|
NTRI = NLNKF
|
||
|
|
NNPF = NLNKF
|
||
|
|
MAXPT = 12
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Special check to paint the triangle formed by two adjacent nodes
|
||
|
|
C --equal to each other, the middle value, and CNTR0
|
||
|
|
|
||
|
|
IF ((NTRI .GT. 1) .AND. (CNTR0 .EQ. FM)) THEN
|
||
|
|
IFL = 0
|
||
|
|
FLAST = VARNP(LINKF1(NNPF))
|
||
|
|
DO 130 K = 1, NNPF
|
||
|
|
FTHIS = VARNP(LINKF1(K))
|
||
|
|
IF ((FLAST .EQ. FTHIS) .AND. (FTHIS .EQ. FM)) IFL = K
|
||
|
|
FLAST = FTHIS
|
||
|
|
130 CONTINUE
|
||
|
|
|
||
|
|
IF (IFL .GT. 0) THEN
|
||
|
|
|
||
|
|
XPTS(1) = XM
|
||
|
|
YPTS(1) = YM
|
||
|
|
N1 = LINKF1(IFL)
|
||
|
|
XPTS(2) = XN(N1)
|
||
|
|
YPTS(2) = YN(N1)
|
||
|
|
N = LINKF1(ICNVS(IFL-1))
|
||
|
|
XPTS(3) = XN(N)
|
||
|
|
YPTS(3) = YN(N)
|
||
|
|
CALL MPD2PG (3, XPTS, YPTS, 'S')
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL INILOG (NTRI, .FALSE., ISDONE)
|
||
|
|
|
||
|
|
NPTS = 0
|
||
|
|
DO 150 ISIDE = 1, NTRI
|
||
|
|
|
||
|
|
C --Check each side of the face, looking for a corner in the
|
||
|
|
C --contour area or a dividing line in the contour area
|
||
|
|
|
||
|
|
IF (ISDONE(ISIDE)) GOTO 150
|
||
|
|
|
||
|
|
IS = ISIDE
|
||
|
|
N = LINKF1(IS)
|
||
|
|
N1 = LINKF1(ICNVS(IS+1))
|
||
|
|
ISTART = IS
|
||
|
|
|
||
|
|
ISTATE = KDONE
|
||
|
|
IF (INTERC (VARNP(N), CNTR0, CNTR1)) THEN
|
||
|
|
ICNTR = -1
|
||
|
|
ISTATE = KCORNR
|
||
|
|
ELSE IF ((INTERP_BL (CNTR0, VARNP(N), VARNP(N1), PSI))
|
||
|
|
& .AND. (VARNP(N1) .GT. CNTR0)) THEN
|
||
|
|
ICNTR = 0
|
||
|
|
CNTR = CNTR0
|
||
|
|
ISTATE = KISIDE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
140 CONTINUE
|
||
|
|
IF ((ISTATE .GT. KDONE) .AND. (NPTS .LT. MAXPT)) THEN
|
||
|
|
|
||
|
|
IF (ISTATE .EQ. KCORNR) THEN
|
||
|
|
|
||
|
|
C --Corner is within the contour area, goto side-1
|
||
|
|
|
||
|
|
NPTS = NPTS + 1
|
||
|
|
XPTS(NPTS) = XN(N)
|
||
|
|
YPTS(NPTS) = YN(N)
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
IS = ICNVS(IS-1)
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
N = LINKF1(IS)
|
||
|
|
N1 = LINKF1(ICNVS(IS+1))
|
||
|
|
ISTATE = KFINDS
|
||
|
|
IF (IS .EQ. ISTART) ISTATE = KDONE
|
||
|
|
|
||
|
|
ELSE IF (ISTATE .EQ. KISIDE) THEN
|
||
|
|
|
||
|
|
C --Side crossing starts a contour area delimiter, find
|
||
|
|
C --direction and follow contour line
|
||
|
|
|
||
|
|
NPTS = NPTS + 1
|
||
|
|
XPTS(NPTS) = XN(N) * (1.-PSI) + XN(N1) * PSI
|
||
|
|
YPTS(NPTS) = YN(N) * (1.-PSI) + YN(N1) * PSI
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
|
||
|
|
C --Find the direction to follow this contour line through
|
||
|
|
C --the face center
|
||
|
|
|
||
|
|
ISTATE = KERR3
|
||
|
|
IF (INTERP_BL (CNTR, VARNP(N1), FM, PSI)) THEN
|
||
|
|
IDIR = +1
|
||
|
|
I = N1
|
||
|
|
ISTATE = KMIDDL
|
||
|
|
ELSE IF (INTERP_BL (CNTR, VARNP(N), FM, PSI)) THEN
|
||
|
|
IDIR = -1
|
||
|
|
I = N
|
||
|
|
ISTATE = KMIDDL
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (ISTATE .EQ. KMIDDL) THEN
|
||
|
|
|
||
|
|
C --Crossing through the middle, continue following line
|
||
|
|
C --to the side or through the middle
|
||
|
|
|
||
|
|
NPTS = NPTS + 1
|
||
|
|
XPTS(NPTS) = XN(I) * (1.-PSI) + XM * PSI
|
||
|
|
YPTS(NPTS) = YN(I) * (1.-PSI) + YM * PSI
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
IS = ICNVS(IS+IDIR)
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
N = LINKF1(IS)
|
||
|
|
N1 = LINKF1(ICNVS(IS+1))
|
||
|
|
|
||
|
|
ISTATE = KERR1
|
||
|
|
IF (IDIR .EQ. +1) THEN
|
||
|
|
I = N1
|
||
|
|
ELSE
|
||
|
|
I = N
|
||
|
|
END IF
|
||
|
|
IF (INTERP_BL (CNTR, VARNP(N), VARNP(N1), PSI)) THEN
|
||
|
|
ISTATE = KOSIDE
|
||
|
|
C --If the corner is exactly on the contour range, check
|
||
|
|
C --if the line is moving away from the corner; if so, go
|
||
|
|
C --through the middle to prevent cycling on this corner
|
||
|
|
IF (INTERP_BL (CNTR, VARNP(I), FM, PSIX)) THEN
|
||
|
|
IF (((IDIR .EQ. +1) .AND. (VARNP(N) .EQ. CNTR))
|
||
|
|
& .OR.
|
||
|
|
& ((IDIR .EQ. -1) .AND. (VARNP(N1) .EQ. CNTR)))
|
||
|
|
& THEN
|
||
|
|
PSI = PSIX
|
||
|
|
ISTATE = KMIDDL
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
ELSE IF (INTERP_BL (CNTR, VARNP(I), FM, PSI)) THEN
|
||
|
|
ISTATE = KMIDDL
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (ISTATE .EQ. KOSIDE) THEN
|
||
|
|
|
||
|
|
C --Contour line is intersecting the side, ending the line;
|
||
|
|
C --search for enclosing corners/lines
|
||
|
|
|
||
|
|
NPTS = NPTS + 1
|
||
|
|
XPTS(NPTS) = XN(N) * (1.-PSI) + XN(N1) * PSI
|
||
|
|
YPTS(NPTS) = YN(N) * (1.-PSI) + YN(N1) * PSI
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
IF (VARNP(N) .EQ. CNTR) ISDONE(ICNVS(IS-1)) = .TRUE.
|
||
|
|
IF (VARNP(N1) .EQ. CNTR) ISDONE(ICNVS(IS+1)) = .TRUE.
|
||
|
|
|
||
|
|
ISTATE = KFINDS
|
||
|
|
IF (IS .EQ. ISTART) ISTATE = KDONE
|
||
|
|
IF (VARNP(N) .EQ. CNTR) THEN
|
||
|
|
IF ((IDIR .EQ. -1) .OR.
|
||
|
|
& ((ICNTR .EQ. 0) .AND. (IDIR .EQ. +1))) THEN
|
||
|
|
C --If the line exits at the corner, and enclosing area,
|
||
|
|
C --adjust side to be adjacent side
|
||
|
|
IS = ICNVS(IS-1)
|
||
|
|
ISDONE(IS) = .TRUE.
|
||
|
|
N = LINKF1(IS)
|
||
|
|
N1 = LINKF1(ICNVS(IS+1))
|
||
|
|
IF (IS .EQ. ISTART) ISTATE = KDONE
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (ISTATE .EQ. KFINDS) THEN
|
||
|
|
|
||
|
|
C --Search for corner or first side crossing; the side can be
|
||
|
|
C --a CNTR0 crossing if the last crossing was a corner or a
|
||
|
|
C --CNTR1 crossing; it can be a CNTR1 crossing if the last
|
||
|
|
C --crossing was a corner or a CNTR0 crossing
|
||
|
|
|
||
|
|
ISTATE = KERR2
|
||
|
|
IF (INTERC (VARNP(N), CNTR0, CNTR1) .OR.
|
||
|
|
& INTEQC (VARNP(N), VARNP(N1), CNTR0, CNTR1)) THEN
|
||
|
|
ICNTR = MIN (-1, ICNTR-1)
|
||
|
|
ISTATE = KCORNR
|
||
|
|
ELSE IF ((ICNTR .EQ. -2) .AND.
|
||
|
|
& INTERP_BL (CNTR0, VARNP(N), VARNP(N1), PSI)) THEN
|
||
|
|
ICNTR = 0
|
||
|
|
CNTR = CNTR0
|
||
|
|
ISTATE = KISIDE
|
||
|
|
ELSE IF ((ICNTR .NE. 1) .AND.
|
||
|
|
& INTERP_BL (CNTR1, VARNP(N), VARNP(N1), PSI)) THEN
|
||
|
|
ICNTR = 1
|
||
|
|
CNTR = CNTR1
|
||
|
|
ISTATE = KISIDE
|
||
|
|
ELSE IF ((ICNTR .NE. 0) .AND.
|
||
|
|
& INTERP_BL (CNTR0, VARNP(N), VARNP(N1), PSI)) THEN
|
||
|
|
ICNTR = 0
|
||
|
|
CNTR = CNTR0
|
||
|
|
ISTATE = KISIDE
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
GOTO 140
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (ISTATE .NE. KDONE) THEN
|
||
|
|
C --State will be <0 if error occurred, >0 if too many points
|
||
|
|
CALL PLTFLU
|
||
|
|
WRITE (*, 10000) ISTATE, IS, ICNTR, IDIR,
|
||
|
|
& (VARNP(LINKF1(I)), I=1,NLNKF), CNTR0, CNTR1
|
||
|
|
10000 FORMAT (' PAINT ERROR - please contact',
|
||
|
|
& ' SEACAS@sandia.gov with this information:',
|
||
|
|
& /, 3X, 3I3, SP, I3,
|
||
|
|
& 2X, SP, 4 (1X, E9.2), 2X, 2 (1X, E9.2), /)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Paint enclosed area
|
||
|
|
|
||
|
|
IF (NPTS .GT. 2) THEN
|
||
|
|
CALL MPD2PG (NPTS, XPTS, YPTS, 'S')
|
||
|
|
NPTS = 0
|
||
|
|
END IF
|
||
|
|
150 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|