lib
/
EXODUS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
4 Commits
1 Branch
0 Tags
19 MiB
 
 
 
 
 
 
Tag: Branch: Tree: 77bd7563eb
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '77bd7563eb'
${ noResults }
EXODUS/packages/seacas/libraries/plt/pltaxs.F

684 lines
18 KiB
Raw Blame History

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
C=======================================================================
SUBROUTINE PLTAXS(X,Y,XLENG,YLENG,TYPE,XMIN,XMAX,XSTART,NDEC,
* INTER,MININT,LABEL,UNITS,EXP)
REAL DEVCAP(23)
REAL DEFOUT(7)
COMMON /STATUS/DEVCAP,DEFOUT
REAL DEVP(5)
COMMON /DEVICE/DEVP
REAL COLP(3)
REAL PALETT(3,16)
COMMON /COLOR/COLP,PALETT
REAL TEXTP(40)
COMMON /TEXT/TEXTP
REAL VECTP(5)
REAL XCUR
REAL YCUR
COMMON /VECTRC/VECTP,XCUR,YCUR
INTEGER IDEX(200,2)
INTEGER NVECT(200,2)
REAL XSIZE(200,2)
REAL YSIZE(200,2)
REAL X0(2300,2)
REAL Y0(2300,2)
REAL X1(2300,2)
REAL Y1(2300,2)
COMMON /FONT/IDEX,NVECT,XSIZE,YSIZE,X0,Y0,X1,Y1
REAL GRAPHP(100)
COMMON /GRAPH/GRAPHP
COMMON /MAPPAR/MAPP(11)
REAL MAPP
COMMON /STORAG/MEMORY(1000)
LOGICAL CPUIFC
INTEGER EXP
REAL LENMAJ,LENMIN,MAJRAT,MINRAT,NUMRAT,NUMSIZ,LABSIZ,MINTIC,
* LABRAT,MAJTIC,LONNUM,LABSCA,INTER
CHARACTER*(*) LABEL,UNITS,TYPE
CHARACTER TTYPE*1,FORMA*32,LINE*15,TLABEL*132,EXPL*4,CINPUT*132,
* CNDEC*1
LOGICAL PLTNER
DATA MAJRAT/50./
DATA MINRAT/2./
DATA NUMRAT/50./
DATA LABRAT/40./
DATA FUDGE/.0025/
IF (INTER.EQ.0.) THEN
CALL PLTFLU
CALL SIORPT('PLTAXS',
* 'Interval between major ticks must be nonzero.',2)
RETURN
END IF
TTYPE = TYPE
CALL CHRUP(TTYPE,TTYPE)
CALL PLTSVT
CALL PLTSVD
CALL PLTSVV
CALL PLTSTT(3,0.)
CALL PLTSTT(4,0.)
CALL PLTSTV(1,1.)
CALL CHRIC(NDEC,CNDEC,L)
FORMA = '(f15.'//CNDEC//')'
2180 CONTINUE
IF (TTYPE.EQ.'X') THEN
LABSCA = (XLENG+YLENG)/2.
NUMSIZ = (LABSCA* (GRAPHP(44)/5.))/NUMRAT
LABSIZ = (LABSCA* (GRAPHP(45)/5.))/LABRAT
YOFF = Y - NUMSIZ*1.8
LENMAJ = XLENG/MAJRAT
LENMIN = LENMAJ/MINRAT
MAJTIC = XLENG/ ((XMAX-XMIN)/INTER)
IF (MININT.NE.0) THEN
MINTIC = MAJTIC/MININT
ELSE
MINTIC = 0.
END IF
XLOW = XSTART
IF (XSTART.NE.XMIN) THEN
XLOW = XSTART - INTER
END IF
FMJTIC = X - (XMIN-XLOW)*MAJTIC/INTER
XMAJ = FMJTIC
XNUM = XSTART
IF (PLTNER(FMJTIC,X) .AND. XSTART.NE.XMIN) THEN
XNUM = XSTART - INTER
END IF
CALL PLTSTD(1,GRAPHP(37))
CALL PLTSTV(2,GRAPHP(62))
CALL PLTVCT(1,X,Y,X+XLENG,Y)
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,X,Y+YLENG,X+XLENG,Y+YLENG)
END IF
IF (PLTNER(FMJTIC,X) .AND. NUMSIZ.GT.0.0) THEN
LINE = ' '
WRITE (LINE,FORMA,ERR=120) XNUM
120 DO 2210 J = 1,15
IF (LINE(J:J).NE.' ') THEN
GO TO 2220
END IF
2210 CONTINUE
2220 CONTINUE
ILAST = 15
IF (NDEC.EQ.0) THEN
ILAST = 14
END IF
CALL PLTSTT(2,NUMSIZ)
CALL PLTSTT(11,GRAPHP(64))
CALL PLTSTD(1,GRAPHP(76))
CALL PLTXSL(LINE(J:ILAST),TLEN)
CALL PLTXTS(X-TLEN/2.,YOFF,LINE(J:ILAST))
XNUM = XNUM + INTER
END IF
2230 CONTINUE
IF (CPUIFC(.FALSE.)) THEN
GO TO 2250
END IF
DO 2260 I = 1,MININT - 1
IF (CPUIFC(.FALSE.)) THEN
GO TO 2270
END IF
XNEW = XMAJ + DBLE(I)*MINTIC
IF (XNEW-FUDGE.LE.X) THEN
GO TO 2260
END IF
IF (XNEW.GT.X+XLENG-FUDGE) THEN
GO TO 2270
END IF
CALL PLTSTD(1,GRAPHP(77))
CALL PLTSTV(2,GRAPHP(67))
CALL PLTVCT(1,XNEW,Y,XNEW,Y+LENMIN)
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,XNEW,Y+YLENG,XNEW,Y+YLENG-LENMIN)
END IF
IF (GRAPHP(73).NE.0.) THEN
CALL PLTSTV(1,GRAPHP(73))
CALL PLTSTD(1,GRAPHP(74))
CALL PLTSTV(2,GRAPHP(69))
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,XNEW,Y+LENMIN,XNEW,Y+YLENG-LENMIN)
ELSE
CALL PLTVCT(1,XNEW,Y+LENMIN,XNEW,Y+YLENG)
END IF
CALL PLTSTV(1,1.)
END IF
2260 CONTINUE
2270 CONTINUE
XMAJ = XMAJ + MAJTIC
IF (XMAJ.GT.X+XLENG+FUDGE .AND. GRAPHP(32).EQ.0.) THEN
GO TO 2250
ELSE IF (XMAJ.GT.X+XLENG-FUDGE .AND. GRAPHP(32).EQ.1.) THEN
GO TO 2250
END IF
CALL PLTSTD(1,GRAPHP(77))
CALL PLTSTV(2,GRAPHP(67))
CALL PLTVCT(1,XMAJ,Y,XMAJ,Y+LENMAJ)
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,XMAJ,Y+YLENG,XMAJ,Y+YLENG-LENMAJ)
END IF
IF (GRAPHP(73).NE.0. .OR. GRAPHP(35).NE.0.) THEN
IF (GRAPHP(35).EQ.0.) THEN
CALL PLTSTV(1,GRAPHP(73))
ELSE
CALL PLTSTV(1,GRAPHP(35))
END IF
IF (GRAPHP(35).EQ.0.) THEN
CALL PLTSTD(1,GRAPHP(74))
ELSE
CALL PLTSTD(1,GRAPHP(36))
END IF
IF (GRAPHP(35).EQ.0.) THEN
CALL PLTSTV(2,GRAPHP(69))
ELSE
CALL PLTSTV(2,GRAPHP(68))
END IF
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,XMAJ,Y+LENMAJ,XMAJ,Y+YLENG-LENMAJ)
ELSE
CALL PLTVCT(1,XMAJ,Y+LENMAJ,XMAJ,Y+YLENG)
END IF
CALL PLTSTV(1,1.)
END IF
IF (NUMSIZ.GT.0.0) THEN
LINE = ' '
WRITE (LINE,FORMA,ERR=121) XNUM
121 DO 2280 J = 1,15
IF (LINE(J:J).NE.' ') THEN
GO TO 2290
END IF
2280 CONTINUE
2290 CONTINUE
ILAST = 15
IF (NDEC.EQ.0) THEN
ILAST = 14
END IF
CALL PLTSTT(2,NUMSIZ)
CALL PLTSTT(11,GRAPHP(64))
CALL PLTSTD(1,GRAPHP(76))
CALL PLTXSL(LINE(J:ILAST),TLEN)
CALL PLTXTS(XMAJ-TLEN/2.,YOFF,LINE(J:ILAST))
END IF
XNUM = XNUM + INTER
GO TO 2230
2250 CONTINUE
IF (PLTNER(XMAJ,X+XLENG) .AND. NUMSIZ.GT.0.0) THEN
LINE = ' '
WRITE (LINE,FORMA,ERR=122) XNUM
122 DO 2300 J = 1,15
IF (LINE(J:J).NE.' ') THEN
GO TO 2310
END IF
2300 CONTINUE
2310 CONTINUE
ILAST = 15
IF (NDEC.EQ.0) THEN
ILAST = 14
END IF
CALL PLTSTT(2,NUMSIZ)
CALL PLTSTT(11,GRAPHP(64))
CALL PLTSTD(1,GRAPHP(76))
CALL PLTXSL(LINE(J:ILAST),TLEN)
CALL PLTXTS(XMAJ-TLEN/2.,YOFF,LINE(J:ILAST))
END IF
IF ((XMIN.LT.0..AND.XMAX.GT.0.) .AND.
* (GRAPHP(35).EQ.0..AND.GRAPHP(73).EQ.0.) .AND.
* GRAPHP(71).NE.0.) THEN
CALL PLTSTV(1,GRAPHP(71))
CALL PLTSTD(1,GRAPHP(72))
CALL PLTSTV(2,GRAPHP(70))
X0LINE = X - (XMIN*XLENG)/ (XMAX-XMIN)
CALL PLTVCT(1,X0LINE,Y+LENMAJ,X0LINE,Y+YLENG-LENMAJ)
CALL PLTSTV(1,1.)
END IF
IF (LABSIZ.GT.0.0) THEN
TLABEL = ' '
LL = 0
IF (LABEL.NE.' ') THEN
TLABEL = LABEL
CALL CHRTRM(TLABEL,LL)
#if NeedsDoubleEscape
TLABEL(LL+1:LL+2) = '\\-'
#else
TLABEL(LL+1:LL+2) = '\-'
#endif
LL = LL + 2
END IF
IF (UNITS.NE.' ') THEN
TLABEL(LL+6:) = UNITS
CALL CHRTRM(TLABEL,LL)
#if NeedsDoubleEscape
TLABEL(LL+1:LL+2) = '\\-'
#else
TLABEL(LL+1:LL+2) = '\-'
#endif
LL = LL + 2
END IF
IF (EXP.NE.0. .AND. NUMSIZ.GT.0.) THEN
IF (LL.GT.0) THEN
LL = LL + 1
END IF
EXPL = ' '
WRITE (EXPL,'(i4)',ERR=110) EXP
110 DO 2320 I = 1,4
IF (EXPL(I:I).NE.' ') THEN
GO TO 2330
END IF
2320 CONTINUE
2330 CONTINUE
#if NeedsDoubleEscape
TLABEL(LL+1:) = '( *10\\^'//EXPL(I:)//'\\- )'
#else
TLABEL(LL+1:) = '( *10\^'//EXPL(I:)//'\- )'
#endif
END IF
CINPUT = TLABEL
CALL CHRSTR(CINPUT,TLABEL,LL)
IF (LL.GT.0) THEN
CALL PLTSTT(2,LABSIZ)
CALL PLTSTT(11,GRAPHP(65))
CALL PLTSTD(1,GRAPHP(39))
CALL PLTXSL(TLABEL(1:LL),TLEN)
XLAB = X + (XLENG-TLEN)/2.
YLAB = YOFF - LABSIZ*2.
CALL PLTXTS(XLAB,YLAB,TLABEL(1:LL))
END IF
IF (CPUIFC(.FALSE.)) THEN
GO TO 2200
END IF
END IF
ELSE IF (TTYPE.EQ.'Y') THEN
LABSCA = (XLENG+YLENG)/2.
NUMSIZ = (LABSCA* (GRAPHP(88)/5.))/NUMRAT
LABSIZ = (LABSCA* (GRAPHP(89)/5.))/LABRAT
LONNUM = 0.
XOFF = NUMSIZ*.8
YOFF = NUMSIZ/2.
LENMAJ = YLENG/MAJRAT
LENMIN = LENMAJ/MINRAT
MAJTIC = YLENG/ ((XMAX-XMIN)/INTER)
IF (MININT.NE.0) THEN
MINTIC = MAJTIC/MININT
ELSE
MINTIC = 0.
END IF
XLOW = XSTART
IF (XSTART.NE.XMIN) THEN
XLOW = XSTART - INTER
END IF
FMJTIC = Y - (XMIN-XLOW)*MAJTIC/INTER
YMAJ = FMJTIC
XNUM = XSTART
IF (PLTNER(FMJTIC,Y) .AND. XSTART.NE.XMIN) THEN
XNUM = XSTART - INTER
END IF
CALL PLTSTD(1,GRAPHP(37))
CALL PLTSTV(2,GRAPHP(62))
CALL PLTVCT(1,X,Y,X,Y+YLENG)
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,X+XLENG,Y,X+XLENG,Y+YLENG)
END IF
IF (PLTNER(FMJTIC,Y) .AND. NUMSIZ.GT.0.0) THEN
LINE = ' '
WRITE (LINE,FORMA,ERR=130) XNUM
130 DO 2340 J = 1,15
IF (LINE(J:J).NE.' ') THEN
GO TO 2350
END IF
2340 CONTINUE
2350 CONTINUE
ILAST = 15
IF (NDEC.EQ.0) THEN
ILAST = 14
END IF
CALL PLTSTT(2,NUMSIZ)
CALL PLTSTT(11,GRAPHP(64))
CALL PLTSTD(1,GRAPHP(76))
CALL PLTXSL(LINE(J:ILAST),TLEN)
IF (GRAPHP(92).EQ.1.) THEN
LONNUM = NUMSIZ
CALL PLTSTT(3,90.)
CALL PLTXTS(X-XOFF,Y-TLEN/2.,LINE(J:ILAST))
CALL PLTSTT(3,0.)
ELSE
CALL PLTXTS(X- (TLEN+XOFF),Y-NUMSIZ/2.,LINE(J:ILAST))
IF (TLEN.GT.LONNUM) THEN
LONNUM = TLEN
END IF
END IF
XNUM = XNUM + INTER
END IF
2360 CONTINUE
IF (CPUIFC(.FALSE.)) THEN
GO TO 2380
END IF
DO 2390 I = 1,MININT - 1
IF (CPUIFC(.FALSE.)) THEN
GO TO 2400
END IF
YNEW = YMAJ + DBLE(I)*MINTIC
IF (YNEW-FUDGE.LE.Y) THEN
GO TO 2390
END IF
IF (YNEW.GT.Y+YLENG-FUDGE) THEN
GO TO 2400
END IF
CALL PLTSTD(1,GRAPHP(77))
CALL PLTSTV(2,GRAPHP(67))
CALL PLTVCT(1,X,YNEW,X+LENMIN,YNEW)
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,X+XLENG,YNEW,X+XLENG-LENMIN,YNEW)
END IF
IF (GRAPHP(73).NE.0.) THEN
CALL PLTSTV(1,GRAPHP(73))
CALL PLTSTD(1,GRAPHP(74))
CALL PLTSTV(2,GRAPHP(69))
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,X+LENMIN,YNEW,X+XLENG-LENMIN,YNEW)
ELSE
CALL PLTVCT(1,X+LENMIN,YNEW,X+XLENG,YNEW)
END IF
CALL PLTSTV(1,1.)
END IF
2390 CONTINUE
2400 CONTINUE
YMAJ = YMAJ + MAJTIC
IF (YMAJ.GT.Y+YLENG+FUDGE .AND. GRAPHP(32).EQ.0.) THEN
GO TO 2380
ELSE IF (YMAJ.GT.Y+YLENG-FUDGE .AND. GRAPHP(32).EQ.1.) THEN
GO TO 2380
END IF
CALL PLTSTD(1,GRAPHP(77))
CALL PLTSTV(2,GRAPHP(67))
CALL PLTVCT(1,X,YMAJ,X+LENMAJ,YMAJ)
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,X+XLENG,YMAJ,X+XLENG-LENMAJ,YMAJ)
END IF
IF (GRAPHP(35).NE.0. .OR. GRAPHP(73).NE.0.) THEN
IF (GRAPHP(35).EQ.0.) THEN
CALL PLTSTV(1,GRAPHP(73))
ELSE
CALL PLTSTV(1,GRAPHP(35))
END IF
IF (GRAPHP(35).EQ.0.) THEN
CALL PLTSTD(1,GRAPHP(74))
ELSE
CALL PLTSTD(1,GRAPHP(36))
END IF
IF (GRAPHP(35).EQ.0.) THEN
CALL PLTSTV(2,GRAPHP(69))
ELSE
CALL PLTSTV(2,GRAPHP(68))
END IF
IF (GRAPHP(32).EQ.1.) THEN
CALL PLTVCT(1,X+LENMAJ,YMAJ,X+XLENG-LENMAJ,YMAJ)
ELSE
CALL PLTVCT(1,X+LENMAJ,YMAJ,X+XLENG,YMAJ)
END IF
CALL PLTSTV(1,1.)
END IF
IF (NUMSIZ.GT.0.0) THEN
LINE = ' '
WRITE (LINE,FORMA,ERR=131) XNUM
131 DO 2410 J = 1,15
IF (LINE(J:J).NE.' ') THEN
GO TO 2420
END IF
2410 CONTINUE
2420 CONTINUE
ILAST = 15
IF (NDEC.EQ.0) THEN
ILAST = 14
END IF
CALL PLTSTT(2,NUMSIZ)
CALL PLTSTT(11,GRAPHP(64))
CALL PLTSTD(1,GRAPHP(76))
CALL PLTXSL(LINE(J:ILAST),TLEN)
IF (GRAPHP(92).EQ.1.) THEN
LONNUM = NUMSIZ
CALL PLTSTT(3,90.)
CALL PLTXTS(X-XOFF,YMAJ-TLEN/2.,LINE(J:ILAST))
CALL PLTSTT(3,0.)
ELSE
CALL PLTXTS(X- (TLEN+XOFF),YMAJ-NUMSIZ/2.,LINE(J:ILAST))
IF (TLEN.GT.LONNUM) THEN
LONNUM = TLEN
END IF
END IF
END IF
XNUM = XNUM + INTER
GO TO 2360
2380 CONTINUE
IF (PLTNER(YMAJ,Y+YLENG) .AND. NUMSIZ.GT.0.0) THEN
LINE = ' '
WRITE (LINE,FORMA,ERR=132) XNUM
132 DO 2430 J = 1,15
IF (LINE(J:J).NE.' ') THEN
GO TO 2440
END IF
2430 CONTINUE
2440 CONTINUE
ILAST = 15
IF (NDEC.EQ.0) THEN
ILAST = 14
END IF
CALL PLTSTT(2,NUMSIZ)
CALL PLTSTT(11,GRAPHP(64))
CALL PLTSTD(1,GRAPHP(76))
CALL PLTXSL(LINE(J:ILAST),TLEN)
IF (GRAPHP(92).EQ.1.) THEN
LONNUM = NUMSIZ
CALL PLTSTT(3,90.)
CALL PLTXTS(X-XOFF,YMAJ-TLEN/2.,LINE(J:ILAST))
CALL PLTSTT(3,0.)
ELSE
CALL PLTXTS(X- (TLEN+XOFF),YMAJ-NUMSIZ/2.,LINE(J:ILAST))
IF (TLEN.GT.LONNUM) THEN
LONNUM = TLEN
END IF
END IF
END IF
IF ((XMIN.LT.0..AND.XMAX.GT.0.) .AND.
* (GRAPHP(35).EQ.0..AND.GRAPHP(73).EQ.0.) .AND.
* GRAPHP(71).NE.0.) THEN
CALL PLTSTV(1,GRAPHP(71))
CALL PLTSTD(1,GRAPHP(72))
CALL PLTSTV(2,GRAPHP(70))
Y0LINE = Y - (XMIN*YLENG)/ (XMAX-XMIN)
CALL PLTVCT(1,X+LENMAJ,Y0LINE,X+XLENG-LENMAJ,Y0LINE)
CALL PLTSTV(1,1.)
END IF
IF (LABSIZ.GT.0.0) THEN
TLABEL = ' '
LL = 0
IF (LABEL.NE.' ') THEN
TLABEL = LABEL
CALL CHRTRM(TLABEL,LL)
#if NeedsDoubleEscape
TLABEL(LL+1:LL+2) = '\\-'
#else
TLABEL(LL+1:LL+2) = '\-'
#endif
LL = LL + 2
END IF
IF (UNITS.NE.' ') THEN
TLABEL(LL+6:) = UNITS
CALL CHRTRM(TLABEL,LL)
#if NeedsDoubleEscape
TLABEL(LL+1:LL+2) = '\\-'
#else
TLABEL(LL+1:LL+2) = '\-'
#endif
LL = LL + 2
END IF
IF (EXP.NE.0. .AND. NUMSIZ.GT.0.) THEN
IF (LL.GT.0) THEN
LL = LL + 1
END IF
EXPL = ' '
WRITE (EXPL,'(i4)',ERR=134) EXP
134 DO 2450 I = 1,4
IF (EXPL(I:I).NE.' ') THEN
GO TO 2460
END IF
2450 CONTINUE
2460 CONTINUE
#if NeedsDoubleEscape
TLABEL(LL+1:) = '( *10\\^'//EXPL(I:)//'\\- )'
#else
TLABEL(LL+1:) = '( *10\^'//EXPL(I:)//'\- )'
#endif
END IF
CINPUT = TLABEL
CALL CHRSTR(CINPUT,TLABEL,LL)
IF (LL.GT.0) THEN
CALL PLTSTT(2,LABSIZ)
CALL PLTSTT(11,GRAPHP(65))
CALL PLTSTD(1,GRAPHP(39))
CALL PLTSTT(3,90.)
CALL PLTXSL(TLABEL(1:LL),TLEN)
XLAB = X - LONNUM - LABSIZ*1.4
YLAB = Y + (YLENG-TLEN)/2.
CALL PLTXTS(XLAB,YLAB,TLABEL(1:LL))
CALL PLTSTT(3,0.)
END IF
IF (CPUIFC(.FALSE.)) THEN
GO TO 2200
END IF
END IF
ELSE
CALL PLTFLU
CALL SIORPT('PLTAXS','Invalid axis type - '//TTYPE,2)
END IF
IF (.NOT. (.TRUE.)) GO TO 2180
2200 CONTINUE
CALL PLTRET
CALL PLTRED
CALL PLTREV
RETURN
END