      SUBROUTINE JCPDS(IN,XW,YW,NN,D2,XL,JIN)
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
C  SUBROUTINE TO DISPLAY JCPDS CARD AS PART OF "SPECPLOT"
C   WRITTEN BY RAY GOEHNER  3/82
C
C  LU-1  INDEX FILE
C  LU-2  PDF FILE
C
C   MAXBUF=5000 NEEDED TO OPEN INDEX FILE
C
      DIMENSION DSP(100)
      INTEGER INT(100),PDF,CLR(7),WSPC
      BYTE CNAME(110),NF,CL,CLB,CLA,CLG(5)
      BYTE ISP,JSP,IFL,D2(12),IDSP,ITERM
      DATA CLR/'C0','C1','C2','C3','C4','C5','C6'/
C
      IF(IN.NE.'DI') RETURN
      IPEN=3
      IC=2
   10 IZ=0
      NN=NN+1
      CALL TPLOT(2,XW,YW)
      WRITE(7,100) NN
  100 FORMAT('+',$,'PDF(',I2,')=')
      CALL PDF(5,IFILE,ICARD,IR)
      XW=XW+252.
      CALL XWYW(XW,YW,XS,XF,252.0)
      IF(IR.EQ.3.OR.IR.EQ.9) GO TO 9999
      IF(IFILE.LT.1.OR.IFILE.GT.70) GO TO 10
      IF(ICARD.LT.1.OR.ICARD.GT.2500) GO TO 10
      CALL CLOSE(11)
      CALL SINDEX(11,6,D2,IFILE,ICARD,IREC)
      CALL CLOSE(11)
      IF(IREC.EQ.0) RETURN
      CALL ASELEC(D2,IFILE,11)
      NF='D'
      CALL RCARD(IREC,DSP,INT,NDI,CNAME,NSYM,11,RIC,NF,XL)
      CALL CLOSE(11)
      CALL DSORT(DSP,INT,NDI)
      CALL DRANGE(CSTR,CFIN,DSP,INT,NDI,IS,IF,XL,IMAX,IMIN)
      CALL PDFPL(AUSX,BUSX,DSP,INT,IS,IF,NN,IMAX,IMIN,XL,YYS,YYF
     1,XXS,XXF,CW,CH,ITERM)
      IF(ITERM.NE.1) GO TO 200
      IC=IC+1
      IF(IC.EQ.4) IC=5
      IF(IC.GT.6) IC=1
      CALL T4027(CLR(IC),WSPC,3)
      GO TO 10
  200 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
  300 CALL ENVIS(0)
      GO TO 10
 9999 CALL CLOSE(11)
      IF(IR.EQ.3) JIN=22
      RETURN
      END
      SUBROUTINE ASELEC(D2,I,LPDF)
C  OPENS APPROPRIATE PDF FILE
      BYTE FILE(21),D2(12)
C
      ENCODE(20,9300,FILE) D2
9300  FORMAT(12A1,'PDF.    ')
      ENCODE(3,500,FILE(17)) I
  500 FORMAT(I3)
      IF(FILE(17).EQ.' ') FILE(17)='0'
      IF(FILE(18).EQ.' ') FILE(18)='0'
      FILE(21)=0
      OPEN(UNIT=LPDF,NAME=FILE,ACCESS='DIRECT',RECORDSIZE=16,TYPE='OLD'
     %,SHARED,READONLY,ERR=900)
      RETURN
C  ERROR DURING OPEN
  900 WRITE(5,1000) FILE
 1000 FORMAT(1X,'PDF FILE ',20A1,' NOT OPENED')
      RETURN
      END
      SUBROUTINE SINDEX(LUINDX,LUTI,D2,IFILE,ICARD,IREC)
C
C  OPEN INDEX FILE & GET RECORD OF PDF CARD
C
      INTEGER INDEX(2500)
      BYTE D2(12),FN(22)
