C----------------------------------------------------------------------
	SUBROUTINE READX7A(dname,pname,filform,nfil,STATUS)
C----------------------------------------------------------------------
C Read in file in BNL X7A format
C----------------------------------------------------------------------
	LOGICAL status
	INTEGER nfil
	character*(*) dname,pname,filform
	CHARACTER*6 thisform/'BNLX7A'/

	real OUTIM,aux(16)

	include 'shared$common'
	include '[-.shared]flabel.common'
	CHARACTER*3 month,monlst(12)/'JAN','FEB','MAR','APR','MAY','JUN',
	1	'JUL','AUG','SEP','OCT','NOV','DEC'/
C
!	logical flag,QTOTT,TTTOQ,DTOTT,TTTOD
	Character*80 line*250,str1*4,str2*4
	CHARACTER*80 cardn(5)
	CHARACTER timbuf*8,datbuf*9
	CHARACTER*15 unit*10,lbl(15)
	INTEGER naux,ich,imon
	LOGICAL exist,convrt
	INTEGER STAT
	REAL xtmp(M$pts)
C (xtmp is used for temporary storage)

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 Is there a datafile name?
	IF (dname .eq. ' ')  RETURN
C   First, Does the file exist?
	INQUIRE(FILE=dname,EXIST=exist,NAME=cfilnam(nfil),
	1	defaultfile='.X7A')
	IF (.not. exist) RETURN

	OPEN(UNIT=IN,FILE=cfilnam(nfil),TYPE='OLD',ERR=200,
	1	defaultfile='.X7A',FORM='FORMATTED',readonly,shared)

C Read the file header
	call RX7AHEAD(IN,lo,ANGI,ANGF,WVL,step,cnt,
	1	OSCENT,OSCANG,OSCSPD,cardn,timbuf,datbuf,line,
	1	.false.,STAT)
	IF (STAT .ne. 0) goto 200
C------------------------------------------------------------------------
C Reading of header went OK, file must be X7A
      write (lo,45) timbuf,datbuf
45    FORMAT(' Reading BNL-X7A file from ',A,', ',A)

	call CX7ACHAN(LINE,unit,lbl,naux,ich,imon,cardn,xscal)

	if (imon .eq. 0) then 
	  FYTYP(nfil) = YTYP_cps
	elseIF (xscal .eq. 0) THEN
	  FYTYP(nfil) = YTYP_scl
	else
	  FYTYP(nfil) = YTYP_100 
	endif

	NPNT = (angf-angi)/STEP + 1
	IF (NPNT .gt. m$pts) write(lo,'(A)') 
	1	' Warning -- not all points will be read'
	call RX7ADATA(in,ich,imon,0,npnt,m$pts,
	1	BX(1,nfil),xtmp(1),B(1,nfil),BESD(1,nfil),xscal)

C----------------------------------------------------------------------
C----------------------------------------------------------------------
	close(unit=IN)
	ATITLE(nfil) = cardn(1)
	IRAD(nfil) = 'SY'
C  Is this data in Q?
	IF (wvl .gt. 0) then 
	  FXTYP(nfil) = XTYP_Q 
	  tzero = 0.0
	ELSE
	  FXTYP(nfil) = XTYP_TT
C    get the wavelength if we don't have one
	  write (lo,'(A)') '$Enter the wavelength: '
	  READ (LI,'(f10.0)',err=200) WAVE(nfil)
	  WKA1(nfil) = WAVE(nfil) 
	  WKA2(nfil) = WAVE(nfil) 
	  write (lo,'(A)') '$Enter the zero correction (added to obs): '
	  READ (LI,'(f10.0)',err=200) tzero
	ENDIF
	IF (tzero .ne. 0) THEN
	  do i=1,npnt
	    BX(i,nfil) = BX(i,nfil) + tzero
	  ENDDO
	ENDIF
	START(nfil) = angi + tzero
	FINISH(nfil) = angf + tzero
	DELTA(nfil) = step + tzero
	INST(nfil)='X7'
	SOURCE(nfil)='BN'
	MONO(nfil)= .true.

	IF (npnt .le. 0) goto 200
	write (LO,'(A)') ' File '//cfilnam(nfil)(:lench(cfilnam(nfil)))
	1		//' read in BNL X7A format'
	read (datbuf,'(i2,1x,a3,1x,i2)',err=113) 
	1	DATE(2,nfil),month,DATE(3,nfil)
	date(1,nfil) = 0
	do i=1,12
	  if (month .eq. monlst(i)) date(1,nfil) = i
	enddo
113	NPOINT(nfil) = npnt
	filform = thisform
	STATUS = .true.
	RETURN
