	SUBROUTINE RDDATA(STATUS,cflag)
	INTEGER STATUS
	LOGICAL cflag

	INTEGER IVAL(6)
	REAL FVAL(2)

	INTEGER CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,gotone
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED

	include 'cmpr.common'
	include '[-.shared]jcpds.parms'

	INTEGER LN, LN1, I, ic, iw, ilen, ip
	CHARACTER filename*80, string*40
	CHARACTER*1 QM
	REAL FCOR
	CHARACTER*35 dataform,peakform
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	INTEGER*4 CARDNO

	IF (MFILE .eq. M$FIL) THEN
	   WRITE (lo,'(A)') 'No more room for files'
	   goto 3
	ENDIF

	ln1 = 0
	IF (.not. cflag) GOTO 200
	GotOne = .false.
C----------------------------------------------------------------------
C Read peaks from the JCPDS-ICDD? 
	IF (.NOT. CLI$PRESENT('JCPDS')) GOTO 100
C is the database available?
	IF (.not. pdfstat) THEN
	  WRITE (lo,'(/2A/)') ' *** JCPDS-ICDD database is not ',
	1	'accessible -- ignoring READ/JCPDS command ***'
	  CALL PS_PAUSE(PROMPT)
	  GOTO 3
	ENDIF
C get a number
10	FLAG = GET_NUMBER('JCPDS',CARDNO)
	IF (MFILE .eq. M$FIL) THEN
	   WRITE (lo,'(A)') 'No more room for files'
	   goto 3
	ENDIF
	IF (FLAG .and. GotONE) goto 1
	IF (FLAG) goto 50

C is CARDNO a valid ICDD-JCPDS number?
	IF (CARDNO .le. 10000 .or. CARDNO/10000 .gt. N_SETNO) then
	  write (lo,'(A,i)')' Invalid ICDD-JCPDS entry number: ',cardno
	  CALL PS_PAUSE(PROMPT)
	  goto 10
	ELSE
C lookup a sequence number
	  CALL CARDLOOK(CARDNO,NAMREC,FULREC,DIREC,ISEQ,N_cards,LUNM,
	1	STATUS)
	  IF (.not. STATUS) THEN
	    write (lo,'(A,i6.6)')' ICDD-JCPDS entry not found: ',cardno
	    CALL PS_PAUSE(PROMPT)
	    goto 10
	  ENDIF
	ENDIF
C got a card, so read it into the peak arrays
	call RDPDF(mfile+1,CARDNO,DIREC,NAMREC,STATUS)
	IF (.not. STATUS) THEN
	  write (lo,'(A,i6.6)')' Error loading ICDD-JCPDS entry: ',cardno
	  CALL PS_PAUSE(PROMPT)
	  goto 10
	ENDIF
	mfile = mfile + 1
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	call setattr(1, MFILE, IVAL, FVAL, .true., DEFAULT, .true.)
C card was loaded
	gotone = .true.
	goto 10

50	IF (MFILE .eq. M$FIL) THEN
	   WRITE (lo,'(A)') 'No more room for files'
	   goto 3
	ENDIF
	WRITE(lo,'(a)') ' ',
	1	' Enter one ICDD-JCPDS entry number per line as'//
	1	' a 5-6 digit ',' number (set#*10000+entry#)'//
	1	' or as 2 numbers (set#, entry#). ',
	2	' Or a blank line to exit.'
51	WRITE(lo,'(a)') '$NUMBER> '
	READ(li,'(2i6)',END=3,err=51) CARDNO,j
	if (j .gt. 0) cardno = cardno*10000 + j
	IF (CARDNO .eq. 0) GOTO 1
C is CARDNO a valid ICDD-JCPDS number?
	IF (CARDNO .le. 10000 .or. CARDNO/10000 .gt. N_SETNO) then
	  write (lo,'(A,i)') ' Invalid ICDD-JCPDS entry number: ',
	1	cardno
	  goto 51
	ELSE
C lookup a sequence number
	  CALL CARDLOOK(CARDNO,NAMREC,FULREC,DIREC,ISEQ,N_cards,LUNM,
	1	STATUS)
	  IF (.not. STATUS) THEN
	    write (lo,'(A,i6.6)')' ICDD-JCPDS entry not found: ',cardno
	    CALL PS_PAUSE(PROMPT)
	    goto 10
	  ENDIF
	ENDIF
C show the name
	CALL RDNAM(NAMREC,LUNN,QM,FCOR,dataform,peakform)
	WRITE (lo,'(4a)') ' Entry: ',dataform(:lench(dataform)),' / ',
	1	peakform(:lench(peakform))
	WRITE (lo,'(a)') '$Load? ([Y]/N): '
	READ (li,'(A1)',end=3) ians
	IF (ians .eq. 'N' .or. ians .eq. 'n') goto 51
