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.

131 lines
5.3 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
SUBROUTINE CHKHOL (IA, L, MP, ML, MS, MR, MSC, IPOINT, COOR,
& IPBOUN, ILINE, LTYPE, NINT, FACTOR, LCON, ILBOUN, ISBOUN,
& ISIDE, NLPS, IFLINE, ILLIST, IREGN, NSPR, IFSIDE, ISLIST,
& NPPF, IFPB, LISTPB, NLPF, IFLB, LISTLB, NSPF, IFSB, LISTSB,
& IFHOLE, NHPR, IHLIST, LINKP, LINKL, LINKS, LINKR, LINKSC,
& LINKPB, LINKLB, LINKSB, RSIZE, NPREGN, NPSBC, NPNODE, MAXNP,
& MAXNL, MXNPER, MXRNBC, MXRSBC, X, Y, NID, LISTL, MARKED, MXNL,
& MAXNBC, MAXSBC, AMESUR, XNOLD, YNOLD, NXKOLD, MMPOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPROLD, NPNOLD, NPEOLD, NNXK, REMESH,
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN,
& NOROOM, ERRCHK, ERR)
C***********************************************************************
C CHKRGN - CHECK THAT A REGION MAY BE MESHED
C***********************************************************************
DIMENSION IA(1)
DIMENSION IPOINT(MP), COOR(2, MP), IPBOUN(MP)
DIMENSION ILINE(ML), LTYPE(ML), NINT(ML), FACTOR(ML), LCON(3, ML)
DIMENSION ILBOUN(ML), ISBOUN(ML), ISIDE(MS), NLPS(MS)
DIMENSION IFLINE(MS), ILLIST(MS*3)
DIMENSION IREGN(MR), NSPR(MR), IFSIDE(MR), ISLIST(MR*4)
DIMENSION RSIZE (MR)
DIMENSION NPPF(MP), IFPB(MP), LISTPB(2, MP)
DIMENSION NLPF(ML), IFLB(ML), LISTLB(2, ML)
DIMENSION NSPF(ML), IFSB(ML), LISTSB(2, ML)
DIMENSION LINKP(2, MP), LINKL(2, ML), LINKS(2, MS)
DIMENSION LINKR(2, MR), LINKSC(2, MR), LINKPB(2, MP)
DIMENSION LINKLB(2, ML), LINKSB(2, ML)
DIMENSION X(MAXNP), Y(MAXNP), NID(MAXNP)
DIMENSION LISTL(MAXNL), MARKED(3, MAXNL)
DIMENSION IFHOLE(MR), NHPR(MR), IHLIST(MR*2)
DIMENSION IDUMMY(1)
DIMENSION AMESUR(NPEOLD), XNOLD(NPNOLD), YNOLD(NPNOLD)
DIMENSION NXKOLD(NNXK, NPEOLD), MMPOLD(3, NPROLD)
DIMENSION LINKEG(2, MLINK), LISTEG(4 * NPEOLD), BMESUR(NPNOLD)
LOGICAL NOROOM, EVEN, ERR, CCW, REAL, ADDLNK, REMESH
LOGICAL COUNT, ERRCHK
addlnk = .false.
COUNT = .TRUE.
EVEN = .FALSE.
REAL = .FALSE.
C CHECK TO MAKE SURE CONNECTING DATA FOR THE REGION EXISTS
C AND FILL IN ANY BLANK INTERVALS ACCORDING TO THE GIVEN SIZE
C FOR THE REGION AND THE LINE'S LENGTH
IF (NHPR(L) .GT. 0) THEN
DO 100 I = IFHOLE(L), IFHOLE(L) + NHPR(L) - 1
IPNTR1 = 0
CALL LTSORT (MR, LINKR, IHLIST(I), IPNTR1, ADDLNK)
IF (IPNTR1 .GT. 0) THEN
LL = IPNTR1
CALL DATAOK (MP, ML, MS, MR, LL, IREGN(LL), COOR, ILINE,
& LTYPE, NINT, LCON, NLPS, IFLINE, ILLIST, NSPR, IFSIDE,
& ISLIST, LINKP, LINKL, LINKS, RSIZE(LL), ERRCHK, ERR)
IF (ERR) THEN
WRITE (*, 10000) IREGN(LL)
ADDLNK = .TRUE.
IMINUS = -LL
CALL LTSORT (MR, LINKR, IREGN(LL), IMINUS, ADDLNK)
ADDLNK = .FALSE.
C CALCULATE THE PERIMETER OF THE REGION
ELSE
KNBC = 0
KSBC = 0
CALL PERIM (MP, ML, MS, NSPR(LL), MAXNL, MAXNP, 1, 1,
& KNBC, KSBC, IREGN(LL), IPOINT, COOR, IPBOUN, ILINE,
& LTYPE, NINT, FACTOR, LCON, ILBOUN, ISBOUN, ISIDE,
& NLPS, IFLINE, ILLIST, ISLIST(IFSIDE(LL)), NPPF,
& IFPB, LISTPB, NLPF, IFLB, LISTLB, NSPF, IFSB,
& LISTSB, LINKP, LINKL, LINKS, LINKPB, LINKLB,
& LINKSB, X, Y, NID, NPER, LISTL, NL, IDUMMY,
& MARKED, EVEN, REAL, ERR, CCW, COUNT, NOROOM,
& AMESUR, XNOLD, YNOLD, NXKOLD, MMPOLD, LINKEG,
& LISTEG, BMESUR, MLINK, NPROLD, NPNOLD, NPEOLD,
& NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX,
& IDIVIS, SIZMIN, EMAX, EMIN)
IF ((NPER .LE. 0) .OR. (ERR)) THEN
WRITE (*, 10010) IREGN(LL)
ADDLNK = .TRUE.
IMINUS = -LL
CALL LTSORT (MR, LINKR, IREGN(LL), IMINUS, ADDLNK)
ADDLNK = .FALSE.
ELSE
C WHEN CHECKING THE MAXIMUMS - ADD ENOUGH FOR ONE MORE INTERVAL
C ON THE LINE AS THIS LINE MAY BE INCREMENTED BY ONE IF THE
C PERIMETER IS ODD
MAXNBC = MAX(MAXNBC, KNBC + 3 + MXRNBC)
MAXSBC = MAX(MAXSBC, KSBC + 3 + MXRSBC)
MXNL = MAX(MXNL, NL)
MXNPER = MAX(MXNPER, NPER + 2)
C MARK THE LINES AND POINTS IN THE REGION AS BEING USED
CALL MKUSED (MAXNL, MP, ML, LISTL, IPOINT, NINT,
& LINKP, LINKL, LCON, NL)
ENDIF
ENDIF
ELSE
WRITE (*, 10020) IREGN(LL)
ERR = .TRUE.
ENDIF
100 CONTINUE
END IF
RETURN
10000 FORMAT (' ** ERROR - DATA PROBLEMS FOR HOLE REGION:', I5, ' **')
10010 FORMAT (' ** ERROR - PERIMETER GENERATION ERRORS FOR HOLE REGION:'
& , I5, ' **')
10020 FORMAT (' ** ERROR - HOLE REGION', I5, ' DOES NOT EXIST **')
END