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.
361 lines
12 KiB
361 lines
12 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 PDATA (MP, ML, MR, MSC, IPOINT, COOR, IPBOUN, ILINE,
|
||
|
|
& LTYPE, NINT, LCON, FACTOR, ILBOUN, ISBOUN, IREGN, IMAT, LINKP,
|
||
|
|
& LINKL, LINKR, LINKSC, RSIZE, SCHEME, DEFSCH, DEFSIZ, REXTRM,
|
||
|
|
& N, LABP, LABL, LABR, FULL, LABMD, LABI, LABF, LABPB, LABLB,
|
||
|
|
& LABSBD, LABSC, LABSZ, AXISD, TITLE, XMIN, XMAX, YMIN, YMAX,
|
||
|
|
& XX1, YY1, XX2, YY2, DEV1, VERSN)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE PDATA = PLOTS FLAGGED POINTS, LINES, AND REGIONS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IPOINT (MP), COOR (2, MP), IPBOUN (MP)
|
||
|
|
DIMENSION ILINE (ML), LTYPE (ML), NINT (ML), LCON (3, ML)
|
||
|
|
DIMENSION FACTOR (ML)
|
||
|
|
DIMENSION ILBOUN (ML), ISBOUN (ML)
|
||
|
|
DIMENSION IREGN (MR), IMAT (MR), REXTRM (4, MR), RSIZE (MR)
|
||
|
|
DIMENSION SCHEME (MSC)
|
||
|
|
DIMENSION LINKP (2, MP), LINKL (2, ML), LINKR (2, MR)
|
||
|
|
DIMENSION LINKSC (2, MR)
|
||
|
|
DIMENSION N (29), XDUM (2), YDUM (2)
|
||
|
|
|
||
|
|
CHARACTER*72 DUMMY, SCHEME, DEFSCH, TITLE, DEV1*3
|
||
|
|
CHARACTER*8 DATE, TIME, VERSN*10
|
||
|
|
|
||
|
|
LOGICAL LABP, LABL, LABR, AXISD, LABMD, LABI, LABF
|
||
|
|
LOGICAL LABPB, LABLB, LABSBD
|
||
|
|
LOGICAL ADDLNK, CPUIFC, TEST, FULL, LABSC
|
||
|
|
LOGICAL GETMAX, ADD, LABSZ
|
||
|
|
|
||
|
|
C INITIALIZE THE PLOTTING SURFACE
|
||
|
|
|
||
|
|
TEST = .FALSE.
|
||
|
|
GETMAX = .FALSE.
|
||
|
|
IF (TEST)OPEN (UNIT = 12, FILE = 'HP7580.DAT', STATUS = 'NEW')
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
CALL PLTBGN
|
||
|
|
CALL PLTSTV (2, 160.)
|
||
|
|
XDIMR = ABS (XMAX - XMIN)
|
||
|
|
YDIMR = ABS (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
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C SET UP SCALING EXTREMES FOR AXIS
|
||
|
|
|
||
|
|
IF (TEST) THEN
|
||
|
|
WRITE (12, 10000)'IN;SP6;;IP - 5710, -10060, 15710, 10060;'
|
||
|
|
WRITE (12, 10010)
|
||
|
|
& 'SC', INT (XX1*1000), ', ', INT (YY1*1000), ', ',
|
||
|
|
& INT (XX2*1000), ', ', INT (YY2*1000), ';'
|
||
|
|
ENDIF
|
||
|
|
IF (AXISD) 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
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
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))
|
||
|
|
ENDIF
|
||
|
|
DUMMY(1:10) = ' DRAWN BY '
|
||
|
|
DUMMY(11:20) = VERSN
|
||
|
|
DUMMY(21:22) = ' '
|
||
|
|
CALL EXDATE (DATE)
|
||
|
|
DUMMY(23:30) = DATE
|
||
|
|
DUMMY(31:32) = ' '
|
||
|
|
CALL EXTIME (TIME)
|
||
|
|
DUMMY(33:40) = TIME
|
||
|
|
CALL PLTXTH (0., 0., DUMMY(1:40))
|
||
|
|
|
||
|
|
C DRAW THE AXIS IF REQUIRED, AND SET CLIPPING WITHIN AXIS
|
||
|
|
|
||
|
|
IF (AXISD)CALL SETAXS (XDUM, YDUM)
|
||
|
|
IF (CPUIFC (.TRUE.))GOTO 130
|
||
|
|
|
||
|
|
C PLOT THE POINTS FLAGGED
|
||
|
|
|
||
|
|
IF ( (LABP) .OR. (LABPB)) THEN
|
||
|
|
DO 100 I = 1, N (18)
|
||
|
|
IF (CPUIFC (.TRUE.))GOTO 130
|
||
|
|
CALL LTSORT (MP, LINKP, I, II, ADDLNK)
|
||
|
|
IF (II.GT.0) THEN
|
||
|
|
IF (IPOINT (II).LT.0) THEN
|
||
|
|
INUM = - IPOINT (II)
|
||
|
|
CALL MP2PT (1, COOR (1, II), COOR (2, II),
|
||
|
|
& X1, Y1, MASK)
|
||
|
|
IF (MOD (MASK, 2).NE.0) THEN
|
||
|
|
|
||
|
|
C PLOT THE POINT LABELS
|
||
|
|
|
||
|
|
IF (LABP) THEN
|
||
|
|
CALL PLTSTD (1, 1.)
|
||
|
|
CALL GETDUM (INUM, DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT THE POINBC FLAGS
|
||
|
|
|
||
|
|
IF ( ( (LABPB) .OR. ( (FULL) .AND. (LABP))) .AND.
|
||
|
|
& (IPBOUN (II).GT.0)) THEN
|
||
|
|
CALL PLTSTD (1, 5.)
|
||
|
|
IF (LABP) THEN
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
CALL GETDUM (IPBOUN (II), DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
100 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT ALL LINES THAT HAVE BEEN FLAGGED
|
||
|
|
|
||
|
|
DO 110 I = 1, N (19)
|
||
|
|
IF (CPUIFC (.TRUE.))GOTO 130
|
||
|
|
CALL LTSORT (ML, LINKL, I, II, ADDLNK)
|
||
|
|
IF (II.GT.0) THEN
|
||
|
|
IF (LABL) THEN
|
||
|
|
ADD = .TRUE.
|
||
|
|
ELSE
|
||
|
|
ADD = .FALSE.
|
||
|
|
ENDIF
|
||
|
|
CALL PLTSTD (1, 7.)
|
||
|
|
IF (ILINE (II).LT.0) THEN
|
||
|
|
IF ( (LABL) .OR. (LABLB) .OR. (LABSBD) .OR. (LABF)
|
||
|
|
& .OR. (LABI)) THEN
|
||
|
|
KNUM = - ILINE (II)
|
||
|
|
ELSE
|
||
|
|
KNUM = 0
|
||
|
|
ENDIF
|
||
|
|
LT = LTYPE (II)
|
||
|
|
IP1 = LCON (1, II)
|
||
|
|
IP2 = LCON (2, II)
|
||
|
|
IP3 = LCON (3, II)
|
||
|
|
CALL LTSORT (MP, LINKP, IP1, IPNTR1, ADDLNK)
|
||
|
|
CALL LTSORT (MP, LINKP, IP2, IPNTR2, ADDLNK)
|
||
|
|
IF (IP3.NE.0) THEN
|
||
|
|
CALL LTSORT (MP, LINKP, IABS (IP3), IPNTR3, ADDLNK)
|
||
|
|
ELSE
|
||
|
|
IPNTR3 = 0
|
||
|
|
ENDIF
|
||
|
|
IF ((IPNTR1.GT.0) .AND. (IPNTR2.GT.0) .AND.
|
||
|
|
& ((LT.EQ.1) .OR. (IPNTR3.GT.0)) ) THEN
|
||
|
|
CALL DLINE (MP, ML, COOR, LINKP, KNUM, LT, IP1, IP2,
|
||
|
|
& IP3, LABL, X1, Y1, TEST, GETMAX, DUM1, DUM2, DUM3,
|
||
|
|
& DUM4)
|
||
|
|
|
||
|
|
C PLOT INTERVAL NUMBERS
|
||
|
|
|
||
|
|
IF ( ( (FULL) .AND. (LABL)) .OR. (LABI)) THEN
|
||
|
|
CALL PLTSTD (1, 5.)
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
CALL GETDUM (NINT (II), DUMMY, LEN)
|
||
|
|
IF (TEST) THEN
|
||
|
|
CALL PLTD2G (X1, Y1, XR, YR)
|
||
|
|
CALL PLTG2D (X1, Y1, XR, YR)
|
||
|
|
WRITE (12, 10020)'PU;PA', INT (XR*1000.),
|
||
|
|
& ', ', INT (YR*1000.), ';LB',
|
||
|
|
& DUMMY (1:LEN), CHAR (3)
|
||
|
|
ENDIF
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ADD = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT THE LINE FACTOR
|
||
|
|
|
||
|
|
IF ( ( (FULL) .AND. (LABL)) .OR. (LABF)) THEN
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTSTD (1, 1.)
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
CALL GTXDUM (FACTOR (II), DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ADD = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT THE LINEBC FLAGS
|
||
|
|
|
||
|
|
IF ( ( ( (FULL) .AND. (LABL)) .OR. (LABLB)) .AND.
|
||
|
|
& (ILBOUN (II).GT.0)) THEN
|
||
|
|
CALL PLTSTD (1, 2.)
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
CALL GETDUM (ILBOUN (II), DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ADD = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT THE SIDEBC FLAGS
|
||
|
|
|
||
|
|
IF ( ( ( (FULL) .AND. (LABL)) .OR. (LABSBD)) .AND.
|
||
|
|
& (ISBOUN (II).GT.0)) THEN
|
||
|
|
CALL PLTSTD (1, 3.)
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
CALL GETDUM (ISBOUN (II), DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
C PLOT ALL REGIONS FLAGGED
|
||
|
|
|
||
|
|
IF ( (LABR) .OR. (LABMD) .OR. (LABSC) .OR. (LABSZ)) THEN
|
||
|
|
IF (CPUIFC (.TRUE.))GOTO 130
|
||
|
|
DO 120 I = 1, N (22)
|
||
|
|
CALL LTSORT (MR, LINKR, I, II, ADDLNK)
|
||
|
|
IF (II.GT.0) THEN
|
||
|
|
IF (IREGN (II).LT.0) THEN
|
||
|
|
ADD = .FALSE.
|
||
|
|
INUM = - IREGN (II)
|
||
|
|
XMID = (REXTRM (1, II) + REXTRM (2, II))/2.
|
||
|
|
YMID = (REXTRM (3, II) + REXTRM (4, II))/2.
|
||
|
|
CALL MP2PT (1, XMID, YMID, X1, Y1, MASK)
|
||
|
|
IF ( (MOD (MASK, 2).NE.0)) THEN
|
||
|
|
|
||
|
|
C PLOT THE REGION NUMBER
|
||
|
|
|
||
|
|
IF (LABR) THEN
|
||
|
|
CALL PLTSTD (1, 2.)
|
||
|
|
CALL GETDUM (INUM, DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ADD = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT OUT THE MATERIAL NUMBER
|
||
|
|
|
||
|
|
IF (((FULL) .AND. (LABR)) .OR. (LABMD)) THEN
|
||
|
|
CALL PLTSTD (1, 1.)
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
ADD = .TRUE.
|
||
|
|
CALL GETDUM (IMAT (II), DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT OUT THE SIZE NUMBER FOR THE REGION
|
||
|
|
|
||
|
|
IF (((FULL) .AND. (LABR)) .OR. (LABSZ)) THEN
|
||
|
|
CALL PLTSTD (1, 1.)
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
ADD = .TRUE.
|
||
|
|
CALL GTXDUM (RSIZE (II), DUMMY, LEN)
|
||
|
|
CALL PLTXTH (X1, Y1, DUMMY (1:LEN))
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C PLOT OUT THE SCHEME
|
||
|
|
|
||
|
|
IF (((FULL) .AND. (LABR)) .OR. (LABSC)) THEN
|
||
|
|
CALL PLTSTD (1, 7.)
|
||
|
|
IF (ADD) THEN
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
CALL PLTXTH (X1, Y1, '/')
|
||
|
|
CALL PLTXHE (X1, Y1)
|
||
|
|
ENDIF
|
||
|
|
CALL LTSORT (MR, LINKSC, INUM, IPNTR, ADDLNK)
|
||
|
|
IF ( (INUM.LE.N (24)) .AND. (IPNTR.GT.0)) THEN
|
||
|
|
CALL STRLNG (SCHEME (IPNTR), LEN)
|
||
|
|
IF (TEST) THEN
|
||
|
|
CALL PLTD2G (X1, Y1, XR, YR)
|
||
|
|
WRITE (12, 10020)'PU;PA', INT (XR*1000.),
|
||
|
|
& ', ', INT (YR*1000.), ';LB',
|
||
|
|
& SCHEME (IPNTR) (1:LEN), CHAR (3)
|
||
|
|
ENDIF
|
||
|
|
CALL PLTXTH (X1, Y1, SCHEME (IPNTR) (1:LEN))
|
||
|
|
ELSE
|
||
|
|
CALL STRLNG (DEFSCH, LEN)
|
||
|
|
IF (TEST) THEN
|
||
|
|
CALL PLTD2G (X1, Y1, XR, YR)
|
||
|
|
WRITE (12, 10020)'PU;PA', INT (XR*1000.),
|
||
|
|
& ', ', INT (YR*1000.), ';LB',
|
||
|
|
& DEFSCH (1:LEN), CHAR (3)
|
||
|
|
ENDIF
|
||
|
|
CALL PLTXTH (X1, Y1, DEFSCH (1:LEN))
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
120 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
130 CONTINUE
|
||
|
|
CALL PLTSTD (1, 7.)
|
||
|
|
CALL PLTBEL
|
||
|
|
CALL PLTFLU
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (A)
|
||
|
|
10010 FORMAT (A2, I10, A1, I10, A1, I10, A1, I10, A1)
|
||
|
|
10020 FORMAT (A5, I10, A1, I10, A3, A, A1)
|
||
|
|
|
||
|
|
END
|