      SUBROUTINE MARKER(IN,XW,YW,NN,XL,JIN,D3)
C
      COMMON /CRD/AUSX,BUSX,AUSY,BUSY,ASUX,BSUX,ASUY,BSUY,AMSX,BMSX
     1,ASMX,BSMX,AUMX,BUMX,AMUX,BMUX,IDSP,ITERM,N,NS,NF
      COMMON /SCN/ XS,XF,YS,YF,XXS,XXF,YYS,YYF,CSTR,CFIN,CYMIN,CYMAX,STR
     1,FIN,YMIN,YMAX,ZZ,CW,CH,ISP,JSP,IFL
      COMMON /COLOR/ CL,CLB,CLA,CLG
C  SUBROUTINE TO DISPLAY ELEMENTAL MARKERS AS PART OF "SPECPLOT"
C  WRITTEN BY RAY GOEHNER  3/82
C
      DIMENSION WL(120),INT(120)
      INTEGER ELEM,IZ,CLR(7),WSPC,ORD
      BYTE BUF(4),FILE(23),D3(12),ISP,JSP,IFL,IDSP,ITERM,JIN
      EQUIVALENCE(ELEM,BUF(1))
      DATA CLR/'C0','C1','C2','C3','C4','C5','C6'/
C
      IF(IN.EQ.'DI') RETURN
      ENCODE(22,9300,FILE) D3
 9300 FORMAT(12A1,'LAMBDA.INP')
      FILE(23)=0
      OPEN(UNIT=11,NAME=FILE,TYPE='OLD',READONLY
     X,ACCESS='DIRECT',RECORDSIZE=180,ERR=990)
      IPEN=3
      IC=2
   10 IZ=0
      NN=NN+1
      CALL TPLOT(2,XW,YW)
      WRITE(7,100) NN
  100 FORMAT('+',$,'Z(',I2,')=')
  110 DO 111 I=1,4
  111 BUF(I)=' '
      READ(7,200,END=9999) BUF
  200 FORMAT(4A1)
C  THIS CODE ALLOWS USER TO TYPE ELEMENT SYMBOL WITHOUT BLANK
      IF(BUF(2).NE.','.AND.BUF(2).NE.'/') GO TO 120
      BUF(2)=' '
      BUF(4)=BUF(3)
      BUF(3)=','
  120 ORD=BUF(4)-48 !ASCII '0' IS 48
      IF(BUF(4).EQ.' ') ORD=1
      IF(ORD.LT.1.OR.ORD.GT.9) GO TO 10
      I=9
      IF(ORD.GT.1) I=11    ! ALLOW 4 CHARACTERS INSTEAD OF 2
      XW=XW+I*CW
      W=I*CW
      CALL XWYW(XW,YW,XS,XF,W,CH,CW)
      IF(ELEM.EQ.'  ') GO TO 9999