C
      ENCODE(21,1000,FN) D2
 1000 FORMAT(12A1,'INDEX.PDF')
      FN(22)=0
      OPEN(UNIT=LUINDX,NAME=FN,ACCESS='DIRECT'
     1,RECORDSIZE=1250,TYPE='OLD',SHARED,READONLY,ERR=99)
C
      READ(LUINDX'IFILE) INDEX
      IREC=INDEX(ICARD)
      IF(IREC.LT.0) IREC=-IREC
      RETURN
   99 WRITE(LUTI,100)FN
  100 FORMAT(1X,22A1,' INDEX FILE WAS NOT OPENED')
      STOP
      END
      SUBROUTINE PDFPL(AUSX,BUSX,DSP,INT,IS,IF,N,IMAX,IMIN,XL,YYS,YYF
     1,XXS,XXF,CW,CH,ITERM)
C
C  SUBROUTINE TO PLOT PDF CARDS ON SPECPLOT
C
      DIMENSION DSP(100),INT(100)
      BYTE ITERM
      IF(IS.EQ.0) RETURN
      IF(IF.EQ.0) RETURN
      YMIN=YYS
      YMAX=YYF-YYS-2*CH
      XLAST=XXS
      YLAST=YMIN
      DO 100 I=IS,IF
      IF(DSP(I).LT.0.1) GO TO 100
      X=XL/(2.0*DSP(I))
      IF(X.GT.0.99999) GO TO 100
      IF(X.LT.0.01) GO TO 100
      X=114.592*ASIN(X)
      XC=AUSX*X+BUSX
      IF(XC.LT.XXS) GO TO 100
      IF(XC.GT.XXF) GO TO 100
      Y=YMAX*INT(I)/FLOAT(IMAX)+YMIN
      IF(Y.LE.(YMIN+1)) GO TO 100
      CALL TPLOT(0,XC,YMIN)
      CALL TPLOT(1,XC,Y)
      IF(ABS(XLAST-XC).LT.28.0.AND.ABS(YLAST-Y).LT.44.0) GO TO 100
      IF(ITERM.EQ.0) N=N-1
      IF(ITERM.EQ.0) CALL X2Y2(XC,Y,N,CW,CH)
      XLAST=XC
      YLAST=Y
  100 CONTINUE
      CALL TPLOT(2,XC,Y)
      RETURN
      END
      SUBROUTINE DRANGE(CSTR,CFIN,DSP,INT,NDI,IS,IF,XL,IMAX,IMIN)
C
C  SUBROUTINE TO FIND RANGE OF D'S WITHIN THE SPECPLOT DISPLAY
C   WRITTEN BY RAY GOEHNER 4/82
C
      DIMENSION DSP(100),INT(100)
      DMIN=XL/(2.0*SIN(0.008726646*CFIN))
      DMAX=XL/(2.0*SIN(0.008726646*CSTR))
      IS=0
      IF=0
      DO 100 I=1,NDI
      IF(DSP(I).GE.DMIN.AND.DSP(I).GT.0.01) IF=I
  100 IF(DSP(I).LE.DMAX.AND.IS.EQ.0) IS=I
      IF(IS.EQ.0) RETURN
      IF(IF.EQ.0) RETURN
      IMAX=0
      IMIN=32000
      DO 200 I=IS,IF
      IF(INT(I).GT.IMAX) IMAX=INT(I)
  200 IF(INT(I).LT.IMIN) IMIN=INT(I)
      RETURN
      END
      SUBROUTINE RCARD(NREC,DSPACE,INT,NDSINT,CNAME,NSYM,LUNPDF,RIC,
     1 NF,WKA1)
C--
C  READS DESIGNATED JCPDS CARD AND RETURNS D'S AND I'S OR T'S AND I'S
C--
      DIMENSION DSPACE(100)
      INTEGER INT(100),DSP(21),D(9)
      BYTE CNAME(110),IN(21),IB(9),NF
      BYTE BUFFER(37),NAME(60),IIC(5)
      DO 10 I=1,110
10    CNAME(I)=' '
      READ(LUNPDF'NREC)BUFFER,D,IB
      NREC=NREC+1
      NDSINT=BUFFER(1)
      NSYM=BUFFER(2)
      CNAME(39)=BUFFER(3)
      DO 170 LL=1,34
      KK=LL+3
170   CNAME(LL)=BUFFER(KK)
      NN=1
      DO 200 I=1,9
C      DSPACE(I)=0.770299/SIN(0.0000872665*D(I))
	X=0.25*(0.0001*FLOAT(D(I))+3.14159265)
	DSPACE(NN)=0.770299/SIN(X)
      IF(NF.NE.'T')GOTO171
      X=WKA1/(2.0*DSPACE(I))
      IF(X.GT.1)GOTO200
	 DSPACE(NN)=114.59156*ASIN(X)
171   INT(NN)=IB(I)
      NN=NN+1
200   CONTINUE
      N=9
      IF(N.GE.NDSINT)GO TO 700
50    READ(LUNPDF'NREC)DSP,IN
      NREC=NREC+1
      DO 55 I=1,21
      N=N+1
      IF(N.GT.NDSINT)GO TO 700
	X=0.25*(0.0001*FLOAT(DSP(I))+3.14159265)
      DSPACE(NN)=0.770299/SIN(X)
      IF(NF.NE.'T')GOTO54
      X=WKA1/(2.0*DSPACE(NN))
      IF(X.GT.1)GOTO55
      DSPACE(NN)=114.59156*ASIN(X)
54    INT(NN)=IN(I)
      NN=NN+1
55    CONTINUE
      IF(N.LT.NDSINT)GO TO 50
700    NN=NN-1
      IF(NN.LT.NDSINT)NDSINT=NN
      READ(LUNPDF'NREC)NAME,RIC
      NREC=NREC+1
      N=45
      DO 720 I=1,60
      N=N+1
      CNAME(N)=NAME(I)
720   CONTINUE
      RETURN
      END
	SUBROUTINE DSORT (DSPACE,INT,NDSINT)
C
C  BUBBLE SORTS DSPACE ARRAY FROM HIGH TO LOW
C
	DIMENSION DSPACE(100)
	INTEGER INT(100)
	N=NDSINT-1
100	NSWAP=0
	DO 300 K=1,N
	IF(DSPACE(K).GE.DSPACE(K+1))GO TO 300
	TEMP=DSPACE(K+1)
	DSPACE(K+1)=DSPACE(K)
	DSPACE(K)=TEMP
	ITEMP=INT(K+1)
	INT(K+1)=INT(K)
	INT(K)=ITEMP
	NSWAP=1
300	CONTINUE
	IF(NSWAP.NE.0)GO TO 100
	RETURN
	END
      SUBROUTINE PDF(LUTI,IFILE,ICARD,IR)
C
C  GET PDF FILE & CARD NUMBER
C  IR=3 REFRESH THE SCREEN
C
      BYTE INP(10)
      IR=10
      IFILE=0
      ICARD=0
C
  100 READ(LUTI,1000,END=9998) IQ,INP
 1000 FORMAT(Q,10A1)
      IF(INP(1).EQ.'R'.OR.INP(1).EQ.'#') IR=3
      IF(INP(1).EQ.'R'.OR.INP(1).EQ.'#') GO TO 9999
      IF(INP(1).EQ.' ') GO TO 9998
      IF(INP(1).LT.48.OR.INP(1).GT.57) GO TO 9999
      DO 1100 I=1,10
      IF(INP(I).EQ.','.OR.INP(I).EQ.'-') J=I
 1100 CONTINUE
      K=J-1
      DO 1200 I=1,(J-1)
      K=K-1
 1200 IFILE=IFILE+(INP(I)-48)*10**K
      K=IQ-J
      DO 1300 I=(J+1),IQ
      K=K-1
 1300 ICARD=ICARD+(INP(I)-48)*10**K
      IF(IFILE.LE.0) GO TO 100
      IF(ICARD.LE.0.OR.ICARD.GE.2500) GO TO 100
 9999 RETURN
 9998 IR=9
      RETURN
      END
