C========================================================================
	SUBROUTINE READDI(DIREC,DSPACE,INT,NDSINT,LPDF,WAVE,maxpeaks)
C========================================================================
C  Reads designated a JCPDS card and returns D's and I's or 2T's and I's
C--
C	DIREC	  is the D/I file record number
C	DSPACE(*) are the (returned) array of D's or 2T's
C	INT(*)	  are the (returned) array of I's 
C	LPDF	  is the file number for the JCPDS D/I file
C	NDSINT    is the number of intensities
C	WAVE	  is the wavelength for 2Theta's; 0 for D's
C	MAXPEAKS  is the maximum number of peaks to be read 
C========================================================================
	REAL DSPACE(*)
	INTEGER*2 INT(*),MAXPEAKS  
	INTEGER*4 DIREC
	REAL WAVE
	INTEGER NDSINT,LPDF

	LOGICAL FLAG,DTOTT,PDFTOD
	INTEGER*4 NREC,maxread
	INTEGER*2 PDF2T(210)
	BYTE INTBYT(210)
	INTEGER*2    NUMDS
	INTEGER NE,NREAD,NB,N,I
	REAL X

	NDSINT = 0
	IF (DIREC .LE. 0) RETURN

	MAXREAD = MIN(210,MAXPEAKS)
	NE = 0
	nread = 0
	NREC=DIREC

100	NB = NE + 1
	NE = NB + 41
	READ(LPDF,REC=NREC) NUMDS,(PDF2T(N),N=NB,NE),(INTBYT(N),N=NB,NE)
	nread = nread + 42
	NREC = NREC + 1
	IF (min(maxread,NUMDS) .gt. NREAD) GOTO 100

C now convert PDF2T's to either angles or D's
	NDSINT = 0
	DO I=1,min(maxread,NUMDS)
C    convert from PDF encoding to a dspace
	  FLAG = PDFTOD(PDF2T(I),X)
	  IF (.not. FLAG) type *,'READDI ERROR -- ILLEGAL PDF: '
	1	,NREC,I,PDF2T(I)
C    convert to angle (if appropriate)
	  IF (FLAG .and. WAVE .gt. 0.0) FLAG = DtoTT(X,X,WAVE)
	  IF (FLAG) THEN 
	    NDSINT = NDSINT + 1
	    DSPACE(NDSINT) = X
	    INT(NDSINT) = INTBYT(I)
	  ENDIF
	ENDDO
	RETURN
	END
C========================================================================
	SUBROUTINE READNAM(NAMREC,LUNN,QM,FCOR,
	1	CHFORM,LCHFORM,CHNAME,LCHNAME)
C========================================================================
C  READS DESIGNATED JCPDS CARD AND RETURNS NAME FILE INFORMATION
C--
C	Updated to read 64 byte records	BHT 7/88
C========================================================================
	INTEGER*4 NAMREC,LUNN
	CHARACTER*1 QM
	BYTE CHFORM(*),CHNAME(*)
	INTEGER*2 LCHFORM,LCHNAME

	BYTE BUFFER(405)
	INTEGER*4 NREC
	INTEGER JE,J,NBYTES,NLINES,NL,JB
	REAL FC,FCOR

	LCHFORM = 0
	LCHNAME = 0 
	FC = 0.0
	QM = ' '
C return with null values if there is no name record
	IF (NAMREC .le. 0) RETURN
	JE=55
	READ (LUNN,REC=NAMREC) LCHFORM,LCHNAME,QM,FCOR,(BUFFER(J),J=1,JE)
	NBYTES=9+LCHFORM+LCHNAME

C   How many more lines to read?
	NLINES=(NBYTES-1)/64
	NREC = NAMREC
	DO NL=1,NLINES
	  JB = JE+1
	  JE = JE+64
	  NREC=NREC+1
	  READ (LUNN,REC=NREC) (BUFFER(J),J=JB,JE)
	ENDDO

C copy names from the buffer array
	DO J=1,LCHFORM
	  CHFORM(J) = BUFFER(J)
	ENDDO
	DO J=1,LCHNAME
	  CHNAME(J)=BUFFER(J+LCHFORM)
	ENDDO

	RETURN
	END
C========================================================================
	SUBROUTINE RDNAM(NAMREC,LUNN,QM,FCOR,CHFORM,CHNAME)
