C----------------------------------------------------------------------
	SUBROUTINE READPSU(dname,pname,filform,nfil,STATUS)
C----------------------------------------------------------------------
C Read in file in the PENN STATE package format
C
C----------------------------------------------------------------------
	LOGICAL status
	INTEGER nfil
	character*(*) dname,pname,filform
	CHARACTER*4 thisform/'PSU'/
	CHARACTER  temp*6

	include 'shared$common'
	include '[-.shared]flabel.common'
C
	Character*80 card1,card2
	LOGICAL exist

C Assume that the read was not successful
	STATUS = .false.

C check the file format qualifier, if one exists
	IF (filform .ne. ' ') THEN
	  I = LENCH(filform)
	  IF (filform(:I) .ne. thisform(:I)) RETURN
	ENDIF
C-------------------------------------------------------------------
C Is there a datafile name?
	IF (dname .eq. ' ') GOTO 201

C   First, Does the file exist?
	INQUIRE(FILE=dname,EXIST=exist,NAME=cfilnam(nfil),
	1	defaultfile='.asc')
	IF (.not. exist) goto 201

	OPEN(UNIT=IN,FILE=cfilnam(nfil),TYPE='OLD',ERR=201,
	1	FORM='FORMATTED',readonly,shared)

C----------------------------------------------------------------------
C  Read first & second cards
	read (IN,'(a)',err=111) ATITLE(nfil)
	read (in,'(4F10.0)',err=111) START(nfil),
	1		FINISH(nfil),DELTA(nfil),TIME(nfil)
	IF (DELTA(nfil) .eq. 0) goto 111
	npnt = (FINISH(nfil) - START(nfil))/DELTA(nfil)
	if (npnt .le. 0) goto 111
	if (TIME(nfil) .le. 0) goto 111
C----------------------------------------------------------------------
	IF (NPNT.gt.M$PTS) then
	  WRITE (LI,'(A,i6)') 
	1	' WARNING -- NUMBER OF DATA POINTS WILL BE LIMITED TO ',
	2	M$PTS
	  NPNT = M$PTS
	ENDIF
	READ (IN,'(10F8.0)',err=111) (B(i,nfil),I=1,npnt)
	INST(nfil) ='DI'
	SOURCE(nfil) = 'PH'
C the format has no wavelength, so ask for one
C	IRAD(nfil) = '  '
C	CALL WAVEINQ(LO,LI,IRAD(nfil),WAVE(nfil),WKA1(nfil),WKA2(nfil),*33)
C --or-- assume Cu K alpha 1-2 for convenience
	  IRAD(nfil) = 'CU'
	  CALL WAVESET(IRAD(nfil),WAVE(nfil),WKA1(nfil),WKA2(nfil),*33)
33	MONO(nfil)= WKA1(nfil) .eq. WKA2(nfil)
C set the date to now since we have no better choice
	CALL IDATE(DATE(1,nfil),DATE(2,nfil),DATE(3,nfil))

	DO i=1,npnt
	  besd(i,nfil) = sqrt(B(i,nfil))
	  bx(i,nfil) = START(nfil) + (I-1.)*DELTA(nfil)
	ENDDO
	NPOINT(nfil)=npnt
	FXTYP(nfil) = xtyp_tt
	FYTYP(nfil) = 1
	if (npnt .gt. 0) then
	  filform = thisform
C remove the file extension from the peak name, if one was specified
	  call remext(pname)
	  STATUS = .true.
	  write (LO,'(A)') ' File '//cfilnam(nfil)(:lench(cfilnam(nfil)))
	1		//' read in PSU ASCII data (.ASC) format'
	ENDIF
111	close(unit=IN)
C---------------------------------------------------------------------------
201	IF (pname .eq. ' ') RETURN
	INQUIRE(FILE=pname,EXIST=exist,defaultfile='.adr')
	IF (.not. exist) goto 211
	OPEN(UNIT=IN,FILE=pname,TYPE='OLD',ERR=211,FORM='FORMATTED'
	1	,readonly,shared,defaultfile='.adr')
C read through the file until we find 'PEAK ' or run out of lines
	READ(IN,'(A)',err=211) ATITLE(nfil)
!	IF (ATITLE(nfil)(1:5) .eq. 'PEAK ') goto 122
	IF (ATITLE(nfil)(1:4) .eq. 'PEAK') goto 122
121	READ(IN,'(A)',err=211) temp
!	IF (temp(1:5) .ne. 'PEAK ') goto 121
	IF (temp(1:4) .ne. 'PEAK') goto 121

C	
C if not set, set the wavelength to CU K alpha 1 for convenience
122	IF (WAVE(nfil) .le. 0) THEN
	  IRAD(nfil) = 'CU'
	  CALL WAVESET(IRAD(nfil),WAVE(nfil),WKA1(nfil),WKA2(nfil),*133)
133	  MONO(nfil) = .true.
	  WKA1(nfil) = WAVE(nfil)
	  WKA2(nfil) = WAVE(nfil)
	ENDIF
	do j=1,m$pks
	  READ (IN,'(14X,F8.0,2X,F3.0)',end=199,err=211)
	1	DSPACE(J,nfil),PKHT(J,nfil)
	  flag = dTOtt(DSPACE(J,nfil),TT(J,nfil),wave(nfil))
	  NPKS(nfil) = j
	ENDDO
199	ymax = PKHT(1,nfil)
	do j=2,NPKS(nfil)
	  ymax = max(ymax,PKHT(J,nfil))
	enddo
	do j=1,NPKS(nfil)
	  RELINT(J,nfil) = 100. 
	  IF (ymax .gt. 0) RELINT(J,nfil) = 100. * PKHT(J,nfil) / ymax
	  call dTOtt(DSPACE(J,nfil),TT(J,nfil),wave(nfil))
	enddo
	if (NPKS(nfil) .gt. 0) then
	  INQUIRE(UNIT=IN,NAME=pname)
	  filform = thisform
	  STATUS = .true.
	  write (LO,'(I5,A)') NPKS(nfil),
	1	' Peaks read from PSU file '//pname(:lench(pname))
	  IF (FYTYP(nfil) .eq. 0) FYTYP(nfil) = 1
	  IF (FXTYP(nfil) .eq. 0) FXTYP(nfil) = XTYP_TT
	ENDIF
211	close(unit=IN)
300	RETURN
	END