C got a card, so read it into the peak arrays
	call RDPDF(mfile+1,CARDNO,DIREC,NAMREC,STATUS)
	IF (.not. STATUS) THEN
	  write (lo,'(A,i6.6)')' Error loading ICDD-JCPDS entry: ',cardno
	  CALL PS_PAUSE(PROMPT)
	  goto 10
	ENDIF
	mfile = mfile + 1
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	call setattr(1, MFILE, IVAL, FVAL, .true., DEFAULT, .true.)
C card was loaded
	gotone = .true.
	goto 50
C----------------------------------------------------------------------
100	ln1 = 0
C get the format
	IF (CLI$PRESENT('FORMAT')) 
	1	STATUS = CLI$GET_VALUE('FORMAT',string,ln1)
	STATUS = CLI$GET_VALUE('filename',filename,ln)
	if ((.not. STATUS) .or. ln .le. 0) GOTO 200
	DO I=MFILE+1,M$FIL
C try to read data & peaks 
25	  IF (ln1 .gt. 1) filename = filename(:lench(filename))
	1	// '/' //string
	  call READDATA(filename,I,STATUS,.true.,.true.,
	1	dataform,peakform,.FALSE.)
	  IF (npoint(I) .gt. 0) then
C data were read
	    ln = lench(cfilnam(I))
	    cfilnam(I) = cfilnam(I)(:ln) // '/FORM=' //dataform
	  ELSEif (NPKS(I) .gt. 0) THEN
C peaks only were read
	    ln = lench(filename)
	    cfilnam(I) = filename(:ln) // '/FORM=' //peakform
	  ELSE
C nothing was read
	    WRITE(LO,'(1x,2a,i2,3a)') 7,'ERROR IN OPENING FILE#',i,
	1	': ',filename(:ln)
C try the next file
	    STATUS = CLI$GET_VALUE('filename',filename,ln)
	    if (.NOT. STATUS .or. ln .le. 0) GOTO 3
	    call ps_pause(prompt)
	    goto 25
	  ENDIF
	  MFILE = I
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	  call setattr(1, MFILE, IVAL, FVAL, .true., DEFAULT, .true.)
C try the next file
	  STATUS = CLI$GET_VALUE('filename',filename,ln)
	  if (.not. STATUS .or. ln .le. 0) goto 1
	ENDDO
	goto 1
C----------------------------------------------------------------------
C---- read with prompted input
200	FLAG = .true.
	DO I=MFILE+1,M$FIL
207	  IF (ln1 .gt. 1 .and. PDFSTAT) THEN
	    WRITE(LO,'(/A,i2,3A)') '$Enter filename or PDF # for file #'
	1	,i,'(FORMAT=',string(:ln1),'): '
	  ELSEIF (PDFSTAT) THEN
	    WRITE(LO,'(/A,i2,A)') '$Enter filename or PDF # for file #'
	1	,i,' (?=help): '
	  ELSE
	    WRITE(LO,'(/A,i2,A)') '$Enter filename for file #'
	1	,i,' (?=help): '
	  ENDIF
	  READ (LI,'(A)',err=3) filename
	  ln = lench(filename)
	  IF (ln .le. 0 .and. FLAG) goto 3
	  IF (ln .le. 0) goto 1
C is this a help request?
	  IF (filename .eq. '?') THEN
	    CALL TERASE(ICRT,lo,li)
	    call help('READ PARAM','cmpr_hlp',prompt)
	    goto 207
	  ENDIF