C========================================================================
C  READS DESIGNATED JCPDS CARD AND RETURNS NAME FILE INFORMATION
C    to replace READNAM
C--
C	Updated to read 64 byte records	BHT 7/88
C========================================================================
	INTEGER*4 NAMREC,LUNN
	CHARACTER*1 QM
	CHARACTER*(*) CHFORM,CHNAME
	REAL FCOR

	INTEGER JE,J,NBYTES,NLINES,NL,JB
	REAL FC

	BYTE BUFFER(405)
	INTEGER*2 LCHFORM,LCHNAME
	INTEGER*4 NREC

	CHFORM = ' '
	CHNAME = ' '
	FC = 0.0
	QM = ' '
C return with null values if there is no name record
	IF (NAMREC .le. 0) RETURN

	JE=55
	READ (LUNN,REC=NAMREC) LCHFORM,LCHNAME,QM,FCOR,(BUFFER(J),J=1,JE)
	NBYTES=9+LCHFORM+LCHNAME

C   How many more lines to read?
	NLINES=(NBYTES-1)/64
	NREC = NAMREC
	DO NL=1,NLINES
	  JB = JE+1
	  JE = JE+64
	  NREC=NREC+1
	  READ (LUNN,REC=NREC) (BUFFER(J),J=JB,JE)
	ENDDO

C copy names from the buffer array to the character strings
	LCHFORM = MIN(LCHFORM,LEN(CHFORM))
	WRITE(CHFORM,'(405A1)') (BUFFER(J),J=1,LCHFORM)
	LCHNAME = MIN(LCHNAME,LEN(CHNAME))
	WRITE(CHNAME,'(405A1)') (BUFFER(J+LCHFORM),J=1,LCHNAME)

	RETURN
	END
C========================================================================
	SUBROUTINE PDF1INIT(LUNM,LPDF,LUNn,*)
C========================================================================
C   Open the master index file -- replace in new code with PDF1OPEN
C--
	INTEGER LUNM, LPDF, LUNN
C	LUNM	LUN for index file
C	LPDF	LUN for DI dile
C	LUNN	LUN for Names file
C========================================================================
	INCLUDE 'JCPDS.PARMS'
	INTEGER NCRD,I

	OPEN (UNIT=LUNM,NAME='PS_JCPDS:JCPDS.INDEX',STATUS='old',
	1	READONLY,SHARED,FORM='UNFORMATTED',ACCESS='DIRECT',
	1	iostat=i)
	IF (I .ne. 0) then
	  type *,'ERROR opening JCPDS index file: PS_JCPDS:JCPDS.INDEX'
	  RETURN 1
	ENDIF
C   Open the D/I file
	OPEN (UNIT=LPDF,NAME='PS_JCPDS:DI.library',STATUS='OLD',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',RECL=32,
	1	SHARED,READONLY,iostat=i)
	IF (I .ne. 0) then
	  type *,'ERROR opening JCPDS index file: PS_JCPDS:DI.LIBRARY'
	  RETURN 1
	ENDIF
	READ (LPDF,rec=1) n_cards,N_Lwords,ncrd,N_sub,N_Regions,
     1                   N_ELEMC
       N_SETNO = ncrd / 10000

C   Open the NAMES file
	OPEN (UNIT=LUNn,NAME='PS_JCPDS:name.direct',STATUS='old',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',
	1	SHARED,READONLY,iostat=i)
	IF (I .ne. 0) then
	  type *,'ERROR opening JCPDS index file: PS_JCPDS:NAME.DIRECT'
	  RETURN 1
	ENDIF
	IF (N_REGIONS .GT. MAX_REGIONS) 
	1	STOP 'INITPDF1 ERROR - MAX_REGIONS exceeds N_REGIONS'

	RETURN
	END
C========================================================================
	SUBROUTINE PDF1OPEN(LUNM,LPDF,LUNN,STATUS)
