Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
 
 
 
 
 
 

177 lines
6.0 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
SUBROUTINE OVRMX2 (LSTEL, CORD, IX, NSEG, MINMAX, NIQSLV,
* NIQS, TEMP, LTNESS, NUMIN, NUMFAC, NUMON,
* NUMEL, LFACE, NUMNP)
INTEGER LSTEL(*), IX(4,*), NIQSLV(*), LTNESS(2,*)
INTEGER LFACE(4,*)
REAL MINMAX(4,*), CORD(NUMNP,*), TEMP(*)
CHARACTER*16 ENGNOT, ENG1
DIMENSION MAP(2,4), V(4), FCORD(2,2), DIST(4), SCORD(2)
LOGICAL INSIDE, ONFACE, INIT
PARAMETER (MAXFAC = 4)
include 'nu_io.blk'
DATA MAP /1, 2, 2, 3, 3, 4, 4, 1/
INIT = .FALSE.
NUMIN = 0
NUMON = 0
NUMFAC = 0
DO 10 I=1,NSEG
IEL = LSTEL(I)
MINMAX(1, I) = MIN( CORD(IX(1,IEL),1), CORD(IX(2,IEL),1),
* CORD(IX(3,IEL),1), CORD(IX(4,IEL),1))
MINMAX(2, I) = MAX( CORD(IX(1,IEL),1), CORD(IX(2,IEL),1),
* CORD(IX(3,IEL),1), CORD(IX(4,IEL),1))
MINMAX(3, I) = MIN( CORD(IX(1,IEL),2), CORD(IX(2,IEL),2),
* CORD(IX(3,IEL),2), CORD(IX(4,IEL),2))
MINMAX(4, I) = MAX( CORD(IX(1,IEL),2), CORD(IX(2,IEL),2),
* CORD(IX(3,IEL),2), CORD(IX(4,IEL),2))
10 CONTINUE
C ... DETERMINE WHICH FACES HAVE SSET FLAG
CALL INIINT (MAXFAC * NUMEL, 0, LFACE)
DO 30 ISEG = 1, NSEG
IEL = LSTEL(ISEG)
IFAC1 = LTNESS(1,ISEG)
IFAC2 = LTNESS(2,ISEG)
DO 20 IFAC = 1, MAXFAC
INOD1 = IX(MAP(1,IFAC),IEL)
INOD2 = IX(MAP(2,IFAC),IEL)
ITST1 = ISIGN(1,(INOD1-IFAC1)) + ISIGN(1,(IFAC1-INOD1)) +
* ISIGN(1,(INOD2-IFAC1)) + ISIGN(1,(IFAC1-INOD2))
ITST2 = ISIGN(1,(INOD1-IFAC2)) + ISIGN(1,(IFAC2-INOD1)) +
* ISIGN(1,(INOD2-IFAC2)) + ISIGN(1,(IFAC2-INOD2))
LFACE(IFAC,IEL) = LFACE(IFAC,IEL) + ITST1 * ITST2
20 CONTINUE
30 CONTINUE
C ... DETERMINE IF NODE IS CLOSE TO ELEMENT
C TEMP = 1.0 IF INSIDE MIN/MAX BOX
DO 130 I=1, NSEG
IEL = LSTEL(I)
DO 40 ISLV = 1, NIQS
ISN = NIQSLV(ISLV)
TEMP(ISLV) =
* (0.5 + SIGN( 0.5, CORD (ISN,1) - MINMAX(1,I) )) *
* (0.5 + SIGN( 0.5, -CORD (ISN,1) + MINMAX(2,I) )) *
* (0.5 + SIGN( 0.5, CORD (ISN,2) - MINMAX(3,I) )) *
* (0.5 + SIGN( 0.5, -CORD (ISN,2) + MINMAX(4,I) ))
40 CONTINUE
C ... DETERMINE IF ANY INSIDE BOX ( TEMP = 1.0 )
C ... FOR EACH NODE INSIDE BOX, DETERMINE IF ACTUALLY INSIDE ELEMENT
DO 120 ISLV = 1, NIQS
IF (TEMP(ISLV) .EQ. 1.0) THEN
INOD = NIQSLV(ISLV)
X3 = CORD(INOD,1)
Y3 = CORD(INOD,2)
INSIDE = .TRUE.
ONFACE = .FALSE.
DO 50 IPYR = 1, 4
X1 = CORD(IX(MAP(1,IPYR),IEL),1)
Y1 = CORD(IX(MAP(1,IPYR),IEL),2)
X2 = CORD(IX(MAP(2,IPYR),IEL),1)
Y2 = CORD(IX(MAP(2,IPYR),IEL),2)
C ... CALCULATE TRIANGLE AREAS (SHOULD BE DIVIDED BY 2 FOR AREA)
V(IPYR) = X1 * (Y2 - Y3) + X2 * (Y3 - Y1)
* + X3 * (Y1 - Y2)
IF (V(IPYR) .LT. 0.0) INSIDE = .FALSE.
IF (V(IPYR) .EQ. 0.0) ONFACE = .TRUE.
50 CONTINUE
C ... FLAG NODE AND ELEMENT IF INSIDE
IF (ONFACE .AND. INSIDE) THEN
INSIDE = .TRUE.
ONFACE = .FALSE.
DO 60 IFAC = 1, MAXFAC
IF (V(IFAC) .EQ. 0.0 .AND.
* LFACE(IFAC,IEL) .NE. 0 ) THEN
INSIDE = .FALSE.
ONFACE = .TRUE.
END IF
60 CONTINUE
END IF
C ... CHECK FOR NODE ON BOTH SURFACES
IF (INSIDE) THEN
DO 70 INOD = 1, 4
IF (IX(INOD,IEL) .EQ. NIQSLV(ISLV)) THEN
INSIDE = .FALSE.
NUMON = NUMON + 1
END IF
70 CONTINUE
END IF
IF (INSIDE) THEN
IF (.NOT. INIT) THEN
INIT = .TRUE.
DO 80 IO=IOMIN, IOMAX
WRITE (IO, 150)
80 CONTINUE
END IF
DO 90 IFAC = 1, MAXFAC
IF (LFACE(IFAC,IEL) .NE. 0 ) THEN
FCORD(1,1) = CORD(IX(MAP(1,IFAC),IEL),1)
FCORD(2,1) = CORD(IX(MAP(1,IFAC),IEL),2)
FCORD(1,2) = CORD(IX(MAP(2,IFAC),IEL),1)
FCORD(2,2) = CORD(IX(MAP(2,IFAC),IEL),2)
SCORD(1) = CORD(NIQSLV(ISLV),1)
SCORD(2) = CORD(NIQSLV(ISLV),2)
CALL PENDIS (SCORD, FCORD, DIST(IFAC), 2, 2)
END IF
90 CONTINUE
DO 100 IFAC = 1, MAXFAC
IF (LFACE(IFAC,IEL) .NE. 0 .AND.
* DIST(IFAC) .NE. 0.0) THEN
NUMIN = NUMIN + 1
ENG1 = ENGNOT(DIST(IFAC),2)
DO 110 IO=IOMIN, IOMAX
WRITE (IO,140) NIQSLV(ISLV), IEL,
* ENG1,
* IFAC, CORD(NIQSLV(ISLV),1),
$ CORD(NIQSLV(ISLV),2)
110 CONTINUE
END IF
100 CONTINUE
ELSE IF (ONFACE) THEN
NUMFAC = NUMFAC + 1
END IF
END IF
120 CONTINUE
130 CONTINUE
140 FORMAT (T3,I6,T11,I6,T18,A16,T37,I1,T43,2(F15.8,2X))
150 FORMAT (' Slave Master Penetration Element'/
* ' Node Element Distance Face Location')
RETURN
END