         SUBROUTINE RCARD(ISET,ICARD,IER,NSINT,DSPACE,INT,CNAME,EL
     1,ICOR,D2)
C
c  subroutine to fetch pdf card from the vax diffrac 500 data base.
c  by R. L. Snyder 2/86
C
C  ************************************************************************
C
C         THIS SUBROUTINE ACCEPTS THE SET AND CARD NUMBER AND CALLS
C         UNPACK TO RETURN THE D-SPACING AND INTENSITY ARRAYS ALONG 
C         WITH THE NUMBER OF DI PAIRS, THE ELEMENT NAME AND THE
C         CHEMICAL SPECIES NAME.
C
C  ***********************************************************************
C 
        IMPLICIT INTEGER (I-N)
c  translation of specplot variables and vax unpack variables:
c specplot variables     difrac500 variables
c ISET*2			iset (changed to *2)
c ICARD*2			icard (changed from cardno as *2)
c IER*2
c NSINT*2			ndi*4
c DSPACE(101)real		idees(101)*4->dspace
c INT*2(101)			ints(101)*4
c CNAME(42)byte			mina(66)*2
c  cname(1) = cnum*2
c EL(42)byte			chem(42)*2
c  el(1) = elnum*2
c ICOR*2			iicor*4
c D2(13)byte			location of pdf file
	integer*4 icode,irfa, offset, ints(101),cheml,minl
        integer*4 iunit2,patnum, ndi, idees(101),iicor 
	integer*2 mina (33), ela(22)
        byte minaa(66), elaa(44)
	integer*2 maxset
c  The following are the normal specplot variables
        INTEGER*2 INT(101), nsint, icor, ier, iset, icard
        REAL*4 DSPACE(101)
        BYTE CNAME(42), D2(13), EL(42)
        equivalence (mina(1),minaa(1)), (elaa(1),ela(1))
        LOGICAL*1 NAME(40)
C
C       FIRST OPEN DIRECTORY FILE AND BINARY MASTER FILE
C       AND READ IN THE DIRECTORY INFORMATION
C
        IER = 0
        do 5 i=1,13
5	name(i) = d2(i)
	name(14) = 'J'
	name(15) = 'C'
	name(16) = 'P'
	name(17) = 'D'
	name(18) = 'S'
	name(19) = '.'
	name(20) = 'D'
	name(21) = 'I'
       	name(22) = 'R'
        do 6 i=23,39
6	name(i) = ' '
       	name(40) = 0
        IUNIT2 = 21
	OPEN ( UNIT=IUNIT2, NAME=NAME, TYPE='OLD', READONLY,
     +	SHARED,	ACCESS='DIRECT', RECORDSIZE=1)
	read (iunit2 ' 1) maxset		!get the maximum available
c						!SET  number
	if (iset .lt. 1 .or. iset .gt. maxset) go to 15
	read (iunit2 ' 1+iset) offset		!read offset
	read (iunit2 ' offset) maxnum		!read maximum card no.
	if (icard .lt. 1 .or. icard .gt. maxnum) go to 15
	read (iunit2 'icard+offset) irfa			!read address
	close (unit = iunit2)
c	if (irfa .lt. 0) go to 15			!yes card exists
	go to 20
15        IER = 2                             ! NONEXISTANT PATTERN
          GOTO 999
C
C         OPEN THE MASTER FILE FILE
C
20	name(20) = 'B'
       	name(22) = 'N'
	icode = 0
	patnum = iunit2				!for rsx
	call unpack (icode , patnum, name ,ndi, idees, 
     +			ints, iicor, mina)	!open packed file
	if (icode .ne. 0) then 
              	ier = 1
              	go to 999		!error opening
        endif
	if (irfa .gt. 0) go to	25		!card does not exist
22      IER = 3                                     !PATERN PROBABLY DELETED
        GOTO 999
C           
C         CLEAR BUFFERS FOR ID AND INT ARRAYS
C
25        DO 30 I=1,101
       	  idees(i) = 0
          DSPACE(I)=0.0
          INT(I)=0
30        CONTINUE
C
C         CLEAR CNAME AND EL
C
          DO 40 I=1,42
          CNAME(I)=' '
          EL(I)=' '
40        CONTINUE
	call unpack (irfa , patnum, ela ,ndi, idees, 
     +			ints, iicor, mina)	!open packed file
	if (patnum .ne. icard) go to 22	!this should never happen
c **	push information on appropriate arrays
	icor = iicor/100.0		!i/icor value
        IF (ICOR.EQ.0.0) ICOR = 1.0
        DO 303 I=1,40
          CNAME(I)=minaa(i+2)
303     CONTINUE          
        DO 304 I=1,40
          EL(I)=ELAA(I+2)
304     CONTINUE
        nsint = ndi
        pi = 3.14159265
	halfla = 0.770255
	do 400 i = 1, ndi			!convert d's
        INT(I) = INTS(I)	
	dspace(i) = halfla/ sin((pi + (idees(i)/10000.0))/4.0)
400	continue
1000	icode = -1				!close the .bin file
	call unpack (icode , patnum, name ,ndi, idees, 
     +			ints, iicor, mina)
999	return
       END