C========================================================================
C   Open the master index file -- to replace PDF1INIT
C--
C	LUNM	LUN for index file
C	LPDF	LUN for DI dile
C	LUNN	LUN for Names file
C	STATUS	returned TRUE if open was successful, FALSE if error
C========================================================================
	INTEGER LUNM, LPDF, LUNN, STATUS
	INCLUDE 'JCPDS.PARMS'
	INTEGER NCRD,I

	STATUS = .FALSE.
	OPEN (UNIT=LUNM,NAME='PS_JCPDS:JCPDS.INDEX',STATUS='old',
	1	READONLY,SHARED,FORM='UNFORMATTED',ACCESS='DIRECT',
	1	iostat=i)
	IF (I .ne. 0) then
	  type *,'ERROR opening JCPDS index file: PS_JCPDS:JCPDS.INDEX'
	  RETURN
	ENDIF

C   Open the D/I file
	OPEN (UNIT=LPDF,NAME='PS_JCPDS:DI.library',STATUS='OLD',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',RECL=32,
	1	SHARED,READONLY,iostat=i)
	IF (I .ne. 0) then
	  type *,'ERROR opening JCPDS index file: PS_JCPDS:DI.LIBRARY'
	  RETURN
	ENDIF
	READ (LPDF,rec=1) n_cards,N_Lwords,ncrd,N_sub,N_Regions,
     1                   N_ELEMC
       N_SETNO = ncrd / 10000

C   Open the NAMES file
	OPEN (UNIT=LUNn,NAME='PS_JCPDS:name.direct',STATUS='old',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',
	1	SHARED,READONLY,iostat=i)
	IF (I .ne. 0) then
	  type *,'ERROR opening JCPDS index file: PS_JCPDS:NAME.DIRECT'
	  RETURN
	ENDIF

	IF (N_REGIONS .GT. MAX_REGIONS) 
	1	STOP 'INITPDF1 ERROR - MAX_REGIONS exceeds N_REGIONS'

	STATUS = .TRUE.
	RETURN
	END
C========================================================================
	SUBROUTINE CARDLOOK(ICARD,NAMREC,FULREC,DIREC,ISEQ,NCARDS,LUNM,
	1	STATUS)
