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.
183 lines
7.1 KiB
183 lines
7.1 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 PMSCHM (NPER, NPRM, MXND, MLN, MP, ML, MS, MR, NL,
|
|
& MAXNL, MAXNP, MAXPRM, MAXNB, MAXNBC, MAXSBC, KNBC, KSBC, KNUM,
|
|
& IPOINT, COOR, IPBOUN, ILINE, LTYPE, NINT, FACTOR, LCON, ILBOUN,
|
|
& ISBOUN, ISIDE, NLPS, IFLINE, ILLIST, ISLIST, IREGN, NPPF, IFPB,
|
|
& LISTPB, NLPF, IFLB, LISTLB, NSPF, IFSB, LISTSB, LINKP, LINKL,
|
|
& LINKS, LINKR, LINKPB, LINKLB, LINKSB, NSPR, IFSIDE, RSIZE,
|
|
& IFHOLE, NHPR, IHLIST, X, Y, NID, LISTL, XN, YN, ZN, NUID, LXK,
|
|
& KXL, NXL, LXN, LSTNBC, NPERIM, ANGLE, BNSIZE, LNODES, LINKPR,
|
|
& MARKED, IPTPER, NUMPER, LPERIM, KKK, NNN, LLL, IAVAIL, NAVAIL,
|
|
& DEV1, KREG, IPNTRG, BATCH, NOROOM, ERR, AMESUR, XNOLD, YNOLD,
|
|
& NXKOLD, MMPOLD, LINKEG, LISTEG, BMESUR, MLINK, NPROLD, NPNOLD,
|
|
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS,
|
|
& SIZMIN, EMAX, EMIN)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE FMSCHM = GENERATES AN INITIAL PAVED MESH
|
|
|
|
C***********************************************************************
|
|
|
|
C VARIABLES USED:
|
|
C X = X VALUES AROUND THE PERIMETER
|
|
C Y = Y VALUES AROUND THE PERIMETER
|
|
C NID = PERIMETER NODE UNIQUE ID'S
|
|
C NPER = NUMBER OF PERIMETER NODES
|
|
C ERR = .TRUE. IF ERRORS WERE ENCOUNTERED
|
|
C XN = GLOBAL X VALUES OF NODES
|
|
C YN = GLOBAL Y VALUES OF NODES
|
|
C NUID = GLOBAL NODE UNIQUE IDENTIFIERS
|
|
C LXK = LINES PER ELEMENT
|
|
C KXL = ELEMENTS PER LINE
|
|
C NXL = NODES PER LINE
|
|
C LXN = LINES PER NODE
|
|
C NOTE:
|
|
C FOR *XN TABLES A NEGATIVE FLAG IN THE FOURTH COLUMN MEANS
|
|
C GO TO THAT ROW FOR A CONTINUATION OF THE LIST. IN THAT ROW
|
|
C THE FIRST ELEMENT WILL BE NEGATED TO INDICATE THAT THIS IS
|
|
C A CONTINUATION ROW.
|
|
C A NEGATIVE FLAG IN THE SECOND COLUMN OF THE LXN ARRAY MEANS
|
|
C THAT THIS NODE IS AN EXTERIOR BOUNDARY NODE.
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION ANGLE (MXND), BNSIZE (2, MXND), LNODES (MLN, MXND)
|
|
DIMENSION LINKPR (3, MAXPRM)
|
|
DIMENSION IPTPER (MAXPRM), NUMPER (MAXPRM), LPERIM(MAXNB)
|
|
|
|
DIMENSION IPOINT(MP), COOR(2, MP), IPBOUN(MP)
|
|
DIMENSION ILINE(ML), NINT(ML), LTYPE(ML), FACTOR(ML), LCON(3, ML)
|
|
DIMENSION ILBOUN(ML), ISBOUN(ML), LINKR(2, MR)
|
|
DIMENSION ISIDE(MS), NLPS(MS), IFLINE(MS), ILLIST(MS*3)
|
|
DIMENSION IREGN(MR), NSPR(MR), IFSIDE(MR), ISLIST(MR*4)
|
|
DIMENSION RSIZE(MR), IFHOLE(MR), NHPR(MR), IHLIST(MR*2)
|
|
DIMENSION LINKP(2, MP), LINKL(2, ML), LINKS(2, MS)
|
|
DIMENSION LISTL(MAXNL), MARKED(3, MAXNL)
|
|
DIMENSION X(MAXNP), Y(MAXNP), NID(MAXNP, MAXPRM), NPERIM(MAXPRM)
|
|
DIMENSION LINKPB(2, MP), NPPF(MP), IFPB(MP), LISTPB(2, MP)
|
|
DIMENSION LINKLB(2, ML), NLPF(ML), IFLB(ML), LISTLB(2, ML)
|
|
DIMENSION LINKSB(2, ML), NSPF(ML), IFSB(ML), LISTSB(2, ML)
|
|
DIMENSION LSTNBC(MAXNBC)
|
|
DIMENSION XN(MXND), YN(MXND), ZN(MXND), NUID(MXND)
|
|
DIMENSION LXK(4, MXND), KXL(2, 3*MXND)
|
|
DIMENSION NXL(2, 3*MXND), LXN(4, MXND)
|
|
|
|
DIMENSION AMESUR(NPEOLD), XNOLD(NPNOLD), YNOLD(NPNOLD)
|
|
DIMENSION NXKOLD(NNXK, NPEOLD), MMPOLD(3, NPROLD)
|
|
DIMENSION LINKEG(2, MLINK), LISTEG(4 * NPEOLD), BMESUR(NPNOLD)
|
|
|
|
LOGICAL ERR, GRAPH, ERRCHK, NOROOM, VIDEO
|
|
LOGICAL ADDLNK, CCW, EVEN, LREAL, COUNT, SIZEIT, TIMER
|
|
LOGICAL BATCH, REMESH
|
|
|
|
CHARACTER*3 DEV1
|
|
|
|
ADDLNK = .FALSE.
|
|
ERR = .FALSE.
|
|
GRAPH = .FALSE.
|
|
TIMER = .FALSE.
|
|
SIZEIT = .FALSE.
|
|
ERRCHK = .TRUE.
|
|
DEFSIZ = RSIZE (IPNTRG)
|
|
|
|
VIDEO = .FALSE.
|
|
|
|
C PUT ALL THE NODES IN THE ORIGINAL PERIMETER INTO THE GLOBAL
|
|
C PERIMETER ARRAYS FOR THE PAVING ROUTINE
|
|
|
|
DO 100 I = 1, NPER
|
|
XN(I) = X(I)
|
|
YN(I) = Y(I)
|
|
NUID(I) = NID(I, 1)
|
|
LPERIM(I) = I
|
|
100 CONTINUE
|
|
IPTPER(1) = 1
|
|
NUMPER(1) = NPER
|
|
NBNODE = NPER
|
|
|
|
C NOW GENERATE ALL THE HOLE PERIMETERS
|
|
|
|
CCW = .TRUE.
|
|
COUNT = .TRUE.
|
|
EVEN = .TRUE.
|
|
LREAL = .TRUE.
|
|
CALL LTSORT (MR, LINKR, KREG, IPNTR, ADDLNK)
|
|
DO 120 IR = IFHOLE(IPNTR), IFHOLE(IPNTR) + NHPR (IPNTR) - 1
|
|
CALL LTSORT (MR, LINKR, IHLIST (IR), JPNTR, ADDLNK)
|
|
IF (JPNTR .GT. 0) THEN
|
|
NPRM = NPRM + 1
|
|
CALL DATAOK (MP, ML, MS, MR, JPNTR, IABS(IREGN(IR)), COOR,
|
|
& ILINE, LTYPE, NINT, LCON, NLPS, IFLINE, ILLIST, NSPR,
|
|
& IFSIDE, ISLIST, LINKP, LINKL, LINKS, RSIZE(JPNTR),
|
|
& ERRCHK, ERR)
|
|
IF (ERR) GOTO 130
|
|
NLP1 = NL + 1
|
|
|
|
CALL PERIM (MP, ML, MS, NSPR(JPNTR), MAXNL, MAXNP, MAXNBC,
|
|
& MAXSBC, KNBC, KSBC, KNUM, IPOINT, COOR, IPBOUN, ILINE,
|
|
& LTYPE, NINT, FACTOR, LCON, ILBOUN, ISBOUN, ISIDE, NLPS,
|
|
& IFLINE, ILLIST, ISLIST(IFSIDE(JPNTR)), NPPF, IFPB,
|
|
& LISTPB, NLPF, IFLB, LISTLB, NSPF, IFSB, LISTSB, LINKP,
|
|
& LINKL, LINKS, LINKPB, LINKLB, LINKSB, X, Y, NID(1, NPRM),
|
|
& NPERIM(NPRM), LISTL(NLP1), NL1, LSTNBC, MARKED, EVEN,
|
|
& LREAL, 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 (NOROOM .OR. ERR) GO TO 130
|
|
IF (NL1 .GE. 0 .AND. NL + NL1 .LE. MAXNL) THEN
|
|
NL = NL + NL1
|
|
ELSE
|
|
CALL MESSAGE('** PROBLEMS IN FMSCHM ADDING HOLE LINES '//
|
|
& 'TO REGION LINE LIST **')
|
|
ERR = .TRUE.
|
|
GO TO 130
|
|
END IF
|
|
|
|
C NOW LINK THIS HOLE'S PERIMETER NODES TOGETHER INTO THE GLOBAL
|
|
C PERIMETER LIST
|
|
|
|
CALL REVERS (X (2), NPERIM(NPRM) - 1)
|
|
CALL REVERS (Y (2), NPERIM(NPRM) - 1)
|
|
CALL IREVER (NID (2, NPRM), NPERIM(NPRM) - 1)
|
|
IPTPER (NPRM) = NBNODE + 1
|
|
NUMPER (NPRM) = NPERIM(NPRM)
|
|
NBNODE = NBNODE + NPERIM(NPRM)
|
|
|
|
DO 110 J = 1, NPERIM(NPRM)
|
|
NODE = J + IPTPER(NPRM) - 1
|
|
XN(NODE) = X(J)
|
|
YN(NODE) = Y(J)
|
|
ZN(NODE) = 0.
|
|
NUID(NODE) = NID(J, NPRM)
|
|
LPERIM(NODE) = NODE
|
|
110 CONTINUE
|
|
ENDIF
|
|
120 CONTINUE
|
|
|
|
C NOW MESH THE BOUNDARIES WITH PAVING
|
|
|
|
NNN = NBNODE
|
|
|
|
CALL PAVING (NBNODE, NPRM, MLN, IPTPER, NUMPER, LPERIM, XN, YN,
|
|
& ZN, LXK, NXL, NNN, LLL, KKK, MXND, ANGLE, BNSIZE, LNODES,
|
|
& LINKPR, NPERIM, LXK, KXL, NXL, LXN, NUID, IAVAIL, NAVAIL,
|
|
& GRAPH, TIMER, VIDEO, DEFSIZ, SIZEIT, DEV1, KREG, BATCH,
|
|
& NOROOM, ERR, AMESUR, XNOLD, YNOLD, NXKOLD, MMPOLD, LINKEG,
|
|
& LISTEG, BMESUR, MLINK, NPROLD, NPNOLD, NPEOLD, NNXK, REMESH,
|
|
& REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
|
|
ERR = .FALSE.
|
|
RETURN
|
|
|
|
C ERROR DURING GENERATION
|
|
|
|
130 CONTINUE
|
|
RETURN
|
|
|
|
END
|
|
|