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