C========================================================================
C Subroutine to look up a JCPDS card on the Master index from the
C Card and set number. -- to replace CARDLOC
C
C 	ICARD (input)	= 10000(set#) + card#
C	NAMREC (output)	record number of the first record in the NAMES file
C	FULREC (output)	record number of the first record in the FULL database
C	DIREC (output)	record number of the first record in the D/I file
C	ISEQ (output)	sequence number (record # in index file, bitmap #)
C	LUNM (input)	unit # of index file
C	STATUS (output) TRUE if entry was found, FALSE otherwise
C========================================================================
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	INTEGER*4 NCARDS,LUNM
	INTEGER*4 JCARD,JMIN,JMAX
	INTEGER   STATUS


	JMIN  = 0
	JMAX = NCARDS+1

	DO WHILE(jmin .lt. jmax-1)
	  iseq = (jmin + jmax)/2
	  READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC

C did we hit the right record?
	  IF (JCARD .EQ. ICARD) THEN
	    STATUS = .TRUE.
	    RETURN
C nope, try narrowing the range
	  ELSEIF (JCARD .LT. ICARD) THEN 
C JCARD is low, set the lower search limit to ISEQ
	    JMIN = ISEQ
	  ELSE
C JCARD is high, set the upper search limit to ISEQ
	    JMAX = ISEQ
	  ENDIF
C try again
	ENDDO
C not found -- signal an error and set ISEQ to the closest, higher value
	ISEQ = JMAX
	STATUS = .FALSE.
	RETURN
	END
C========================================================================
	SUBROUTINE CARDLOC(ICARD,NAMREC,FULREC,DIREC,ISEQ,NCARDS,LUNM,*)
C========================================================================
C Subroutine to look up a JCPDS card on the Master index from the
C Card and set number. 
C
C 	ICARD (input)	= 10000(set#) + card#
C	NAMREC (output)	record number of the first record in the NAMES file
C	FULREC (output)	record number of the first record in the FULL database
C	DIREC (output)	record number of the first record in the D/I file
C	ISEQ (output)	sequence number (record # in index file, bitmap #)
C	LUNM (input)	unit # of index file
C========================================================================
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	INTEGER*4 NCARDS,LUNM
	INTEGER*4 JCARD,JMIN,JMAX

	JMIN  = 0
	JMAX = NCARDS+1

	DO WHILE(jmin .lt. jmax-1)
	  iseq = (jmin + jmax)/2
	  READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC

C did we hit the right record?
	  IF (JCARD .EQ. ICARD) THEN
	    RETURN

C nope, try narrowing the range
	  ELSEIF (JCARD .LT. ICARD) THEN 
C JCARD is low, set the lower search limit to ISEQ
	    JMIN = ISEQ
	  ELSE
C JCARD is high, set the upper search limit to ISEQ
	    JMAX = ISEQ
	  ENDIF
C try again
	ENDDO
C not found -- signal an error and set ISEQ to the closest, higher value
	RETURN 1
	END
C========================================================================
	SUBROUTINE CARDLMIN(ICARD,NAMREC,FULREC,DIREC,ISEQ,NCARDS,LUNM,
	1	STATUS)
C========================================================================
C Subroutine to look up a JCPDS card on the Master index from the
C Card and set number. Returns the card, or the next lowest card
C
C 	ICARD (in/output)	= 10000(set#) + card#
C	NAMREC (output)	record number of the first record in the NAMES file
C	FULREC (output)	record number of the first record in the FULL database
C	DIREC (output)	record number of the first record in the D/I file
C	ISEQ (output)	sequence number (record # in index file, bitmap #)
C	LUNM (input)	unit # of index file
C	STATUS (output) TRUE if open was found, FALSE otherwise
C========================================================================
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	INTEGER*4 NCARDS,LUNM
	INTEGER*4 JCARD,JMIN,JMAX
	INTEGER   STATUS


	JMIN  = 0
	JMAX = NCARDS+1

	DO WHILE(jmin .lt. jmax-1)
	  iseq = (jmin + jmax)/2
	  READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC

C did we hit the right record?
	  IF (JCARD .EQ. ICARD) THEN
	    STATUS = .TRUE.
	    RETURN
C nope, try narrowing the range
	  ELSEIF (JCARD .LT. ICARD) THEN 
C JCARD is low, set the lower search limit to ISEQ
	    JMIN = ISEQ
	  ELSE
C JCARD is high, set the upper search limit to ISEQ
	    JMAX = ISEQ
	  ENDIF
C try again
	ENDDO
C not found -- signal an error and set ISEQ to the closest, lower value
	IF (JMIN .ne. 0) THEN
	  ISEQ = JMIN
	  READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC
	ENDIF
	icard = jcard
	STATUS = .FALSE.
	RETURN
	END
C========================================================================
	SUBROUTINE CARDLMAX(ICARD,NAMREC,FULREC,DIREC,ISEQ,NCARDS,LUNM,
	1	STATUS)
C========================================================================
C Subroutine to look up a JCPDS card on the Master index from the
C Card and set number. Returns the card, or the next lowest card
C
C 	ICARD (in/output)	= 10000(set#) + card#
C	NAMREC (output)	record number of the first record in the NAMES file
C	FULREC (output)	record number of the first record in the FULL database
C	DIREC (output)	record number of the first record in the D/I file
C	ISEQ (output)	sequence number (record # in index file, bitmap #)
C	LUNM (input)	unit # of index file
C	STATUS (output) TRUE if open was found, FALSE otherwise
C========================================================================
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	INTEGER*4 NCARDS,LUNM
	INTEGER*4 JCARD,JMIN,JMAX
	INTEGER   STATUS


	JMIN  = 0
	JMAX = NCARDS+1

	DO WHILE(jmin .lt. jmax-1)
	  iseq = (jmin + jmax)/2
	  READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC

C did we hit the right record?
	  IF (JCARD .EQ. ICARD) THEN
	    STATUS = .TRUE.
	    RETURN
C nope, try narrowing the range
	  ELSEIF (JCARD .LT. ICARD) THEN 
C JCARD is low, set the lower search limit to ISEQ
	    JMIN = ISEQ
	  ELSE
C JCARD is high, set the upper search limit to ISEQ
	    JMAX = ISEQ
	  ENDIF
C try again
	ENDDO
C not found -- signal an error and set ISEQ to the closest, higher entry
	IF (JMAX .ne. NCARDS) THEN
	  ISEQ = JMAX
	  READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC
	ENDIF
	icard = jcard
	STATUS = .FALSE.
	RETURN
	END
