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
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
|