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