C----------------------------------------------------------------------------
!       IF (convrt) then
!	  FLAG = QTOTT(START(nfil),START(nfil),wvl)
!         FLAG = QTOTT(finish(nfil),finish(nfil),wvl)
!	  DELTA(nfil) = 0.0
!	ENDIF
!	xmin = MIN(angi,angf)
!	xmax = MAX(angi,angf)
!	IF (prompt) then 
!	  write (*,'(A,F10.3,A)') '$Enter xmin (default=',xmin,'): '
!	  read(*,'(q,f10.0)') i,x1
!	  if (i .ne. 0) xmin = x1
!	  write (*,'(A,F10.3,A)') '$Enter xmax (default=',xmax,'): '
!	  read(*,'(q,f10.0)') i,x1
!	  if (i .ne. 0) xmax = x1
!	ENDIF
C should the data be converted to 2theta values?
!	  if (wvl .gt. 0) convrt = .true.  ! yes
!	  IF (prompt) THEN
!	    write(lo,'(A)') '$Convert Q values to two-theta ([Y]/N): '
!	    read(lo,'(A)',err=91) ians
!	    if (ians .eq. 'N' .or. ians .eq. 'n') convrt = .false. ! don't convert
!	  ENDIF
!	ELSE
C----------------------------------------------------------------------------
200	close(unit=IN)
	RETURN
	END
C!*****************************************************************************
C   Subroutines to read X7A format data
C!*****************************************************************************
	SUBROUTINE RX7AHEAD(LIN,LPR,ANGI,ANGF,WAVE,step,cnt,
	1	OSCENT,OSCANG,OSCSPD,TITLE,timbuf,datbuf,header,
	1	echo,STATUS)
C------------------------------------------------------------------------
C Read the file header
C------------------------------------------------------------------------
	INTEGER LIN,LPR,STATUS
	LOGICAL echo
	REAL ANGI,ANGF,WAVE,step,cnt,OSCENT,OSCANG,OSCSPD
	CHARACTER*80 TITLE(5)
	CHARACTER header*250
	CHARACTER timbuf*8,datbuf*9
	CHARACTER*1 itype
	INTEGER I,LENCH
C------------------------------------------------------------------------
C assume failure
	STATUS = 1
C------------------------------------------------------------------------
      read (LIN,20,err=999) (TITLE(i),i=1,5)
20    FORMAT(A)
      IF (ECHO) write (lpr,'(1x,A)') 
	1	(TITLE(i)(:MAX(79,LENCH(TITLE(i)))),i=1,5)

      read(LIN,63,err=999) itype,ANGI,ANGF,WAVE
63    FORMAT(' INITIAL ',A1,T25,F10.3,/,
     1         ' FINAL Q',T25,F10.3,T45,'WAVELENGTH  ',f10.7)
      IF (WAVE .gt. 0. .and. ECHO) write(lpr,163) ANGI,ANGF,WAVE
163   FORMAT(' INITIAL Q',T25,F10.3,/,
     1         ' FINAL Q',T25,F10.3,T45,'WAVELENGTH  ',f10.7)
      IF (WAVE .eq. 0. .and. ECHO) write(lpr,263) ANGI,ANGF
263   FORMAT(' INITIAL ANGLE',T25,F10.3,/,
     1         ' FINAL ANGLE',T25,F10.3)

      read(LIN,42,err=999) step,cnt
42    FORMAT(' STEP SIZE',T25,F10.3,/,
     3         ' STEP COUNT TIME',T25,F10.3)
      IF (ECHO) write(LPR,42) step,cnt

      read(LIN,51,err=999) OSCENT,OSCANG,OSCSPD
      IF (ECHO) write(LPR,51) OSCENT,OSCANG,OSCSPD
51    FORMAT(' OSCILLATION CENTRAL ANGLE',T25,F10.3,/,
     5         ' OSCILLATION ANGLE',T25,F10.3,/,
     6         ' OSCILLATION SPEED',T25,F10.3)

      read(LIN,50,err=999) timbuf,datbuf
50    FORMAT('EXPERIMENT STARTED AT ',A,' ON ',A,/) 
      IF (ECHO) write (LPR,45) timbuf,datbuf
45    FORMAT(' Scan was started At ',A,' On ',A)

      read(LIN,'(A/)',err=999) header
C Signal success
	STATUS = 0
999	RETURN
	END
C!*****************************************************************************
	SUBROUTINE CX7ACHAN(LINE,unit,lbl,naux,ich,imon,TITLE,xscal)
C------------------------------------------------------------------------
C Select the channels to read
C------------------------------------------------------------------------
	INTEGER naux,ich,imon
	REAL XSCAL
	CHARACTER*(*) LINE
	CHARACTER*15 unit*10,lbl(15)
	CHARACTER*80 TITLE(5)

	INTEGER I
	CHARACTER lbl0*10
	REAL STDMON,CURRNG
C------------------------------------------------------------------------
	unit = line(1:10)
	lbl0 = line(11:20)
	naux = 0
	do i=1,15
	  lbl(i) = line(21+14*(i-1):20+14*i)
	  if (lbl(i) .eq. ' ') goto 10
	  naux = i
	enddo

