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.
468 lines
16 KiB
468 lines
16 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 PMESH (NPNODE, NPELEM, MXNFLG, MXSFLG, NPNBC, NPSBC,
|
|
& MAXKXN, NNN, KKK, NNXK, NBCNOD, NBCSID, NNLIST, NVLIST, NODES,
|
|
& NSIDEN, NNFLG, NNPTR, NSFLG, NVPTR, NVLEN, XN, YN, NXK, MAT,
|
|
& MAPDXG, MAPGXD, WTNODE, WTSIDE, AXIS, AREACG, LABE, LABO, LABN,
|
|
& LABNB, LABSB, LABM, LABW, CENTK, ILOOK, XMIN, XMAX, YMIN, YMAX,
|
|
& XX1, XX2, YY1, YY2, TITLE, DEV1, EIGHT, NINE, VERSN, VAXVMS)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE PMESH = PLOTS ALL FLAGGED ELEMENTS IN THE MESH
|
|
|
|
C***********************************************************************
|
|
|
|
C VARIABLES USED:
|
|
C AREACG = .TRUE. IF AREA AND C.G. REPORT ARE TO BE CALCULATED AND
|
|
C PLOTTED
|
|
C LABE = .TRUE. IF ELEMENT NUMBERS ARE TO BE PLOTTED
|
|
C LABN = .TRUE. IF NODE NUMBERS ARE TO BE PLOTTED
|
|
C LABNB = .TRUE. IF NODE BOUNDARY NUMBERS ARE TO BE PLOTTED
|
|
C LABSB = .TRUE. IF SIDE BOUNDARY NUMBERS ARE TO BE PLOTTED
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION CENTK(2, NPELEM), ILOOK(NNXK*MAXKXN)
|
|
DIMENSION MAPGXD(NPNODE), MAPDXG(NPNODE)
|
|
DIMENSION XN(NPNODE), YN(NPNODE), NXK(NNXK, NPELEM), MAT(NPELEM)
|
|
DIMENSION NODES(NPNBC), NSIDEN(NPSBC)
|
|
DIMENSION WTNODE(NPNBC), WTSIDE(NPSBC)
|
|
DIMENSION NNFLG(MXNFLG), NNPTR(MXNFLG)
|
|
DIMENSION NSFLG(MXSFLG), NVPTR(MXSFLG), NVLEN(MXSFLG)
|
|
DIMENSION XDUM(2), YDUM(2)
|
|
|
|
LOGICAL LABE, LABN, LABNB, LABSB, LABO, ADD, AXIS, LABM, EIGHT
|
|
LOGICAL NINE, NEW, LABW, CPUIFC, AREACG
|
|
|
|
CHARACTER*72 DUMMY, TITLE
|
|
CHARACTER DEV1*3, CDUMMY*4, DATE*8, TIME*8, VERSN*9
|
|
|
|
C INITIALIZE THE PLOTTING SURFACE
|
|
|
|
CALL PLTBGN
|
|
CALL PLTSTV (2, 160.)
|
|
XDIMR = XMAX - XMIN
|
|
YDIMR = YMAX - YMIN
|
|
XDIMD = 1.
|
|
YDIMD = .75
|
|
CALL MPVIEW (0., XDIMD, 0., YDIMD)
|
|
XRAT = XDIMR/XDIMD
|
|
YRAT = YDIMR/YDIMD
|
|
IF (XRAT .LT. YRAT) THEN
|
|
XDIMR = XDIMD*YRAT
|
|
XX1 = (XMIN + XMAX - XDIMR)*.5
|
|
XX2 = (XMIN + XMAX + XDIMR)*.5
|
|
XDIMR = XX2 - XX1
|
|
YY1 = YMIN
|
|
YY2 = YMAX
|
|
ELSE
|
|
YDIMR = YDIMD*XRAT
|
|
YY1 = (YMIN + YMAX - YDIMR)*.5
|
|
YY2 = (YMIN + YMAX + YDIMR)*.5
|
|
YDIMR = YY2 - YY1
|
|
XX1 = XMIN
|
|
XX2 = XMAX
|
|
END IF
|
|
|
|
C SET UP SCALING EXTREMES FOR AXIS
|
|
|
|
IF (AXIS) THEN
|
|
XDUM(1) = XX1 - (XDIMR*.05)
|
|
XDUM(2) = XX2 + (XDIMR*.05)
|
|
YDUM(1) = YY1 - (YDIMR*.05)
|
|
YDUM(2) = YY2 + (YDIMR*.05)
|
|
SHRINK = .2
|
|
ELSE
|
|
SHRINK = .1
|
|
END IF
|
|
|
|
C SHRINK TO FIT A BORDER ON THE PLOT
|
|
|
|
XX1 = XX1 - (XDIMR*SHRINK)
|
|
XX2 = XX2 + (XDIMR*SHRINK)
|
|
YY1 = YY1 - (YDIMR*SHRINK)
|
|
YY2 = YY2 + (YDIMR*SHRINK)
|
|
CALL MPORT2 (XX1, XX2, YY1, YY2)
|
|
CALL PLTFRM (0)
|
|
|
|
C PLOT THE TITLE AND THE TRACE
|
|
|
|
CALL STRLNG (TITLE, LEN)
|
|
IF ((LEN .GT. 1) .OR. (TITLE(1:1) .NE. ' ')) THEN
|
|
CALL PLTXHL (TITLE(1:LEN), XLEN)
|
|
XBEGIN = AMAX1(0., (XDIMD*.5 - XLEN*.5))
|
|
CALL PLTXTH (XBEGIN, YDIMD*.95, TITLE(1:LEN))
|
|
CALL PLTXHN (X1, YBEG)
|
|
ELSE
|
|
YBEG = YDIMD*.95
|
|
END IF
|
|
DUMMY(1:10) = ' DRAWN BY '
|
|
DUMMY(11:19) = VERSN
|
|
DUMMY(20:21) = ' '
|
|
CALL EXDATE (DATE)
|
|
DUMMY(22:29) = DATE
|
|
DUMMY(30:31) = ' '
|
|
CALL EXTIME (TIME)
|
|
DUMMY(32:39) = TIME
|
|
CALL PLTXTH (0., 0., DUMMY(1:39))
|
|
|
|
C DRAW THE AXIS IF REQUIRED AND SET CLIPPING WITHIN THE AXIS
|
|
|
|
IF (AXIS) CALL SETAXS (XDUM, YDUM)
|
|
IF (CPUIFC(.TRUE.)) GO TO 340
|
|
|
|
C FLAG NODES TO BE PLOTTED
|
|
|
|
DO 100 I = 1, NNN
|
|
ILOOK(I) = 0
|
|
100 CONTINUE
|
|
|
|
DO 120 I = 1, KKK
|
|
IF (NXK(1, I) .GT. 0) THEN
|
|
DO 110 J = 1, NNXK
|
|
IF (NXK(J, I) .GT. 0) ILOOK(NXK(J, I)) = 1
|
|
110 CONTINUE
|
|
END IF
|
|
120 CONTINUE
|
|
|
|
C PLOT THE NUMBERS ASSOCIATED WITH NODES
|
|
|
|
IF ((LABN) .OR. (LABNB) .OR. (LABSB) .OR. (LABW)) THEN
|
|
DO 240 I = 1, NNN
|
|
IF (CPUIFC(.TRUE.)) GO TO 340
|
|
IF (ILOOK(I) .EQ. 1) THEN
|
|
ADD = .FALSE.
|
|
DUMMY = ' '
|
|
CALL MP2PT (1, XN(I), YN(I), X1, Y1, MASK)
|
|
IF (MOD(MASK, 2) .NE. 0) THEN
|
|
|
|
C PLOT THE NODE NUMBERS
|
|
|
|
IF (LABN) THEN
|
|
CALL PLTSTD (1, 3.)
|
|
CALL GETDUM (I, DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
CALL PLTXHE (X1, Y1)
|
|
ADD = .TRUE.
|
|
END IF
|
|
|
|
C PLOT THE NODAL BOUNDARY CONDITION FLAGS
|
|
|
|
IF (LABNB) THEN
|
|
CALL PLTSTD (1, 5.)
|
|
J1 = 1
|
|
K1 = 1
|
|
130 CONTINUE
|
|
DO 160 J = J1, NNLIST
|
|
IF (NODES(J) .EQ. I) THEN
|
|
DO 140 K = K1, NBCNOD
|
|
IF (((K .EQ. NBCNOD) .AND.
|
|
& (NNPTR(K) .LE. J)) .OR.
|
|
& ((NNPTR(K + 1) .GT. J) .AND.
|
|
& (NNPTR(K) .LE. J))) THEN
|
|
IF (ADD) THEN
|
|
CALL PLTXTH (X1, Y1, '/')
|
|
CALL PLTXHE (X1, Y1)
|
|
END IF
|
|
CALL GETDUM (NNFLG(K), DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
CALL PLTXHE (X1, Y1)
|
|
ADD = .TRUE.
|
|
IF (K .LT. NBCNOD) THEN
|
|
K1 = K + 1
|
|
J1 = NNPTR(K1)
|
|
GO TO 130
|
|
ELSE
|
|
GO TO 150
|
|
END IF
|
|
END IF
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
END IF
|
|
160 CONTINUE
|
|
END IF
|
|
|
|
C PLOT THE WEIGHTING FACTORS
|
|
|
|
IF (LABW) THEN
|
|
CALL PLTSTD (1, 5.)
|
|
DO 170 J = 1, NNLIST
|
|
IF (NODES(J) .EQ. I) THEN
|
|
IF (ADD) THEN
|
|
CALL PLTXTH (X1, Y1, '/')
|
|
CALL PLTXHE (X1, Y1)
|
|
END IF
|
|
CALL GTXDUM (WTNODE(J), DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
CALL PLTXHE (X1, Y1)
|
|
ADD = .TRUE.
|
|
END IF
|
|
170 CONTINUE
|
|
CALL PLTSTD (1, 7.)
|
|
DO 200 J = 1, NBCSID
|
|
DO 180 K = NVPTR(J), NVPTR(J) + NVLEN(J) - 1
|
|
IF (NSIDEN(K) .EQ. I) THEN
|
|
IF (ADD) THEN
|
|
CALL PLTXTH (X1, Y1, '/')
|
|
CALL PLTXHE (X1, Y1)
|
|
END IF
|
|
CALL GTXDUM (WTSIDE(K), DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
CALL PLTXHE (X1, Y1)
|
|
ADD = .TRUE.
|
|
GO TO 190
|
|
END IF
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
END IF
|
|
|
|
C PLOT THE SIDE BOUNDARY CONDITION FLAGS
|
|
|
|
IF (LABSB) THEN
|
|
J1 = 1
|
|
ADD = .FALSE.
|
|
NEW = .TRUE.
|
|
CALL PLTSTD (1, 7.)
|
|
K1 = 1
|
|
JE = 0
|
|
J1HOLD = 0
|
|
210 CONTINUE
|
|
DO 230 J = J1, NVLIST, 2
|
|
IF ((NSIDEN(J) .EQ. I) .AND.
|
|
& (ILOOK(NSIDEN(J + 1)) .GT. 0)) THEN
|
|
|
|
C SEE IF THIS USE OF THE NODE IS THE SAME SIDE AS BEFORE
|
|
|
|
IF ((ADD) .AND. (NSIDEN(J + 1) .NE. JE) .AND.
|
|
& (.NOT.NEW)) THEN
|
|
J1HOLD = J
|
|
ELSE
|
|
JE = NSIDEN(J + 1)
|
|
DO 220 K = K1, NBCSID
|
|
IF (((K .EQ. NBCSID) .AND.
|
|
& (NVPTR(K) .LE. J)) .OR.
|
|
& ((NVPTR(K + 1) .GT. J) .AND.
|
|
& (NVPTR(K) .LE. J))) THEN
|
|
NEW = .FALSE.
|
|
K1 = K
|
|
J1 = J + 2
|
|
IF (ADD) THEN
|
|
CALL PLTXTH (X1, Y1, '/')
|
|
CALL PLTXHE (X1, Y1)
|
|
ELSE
|
|
X2 = .5*(XN(NSIDEN(J)) +
|
|
& XN(NSIDEN(J + 1)))
|
|
Y2 = .5*(YN(NSIDEN(J)) +
|
|
& YN(NSIDEN(J + 1)))
|
|
CALL MP2PT (1, X2, Y2, X1, Y1,
|
|
& MASK)
|
|
ADD = .TRUE.
|
|
END IF
|
|
CALL GETDUM (NSFLG(K), DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
CALL PLTXHE (X1, Y1)
|
|
GO TO 210
|
|
END IF
|
|
220 CONTINUE
|
|
END IF
|
|
END IF
|
|
230 CONTINUE
|
|
|
|
C GO BACK AND PICK UP OTHER SIDES USING THIS NODE
|
|
|
|
IF (J1HOLD .GT. 0) THEN
|
|
J1 = J1HOLD
|
|
J1HOLD = 0
|
|
NEW = .TRUE.
|
|
ADD = .FALSE.
|
|
GO TO 210
|
|
END IF
|
|
END IF
|
|
|
|
END IF
|
|
END IF
|
|
240 CONTINUE
|
|
END IF
|
|
|
|
C PLOT THE ELEMENT NUMBERS IF NEEDED
|
|
|
|
IF ((LABE) .OR. (LABO) .OR. (LABM)) THEN
|
|
DO 250 IJK = 1, KKK
|
|
IF (CPUIFC(.TRUE.)) GO TO 340
|
|
I = MAPDXG(IJK)
|
|
IF (NXK(1, I) .GT. 0) THEN
|
|
CALL MP2PT (1, CENTK(1, I), CENTK(2, I), X1, Y1, MASK)
|
|
IF (MOD(MASK, 2) .NE. 0) THEN
|
|
IF (LABE) THEN
|
|
CALL PLTSTD (1, 2.)
|
|
CALL GETDUM (I, DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
ELSE IF (LABO) THEN
|
|
CALL PLTSTD (1, 2.)
|
|
CALL GETDUM (IJK, DUMMY, LEN)
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
END IF
|
|
IF (LABM) THEN
|
|
CALL PLTSTD (1, 1.)
|
|
CALL GETDUM (MAT(I), DUMMY, LEN)
|
|
IF ((LABE) .OR. (LABO)) THEN
|
|
CALL PLTXHE (X1, Y1)
|
|
CALL PLTXTH (X1, Y1, '/')
|
|
CALL PLTXHE (X1, Y1)
|
|
END IF
|
|
CALL PLTXTH (X1, Y1, DUMMY(1:LEN))
|
|
CALL PLTSTD (1, 2.)
|
|
END IF
|
|
END IF
|
|
END IF
|
|
250 CONTINUE
|
|
END IF
|
|
|
|
C PLOT THE ELEMENTS
|
|
|
|
DO 260 I = 1, MAXKXN*NNXK
|
|
ILOOK(I) = 0
|
|
260 CONTINUE
|
|
JCOLOR = -10000
|
|
AREA = 0.0
|
|
XCG = 0.0
|
|
YCG = 0.0
|
|
DO 320 IJK = 1, KKK
|
|
IF (CPUIFC(.TRUE.)) GO TO 340
|
|
I = MAPDXG(IJK)
|
|
IF (NXK(1, I) .GT. 0) THEN
|
|
COLOR = DBLE(MOD(MAT(I) + 1, 6) + 1)
|
|
CALL PLTSTD (1, COLOR)
|
|
IF (NXK(3, I) .EQ. 0) THEN
|
|
JEND = 1
|
|
ELSE IF (NXK(4, I) .EQ. 0) THEN
|
|
JEND = 2
|
|
ELSE IF ((EIGHT) .OR. (NINE)) THEN
|
|
JEND = 8
|
|
ELSE
|
|
JEND = 4
|
|
END IF
|
|
IF (AREACG) THEN
|
|
EAREA = 0.0
|
|
XBAR = 0.0
|
|
YBAR = 0.0
|
|
END IF
|
|
DO 310 J = 1, JEND
|
|
INUM1 = NXK(J, I)
|
|
K = J + 1
|
|
IF (((K .EQ. 9) .AND. (EIGHT .OR. NINE)) .OR.
|
|
& ((K .EQ. 5) .AND. (.NOT.EIGHT) .AND. (.NOT.NINE)))
|
|
& K = 1
|
|
INUM2 = NXK(K, I)
|
|
|
|
C CALCULATE AREA AND C.G. OF ELEMENT
|
|
|
|
IF (AREACG) THEN
|
|
XBAR = XBAR + XN(INUM1)
|
|
YBAR = YBAR + YN(INUM1)
|
|
EAREA = EAREA + 0.5 * (XN(INUM1) - XN(INUM2))
|
|
& * (YN(INUM1) + YN(INUM2))
|
|
END IF
|
|
|
|
IF (INUM2 .GT. INUM1) THEN
|
|
IHOLD = INUM1
|
|
INUM1 = INUM2
|
|
INUM2 = IHOLD
|
|
END IF
|
|
HOLD = ABS((XN(INUM1)*XN(INUM2))) + (INUM1*INUM2*.013927)
|
|
DO 270 IRED = 1, 100
|
|
IF (HOLD .GT. 1.E7) HOLD = HOLD*1.E-6
|
|
IF (HOLD .LT. 1.E7) GOTO 280
|
|
270 CONTINUE
|
|
280 CONTINUE
|
|
LOOKUP = INT((HOLD - INT(HOLD))*DBLE(MAXKXN*NNXK))
|
|
IF (LOOKUP .LE. 0) LOOKUP = 1
|
|
IHOLD = LOOKUP
|
|
290 CONTINUE
|
|
IF ((JEND .EQ. 1) .OR. (ILOOK(LOOKUP) .EQ. 0)) THEN
|
|
CALL MPD2VC (1, XN(INUM1), YN(INUM1), XN(INUM2),
|
|
& YN(INUM2))
|
|
LOOKUP = IHOLD
|
|
300 CONTINUE
|
|
IF (ILOOK(LOOKUP) .LE. 0) THEN
|
|
ILOOK(LOOKUP) = INUM1*10000 + INUM2
|
|
KLOOK = 0
|
|
ELSE
|
|
LOOKUP = LOOKUP + 1
|
|
GO TO 300
|
|
END IF
|
|
ELSE IF (ILOOK(LOOKUP) .EQ. (INUM1*10000 + INUM2)) THEN
|
|
KLOOK = 0
|
|
ILOOK(LOOKUP) = -1
|
|
ELSE
|
|
LOOKUP = LOOKUP + 1
|
|
IF (LOOKUP .GT. MAXKXN*NNXK) LOOKUP = 1
|
|
KLOOK = KLOOK + 1
|
|
IF (KLOOK .GT. MAXKXN*NNXK) THEN
|
|
CALL MESSAGE ('LOOKUP TABLE TOO FULL')
|
|
GO TO 330
|
|
END IF
|
|
GO TO 290
|
|
END IF
|
|
310 CONTINUE
|
|
|
|
IF (AREACG) THEN
|
|
AREA = AREA + EAREA
|
|
XCG = XCG + EAREA*XBAR/REAL(JEND)
|
|
YCG = YCG + EAREA*YBAR/REAL(JEND)
|
|
END IF
|
|
END IF
|
|
320 CONTINUE
|
|
IF (AREACG) THEN
|
|
XCG = XCG/AREA
|
|
YCG = YCG/AREA
|
|
END IF
|
|
330 CONTINUE
|
|
|
|
C CONCLUDE THE PLOT SESSION
|
|
|
|
340 CONTINUE
|
|
CALL PLTSTD (1, 7.)
|
|
|
|
C PLOT SYMBOL AT C.G. AND REPORT AREA AND C.G.
|
|
|
|
IF (AREACG) THEN
|
|
WRITE (DUMMY, 10040) 'AREA', AREA
|
|
CALL STRLNG (DUMMY, LEN)
|
|
CALL PLTXTH (0., YBEG, DUMMY(1:LEN))
|
|
WRITE (DUMMY, 10040) 'XBAR', XCG
|
|
CALL STRLNG (DUMMY, LEN)
|
|
CALL PLTXHN (X1, Y1)
|
|
SPACE = (YBEG - Y1) * 0.2
|
|
CALL PLTXTH (0., Y1 - SPACE, DUMMY(1:LEN))
|
|
WRITE (DUMMY, 10040) 'YBAR', YCG
|
|
CALL STRLNG (DUMMY, LEN)
|
|
CALL PLTXHN (X1, Y1)
|
|
CALL PLTXTH (0., Y1 - SPACE, DUMMY(1:LEN))
|
|
CALL MP2PT (1, XCG, YCG, X1, Y1, MASK)
|
|
IF (MOD(MASK, 2) .NE. 0) THEN
|
|
#if NeedsDoubleEscape
|
|
CDUMMY = '\\CCS'
|
|
#else
|
|
CDUMMY = '\CCS'
|
|
#endif
|
|
CALL PLTXTS (X1, Y1, CDUMMY)
|
|
#if NeedsDoubleEscape
|
|
CDUMMY = '\\CCI'
|
|
#else
|
|
CDUMMY = '\CCI'
|
|
#endif
|
|
CALL PLTXTS (X1, Y1, CDUMMY)
|
|
END IF
|
|
END IF
|
|
CALL PLTBEL
|
|
CALL PLTFLU
|
|
|
|
RETURN
|
|
|
|
10040 FORMAT (A, ': ', G11.4)
|
|
END
|
|
|