C  RF OR # WILL REFRESH THE SCREEN  (JIN=22)
      IF(ELEM.EQ.'RF') GO TO 9998
      IF(ELEM.EQ.'#') GO TO 9998
      CALL ZSYM(IZ,ELEM,6)
      IF(IZ.EQ.0) GO TO 110
      IREC=IZ
      READ(11'IREC) WL,INT
C
C  IS & IF RANGE OF LAMDA IN FILE
C  INS & INF RANGE OF ORDER UP TO 10TH ORDER IN FILE
C
      CALL RANGE(CSTR,CFIN,WL,INT,IS,IF,XL,IMAX,IMIN,ORD,IN)
      CALL MARKPL(AUSX,BUSX,WL,INT,IS,IF,NN,IMAX,IMIN,XL,YYS,YYF,XXS,XXF
     1,ORD,CW,CH,ITERM,IN)
      IF(ITERM.NE.1) GO TO 201
      IC=IC+1
      IF(IC.EQ.4) IC=5
      IF(IC.GT.6) IC=1
      CALL T4027(CLR(IC),WSPC,3)
      GO TO 10
  201 IF(ITERM.LT.2) GO TO 10
      IF(ITERM.GE.3) GO TO 300
      IPEN=IPEN+1
      IF(IPEN.GT.7) IPEN=3
      CALL T4662(-1,IPEN)
      GO TO 10
C
 9998 JIN=22
  300 CALL ENVIS(0)
      GO TO 10
 9999 CLOSE(UNIT=11)
      RETURN
  990 TYPE *,'********************************************************'
      WRITE(6,1000) FILE
 1000 FORMAT(1X,23A1,' ELEMENTAL FILE NOT OPENED')
      TYPE *,'DOES IT EXIST'
      TYPE *,'******************************************************'
      STOP 'WHAT CHOICE DO I HAVE ?'
      END
      SUBROUTINE ZSYM(IZ,ELEM,LUTI)
C
C   PROGRAM TO CONVERT ELEMENT SYMBOL TO ATOMIC NUMBER IF ELEM IS BLANK
C   OR CONVERT ATOMIC NUMBER IF IZ IS ZERO
C
      INTEGER*2 IZ,ELEM,D(104)
C
      IF(IZ.EQ.0.AND.ELEM.EQ.'  ') GO TO 999
      IF(IZ.GT.104) GO TO 990
      D(1)='H '
      D(2)='HE'
      D(3)='LI'
      D(4)='BE'
      D(5)='B '
      D(6)='C '
      D(7)='N '
      D(8)='O '
      D(9)='F '
      D(10)='NE'
      D(11)='NA'
      D(12)='MG'
      D(13)='AL'
      D(14)='SI'
      D(15)='P '
      D(16)='S '
      D(17)='CL'
      D(18)='AR'
      D(19)='K '
      D(20)='CA'
      D(21)='SC'
      D(22)='TI'
      D(23)='V '
      D(24)='CR'
      D(25)='MN'
      D(26)='FE'
      D(27)='CO'
      D(28)='NI'
      D(29)='CU'
      D(30)='ZN'
      D(31)='GA'
      D(32)='GE'
      D(33)='AS'
      D(34)='SE'
      D(35)='BR'
      D(36)='KR'
      D(37)='RB'
      D(38)='SR'
      D(39)='Y '
      D(40)='ZR'
      D(41)='NB'
      D(42)='MO'
      D(43)='TC'
      D(44)='RU'
      D(45)='RH'
      D(46)='PD'
      D(47)='AG'
      D(48)='CD'
      D(49)='IN'
      D(50)='SN'
      D(51)='SB'
      D(52)='TE'
      D(53)='I '
      D(54)='XE'
      D(55)='CS'
      D(56)='BA'
      D(57)='LA'
      D(58)='CE'
      D(59)='PR'
      D(60)='ND'
      D(61)='PM'
      D(62)='SM'
      D(63)='EU'
      D(64)='GD'
      D(65)='TB'
      D(66)='DY'
      D(67)='HO'
      D(68)='ER'
      D(69)='TM'
      D(70)='YB'
      D(71)='LU'
      D(72)='HF'
      D(73)='TA'
      D(74)='W '
      D(75)='RE'
      D(76)='OS'
      D(77)='IR'
      D(78)='PT'
      D(79)='AU'
      D(80)='HG'
      D(81)='TL'
      D(82)='PB'
      D(83)='BI'
      D(84)='PO'
      D(85)='AT'
      D(86)='RN'
      D(87)='FR'
      D(88)='RA'
      D(89)='AC'
      D(90)='TH'
      D(91)='PA'
      D(92)='U '
      D(93)='NP'
      D(94)='PU'
      D(95)='AM'
      D(96)='CM'
      D(97)='BK'
      D(98)='CF'
      D(99)='ES'
      D(100)='FM'
      D(101)='MD'
      D(102)='NO'
      D(103)='LW'
      D(104)='LN'  ! ALL RARE EARTHS ALA JCPDS
C
      IF(ELEM.NE.'  ') GO TO 100
      ELEM=D(IZ)
      RETURN
  100 DO 200 I=1,104
  200 IF(ELEM.EQ.D(I)) IZ=I
      IF(ELEM.EQ.'D ')IZ=1
      RETURN
  999 WRITE(LUTI,300)
  300 FORMAT(1X,'WHICH ONE DO YOU WANT Z OR ELEM SHOULD I GUESS ?')
      STOP
  990 WRITE(LUTI,400)
  400 FORMAT(1X,'ATOMIC NUMBER OUT OF RANGE')
      STOP
      END
      SUBROUTINE RANGE(CSTR,CFIN,WL,INT,IS,IF,XL,IMAX,IMIN,ORD,IN)
C
C  SUBROUTINE TO FIND RANGE OF WAVELENGTH WITHIN DISPLAY
C
      DIMENSION WL(120),INT(120)
      INTEGER*2 ORD
C
      IF(IN.EQ.'XR') THEN
      XLMIN=XL*SIN(0.008726646*CSTR)
      XLMAX=XL*SIN(0.008726646*CFIN)
      ENDIF
C
      IF(IN.EQ.'ED') THEN
	XLMIN=12.4/CFIN
	IF(CSTR.LE.0.0) XLMAX=100.0
	IF(CSTR.GT.0.0) XLMAX=12.4/CSTR
      ENDIF
C
      IS=32000
      IF=0
      IMAX=0
      IMIN=32000
      DO 100 I=1,120
      DO 100 J=1,ORD
      IF(J*WL(I).LT.XLMIN) GO TO 100
      IF(J*WL(I).GT.XLMAX) GO TO 100
      IF(I.LT.IS) IS=I
      IF(I.GT.IF) IF=I
      IF(INT(I)/J.GT.IMAX) IMAX=INT(I)/J
      IF(INT(I)/J.LT.IMIN) IMIN=INT(I)/J
  100 CONTINUE
      IF(IS.EQ.32000) RETURN
      IF(IF.EQ.0) RETURN
      RETURN
      END
      SUBROUTINE MARKPL(AUSX,BUSX,WL,INT,IS,IF,N,IMAX,IMIN,XL,YYS,YYF
     1,XXS,XXF,ORD,CW,CH,ITERM,IN)
C
C  SUBROUTINE TO PLOT ELEMENTAL MARKERS ON SPECPLOT
C
      DIMENSION WL(120),INT(120)
      BYTE ITERM
      INTEGER ORD
      IF(IS.EQ.32000) RETURN
      IF(IF.EQ.0) RETURN
      YMIN=YYS
      YMAX=YYF-YYS-2*CH
      XLAST=XXS
      YLAST=YMIN
   10 DO 100 I=IS,IF
      IF(IN.EQ.'XR') Z=WL(I)/XL
      IF(IN.EQ.'ED') Z=WL(I)
      DO 100 J=1,ORD
      X=J*Z
      IF(IN.EQ.'XR'.AND.X.GT.0.99999) GO TO 100
      IF(X.LT.0.01) GO TO 100
      IF(IN.EQ.'XR') X=114.592*ASIN(X)
      IF(IN.EQ.'ED') X=12.4/X
      XC=AUSX*X+BUSX
      IF(XC.LT.XXS) GO TO 100
      IF(XC.GT.XXF) GO TO 100
      Y=INT(I)/J
      Y=YMAX*Y/FLOAT(IMAX)+YMIN
      IF(Y.LE.(YMIN+6)) GO TO 100
      IF(J.GT.1) GO TO 120
      CALL TPLOT(0,XC,YMIN)
      CALL TPLOT(1,XC,Y)
      GO TO 110
  120 CALL DOTY(XC,YMIN,Y)
  110 IF(ABS(XLAST-XC).LT.28.0.AND.ABS(YLAST-Y).LT.44.0) GO TO 100
      IF(ITERM.EQ.0.OR.ITERM.EQ.6) N=N-1
      IF(ITERM.EQ.0.OR.ITERM.EQ.6) CALL X2Y2(XC,Y,N,CW,CH)
      XLAST=XC
      YLAST=Y
  100 CONTINUE
      CALL TPLOT(2,XC,Y)
      RETURN
      END
C
      SUBROUTINE DOTY(XC,YMIN,YMAX)
      IYMAX=YMAX
      IYMIN=YMIN
      DO 100 I=IYMIN,IYMAX,5
      Y=I
      Y2=I+1
      CALL TPLOT(0,XC,Y)
      CALL TPLOT(1,XC,Y2)
  100 CONTINUE
      RETURN
      END