10	write (*,'(A)') ' Detector assigments are: '
	do i=1,naux
	  write (*,'(i5,A)') i,lbl(i)
	enddo
	write (*,'(A)') '$Choose the channel to input [default=1]: '
	read(*,'(q,i10)',err=10,end=999) i,ich
	if (i .le. 0) ich = 1
	if (ich .le. 0 .or. ich .gt. naux) goto 10

	write (*,'(A)') 
	1  	'$Choose the channel for monitor correction '//
	1	'[default=0 (no correction)]: '
	read(*,'(q,i10)',err=10) i,imon
	IF (i .eq. 0) THEN
	  imon = 0
	ELSEif (imon .lt. 0 .or. imon .gt. naux) THEN
	  goto 10
	ENDIF

	IF (imon .gt. 0) THEN
C attempt to compute a monitor scale factor
	  stdmon = 0.
	  currng = 0.
	  READ(title(5),'(25x,f15.0,f10.0)',err=121) stdmon,currng
C** compute scale factor for data
121	  if (stdmon .le. 0. .or. currng .le. 0.) THEN
C  we do not have ring current, ask -- we need it!
115	    write (*,'(A)') '$Enter a monitor reading (cps): '
	    read (*,'(f10.0)',err=115,end=999) stdmon
	    IF (stdmon .le. 0) goto 115
	    write (*,'(A)') '$Enter beam current (mA) for above: '
	    read (*,'(f10.0)',err=115,end=999) currng
	    if (currng .le. 0.0 .or. stdmon .le. 0.0) goto 115
	    xscal = stdmon/currng*100.
	  ELSE
C  Ring current was found on file
	    write(*,143) stdmon,currng,stdmon/currng
143	    format('0Ring current information from this file: ',/,
     1	   ' MONITOR:',f11.2,' cps;  BEAM CURRENT:',f10.3,
     2     ' Ma',/,' SCALE FACTOR:',f10.1,' cps per mA',/)
	    xscal = stdmon/currng*100.
 	  endif
	endif
	RETURN
999	ICH = 0
	RETURN
	END
C!*****************************************************************************
	SUBROUTINE RX7ADATA(LIN,ICH,IMON,IOFF,NPTS,MAX_PNT,
	1	CURPOS,OUTIM,int,ESD,factor)
C------------------------------------------------------------------------
C Read the data points
C if IMON = 0 returns CPS in array INT
C if IMON > 0 returns counts/monitor relative to 100 mA (FACTOR = mon @ 100 mA)
C    or relative to the first monitor point, if FACTOR=0
C------------------------------------------------------------------------
	INTEGER LIN,ICH,IMON
	INTEGER IOFF,NPTS,MAX_PNT
	REAL CURPOS(MAX_PNT),OUTIM(MAX_PNT),int(MAX_PNT),ESD(MAX_PNT)
	REAL factor

	CHARACTER*14 aux(16)
	INTEGER NAUX,I,J
	REAL XMON
C------------------------------------------------------------------------
	NAUX = MAX(ICH,IMON)
	NPTS = IOFF
	do j=IOFF+1,max_pnt
201       read(lin,56,end=10,ERR=999) 
	1	CURPOS(NPTS+1),OUTIM(NPTS+1),(aux(i),i=1,naux)
56        FORMAT(2F10.3,15A14)
D	  write(56,*) curpos(NPTS+1),outim(NPTS+1),(aux(i),i=1,naux)
	  READ (aux(ich),'(F14.0)',ERR=999) int(NPTS+1)
	  ESD(NPTS+1) = SQRT(MAX(0.,int(NPTS+1)))
	  if (imon .ne. 0) then
	    READ (aux(IMON),'(F14.0)',ERR=999) XMON
	    IF (XMON .le. 0) THEN
		write (*,'(A,f10.3)') 
	1	' ERROR -- Monitor goes to 0 at ',curpos(j)
		goto 201
	    ENDIF
	    IF (FACTOR .EQ. 0) FACTOR = XMON
	    int(NPTS+1) = (int(NPTS+1) / XMON) * factor
	    ESD(NPTS+1) = (ESD(NPTS+1) / XMON) * factor
	  ELSE 
	    IF (outim(NPTS+1) .le. 0) THEN
		write (*,'(A,f10.3)') 
	1	' ERROR -- Count time goes to 0 at ',curpos(j)
		goto 201
	    ENDIF
	    int(NPTS+1) = (int(NPTS+1) / outim(NPTS+1))
	    ESD(NPTS+1) = (ESD(NPTS+1) / outim(NPTS+1))
	  ENDIF
	  NPTS = NPTS +1
	ENDDO
10	RETURN
999	WRITE(*,'(A,i8)') ' WARNING -- error reading file, NPTS=',NPTS
	RETURN
	END