C is this a wild card request?
	  do J=1,ln
	    if (filename(J:J) .eq. '*' .or. filename(J:J) .eq. '%') THEN
	      call lib$spawn('$ directory/nosiz/bri/notra '
	1	//filename(1:ln))
	      goto 207
	    ENDIF
	  enddo
C try to read as JCPDS entry
	  IF (.not. PDFSTAT) goto 210
	  READ(filename(:ln),'(2i6)',err=210) CARDNO,j
	  if (j .gt. 0) cardno = cardno*10000 + j
	  IF (CARDNO .eq. 0) GOTO 210
C is CARDNO a valid ICDD-JCPDS number?
	  IF (CARDNO .le. 10000 .or. CARDNO/10000 .gt. N_SETNO) then
	    write (lo,'(A,i)') ' Invalid ICDD-JCPDS entry number: ',
	1	cardno
	    goto 210
	  ELSE
C lookup a sequence number
	    CALL CARDLOOK(CARDNO,NAMREC,FULREC,DIREC,ISEQ,N_cards,LUNM,
	1	STATUS)
	    IF (.not. STATUS) THEN
	      write (lo,'(A,i6.6)')' ICDD-JCPDS entry not found: ',cardno
	      goto 210
	    ENDIF
	  ENDIF
C show the name
	  CALL RDNAM(NAMREC,LUNN,QM,FCOR,dataform,peakform)
	  WRITE (lo,'(a,i6.6,4a)') ' Entry [',cardno,']: ',
	1	dataform(:lench(dataform)),' / ',
	1	peakform(:lench(peakform))
	  WRITE (lo,'(a)') '$Load? ([Y]/N): '
	  READ (li,'(A1)',end=3) ians
	  IF (ians .eq. 'N' .or. ians .eq. 'n') goto 207
C got a card, so read it into the peak arrays
	  call RDPDF(mfile+1,CARDNO,DIREC,NAMREC,STATUS)
	  IF (.not. STATUS) THEN
	    write (lo,'(A,i6.6)')' Error loading ICDD-JCPDS entry: ',cardno
	    CALL PS_PAUSE(PROMPT)
	    goto 207
	  ENDIF
	  mfile = mfile + 1
	  goto 250
C try to read data & peaks 
210	  IF (ln1 .gt. 1) filename = filename(:lench(filename))
	1	// '/' //string
	  call READDATA(filename,I,STATUS,.true.,.true.,
	1	dataform,peakform,.FALSE.)
	  IF (npoint(I) .gt. 0) then
C data were read
	    ln = lench(cfilnam(I))
	    cfilnam(I) = cfilnam(I)(:ln) // '/FORM=' //dataform
	  ELSEif (NPKS(I) .gt. 0) THEN
C peaks only were read
	    ln = lench(filename)
	    cfilnam(I) = filename(:ln) // '/FORM=' //peakform
	  ELSE
C nothing was read
	    WRITE(LO,'(1x,2a,i2,3a)') 7,'ERROR IN OPENING FILE#',i,
	1	': ',filename(:ln)
	    goto 207
	  ENDIF
	  MFILE = I
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL, FVAL
250	  call setattr(1, MFILE, IVAL, FVAL, .true., DEFAULT, .true.)
	  FLAG = .FALSE.
	ENDDO
C----------------------------------------------------------------------
1	STATUS = .true.
	RETURN
3	STATUS = .false.
	RETURN
	END
C========================================================================
	SUBROUTINE RDPDF(nfil,CARDNO,DIREC,NAMREC,STATUS)
	INTEGER nfil,CARDNO,DIREC,NAMREC,STATUS

	include 'cmpr.common'
	include '[-.shared]flabel.common'
	include '[-.shared]jcpds.parms'

	CHARACTER*35 dataform,peakform
	INTEGER*2 INT(M$PKS)
	CHARACTER*1 QM
	REAL FCOR

	STATUS = .FALSE.
	
	IF (nfil .gt. M$FIL) THEN
	   WRITE (lo,'(A)') 'No more room for files'
	   RETURN
	ENDIF
	call READDI(DIREC,DSPACE(1,nfil),INT,NPKS(nfil),LPDF,0.0,m$pks)
        if (NPKS(nfil) .le. 0) return

	MONO(nfil) = .false.
	if (WAVE0 .gt. 0) then 
	  WAVE(nfil) = WAVE0
	  WKA1(nfil) = WAVE1
	  WKA2(nfil) = WAVE2
	  MONO(nfil) = .true.
	ELSE
	  CALL WAVEINQ(LO,LI,IRAD(nfil),WAVE(nfil),WKA1(nfil),WKA2(nfil)
	1	,*133)
133	  MONO(nfil) = .true.
	  WAVE(nfil) = WKA1(nfil)
	  WKA2(nfil) = WAVE(nfil)
	  MONO(nfil) = .true.
	ENDIF
	DO I=1, NPKS(nfil)
	  FINTEG(I,nfil) = 1.*INT(I)
	  PKHT(I,nfil) = 1.*INT(I)
	  TT(I,nfil) = DSPACE(I,nfil)
	  IF (wave(nfil) .gt. 0) 
	1	call dTOtt(DSPACE(I,nfil),TT(I,nfil),wave(nfil))
	ENDDO
C scale maximum relative intensity to 100.0
	ymax = PKHT(1,nfil)
	START(nfil) = TT(1,nfil)
	FINISH(nfil) = TT(1,nfil)
	DELTA(nfil) = 0.0
	do j=2,NPKS(nfil)
	  ymax = max(ymax,PKHT(J,nfil))
	  START(nfil) = MIN(TT(J,nfil),START(nfil))
	  FINISH(nfil) = MAX(TT(J,nfil),FINISH(nfil))
	enddo
	do j=1,NPKS(nfil)
	  RELINT(J,nfil) = 100. * PKHT(J,nfil) / ymax
	enddo

C save the name
	CALL RDNAM(NAMREC,LUNN,QM,FCOR,dataform,peakform)
	ATITLE(nfil) = ' JCPDS Entry: ' // dataform(:lench(dataform)) 
	1	// ' / ' // peakform(:lench(peakform))

	write (ofilnam(nfil),'(A,i6.6))') 'PDF_',CARDNO
	cfilnam(nfil) = ofilnam(nfil)
	FYTYP(nfil) = YTYP_norm
	FXTYP(nfil) = XTYP_D
	IF (wave(nfil) .gt. 0) FXTYP(nfil) = XTYP_TT

	write (LO,'(I5,A,i6.6)') NPKS(nfil),
	1	' Peaks read from JCPDS-ICDD entry ',CARDNO
	STATUS = .TRUE.
	RETURN
	END
