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.
 
 
 
 
 
 

92 lines
3.3 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 REGEXT (MP, ML, MS, MR, N, II, COOR, ILINE, LTYPE,
& LCON, NLPS, IFLINE, ILLIST, NSPR, IFSIDE, ISLIST, LINKP,
& LINKL, LINKS, LINKR, XMIN, XMAX, YMIN, YMAX)
C***********************************************************************
C SUBROUTINE REGEXT = GETS THE REGION EXTREMES
C***********************************************************************
DIMENSION COOR (2, MP)
DIMENSION ILINE (ML), LTYPE (ML), LCON (3, ML)
DIMENSION NLPS (MS), IFLINE (MS), ILLIST (MS * 3)
DIMENSION NSPR (MR), IFSIDE (MR), ISLIST (MR * 4)
DIMENSION LINKP (2, MP), LINKL (2, ML), LINKS (2, MS)
DIMENSION LINKR (2, MR)
DIMENSION N (29)
LOGICAL FOUND, GETMAX, ADDLNK
LOGICAL NUMPLT, TEST
ADDLNK = .FALSE.
GETMAX = .TRUE.
FOUND = .FALSE.
DO 110 J = IFSIDE (II), IFSIDE (II) + NSPR (II) - 1
C GET SIDE EXTREMES
IF ( ISLIST(J) .GT. 0) THEN
CALL LTSORT (MS, LINKS, ISLIST (J), IPNTR, ADDLNK)
IF (IPNTR .GT. 0) THEN
DO 100 K = IFLINE (IPNTR), IFLINE (IPNTR) +
& NLPS (IPNTR) - 1
CALL LTSORT (ML, LINKL, ILLIST (K), KK, ADDLNK)
IF (KK .GT. 0) THEN
IF (.NOT.FOUND) THEN
CALL LTSORT (MP, LINKP, IABS (LCON (1, KK)),
& IPNT, ADDLNK)
IF (IPNT .GT. 0) THEN
XMAX = COOR (1, IPNT)
XMIN = COOR (1, IPNT)
YMAX = COOR (2, IPNT)
YMIN = COOR (2, IPNT)
FOUND = .TRUE.
ENDIF
ENDIF
IF (FOUND) THEN
CALL DLINE (MP, ML, COOR, LINKP, ILINE (KK),
& LTYPE (KK), LCON (1, KK), LCON (2, KK),
& LCON (3, KK), NUMPLT, X1, Y1, TEST, GETMAX,
& XMIN, XMAX, YMIN, YMAX)
ENDIF
ENDIF
100 CONTINUE
END IF
C GET LINE EXTREMES
ELSEIF (ISLIST (J) .LT. 0) THEN
JJ = IABS (ISLIST (J))
CALL LTSORT (ML, LINKL, JJ, KK, ADDLNK)
IF (KK .GT. 0) THEN
IF (.NOT.FOUND) THEN
CALL LTSORT (MP, LINKP, IABS (LCON (1, KK)), IPNT,
& ADDLNK)
IF (IPNT .GT. 0) THEN
XMAX = COOR (1, IPNT)
XMIN = COOR (1, IPNT)
YMAX = COOR (2, IPNT)
YMIN = COOR (2, IPNT)
FOUND = .TRUE.
ENDIF
ENDIF
IF (FOUND) THEN
CALL DLINE (MP, ML, COOR, LINKP, ILINE (KK),
& LTYPE (KK), LCON (1, KK), LCON (2, KK),
& LCON (3, KK), NUMPLT, X1, Y1, TEST, GETMAX, XMIN,
& XMAX, YMIN, YMAX)
ENDIF
ENDIF
ENDIF
110 CONTINUE
RETURN
END