     	SUBROUTINE WRWRIG
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  JUNE-1987
C
C	THIS ROUTINE WRITES OUT A RIGAKU RAW DATA FILE
C	FROM THE COMMON BLOCKS
c
c	Updated to write unformatted Rigaku raw data files.
c	Martin McMillan			EASTMAN KODAK CO.
c			   Institute for Advanced X-ray Studies: 
c	March 10,1988


     	INCLUDE 'FILECONV.CBS'
	character ans*4,time*8,date*12
	integer*2 nnpts

     	CLOSE( UNIT=IOUT )

c	old stuff

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
c     	INCLUDE 'FILECONV.CBS'
c     	INTEGER*2 ITIT(40)
c     	EQUIVALENCE (ITIT,SLID)
c
c     	CLOSE( UNIT=IOUT )
c     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
c     	1 FORM='FORMATTED', ERR=888 )
cC
cC  WRITE THE FILE HEADER INFORMATION...
cC
c     	WRITE(IOUT,1,ERR=888) FILOUT
c1	FORMAT(A32)
c     	WRITE(IOUT,2,ERR=888) ITIT
c2	FORMAT(1X,40A2)
c     	WRITE(IOUT,3,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10)
c3	FORMAT(1X,F7.3)
c     	WRITE(IOUT,4,ERR=888) WAVE(IELE,3)
c4	FORMAT(1X,F8.5)
c     	WRITE(IOUT,2,ERR=888) NPTS
c5	FORMAT(1X,I5)
cC
cC  WRITE THE INTENSITY DATA...
cC
c     	DO I=1, NPTS
c     	   WRITE(IOUT,6,ERR=888) YOBS(I)
c6	FORMAT(1X,F8.1)
c     	ENDDO
c     	GOTO 999
c
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

c
c	update: March 10,1988
c
     	OPEN( UNIT=IOUT, FILE=FILOUT, ACCESS ='DIRECT', STATUS='NEW',
     	1 FORM='UNFORMATTED', RECL=1, ERR=777 )

C
C  WRITE THE FILE HEADER INFORMATION...
C

	write(iout,rec=1,err=777)'.RAW'
	call coddat(date(1:9),datm)
	call codtim(time,timm)
	write(iout,rec=2,err=777)date(1:4)
	write(iout,rec=3,err=777)date(5:8)
	write(iout,rec=4,err=777)date(9:12)
	write(iout,rec=5,err=777)time(1:4)
	write(iout,rec=6,err=777)time(5:8)

	do i=1,10
		write(iout,rec=6+i,err=777)slid(i)
	enddo

	junk=2
	if(slid(11).eq.' R  ')junk=1
	write(iout,rec=17,err=777)junk

	if(scan.eq.'C')junk=1
	if(scan.eq.'S')junk=2
	write(iout,rec=18,err=777)junk

	junk=1
	if(slid(12).eq.'Stnd')junk=1
	if(slid(12).eq.'Int ')junk=2
	if(slid(12).eq.'Skip')junk=3
	write(iout,rec=19,err=777)junk

	decode(4,1000,slid(13))junk
	write(iout,rec=20,err=777)junk

	write(iout,rec=21,err=777)dang(2)

c	decode(4,1000,slid(15))junk
c	write(iout,rec=23,err=777)junk

c	decode(4,1000,slid(17))junk
c	write(iout,rec=24,err=777)junk

	if(iele.eq.1)then
		ans(1:2)='Cr'
	else if(iele.eq.2)then
		ans(1:2)='Fe'
	else if(iele.eq.3)then
		ans(1:2)='Co'
	else if(iele.eq.4)then
		ans(1:2)='Cu'
	else if(iele.eq.5)then
		ans(1:2)='Mo'
	else
		ans(1:2)='US'
	end if

	write(iout,rec=25,err=777)ans(1:2)

	if(iele.eq.6)then
		write(iout,rec=31,err=777)wave(3,iele)
		write(iout,rec=32,err=777)wave(1,iele)
		write(iout,rec=33,err=777)wave(2,iele)
		write(iout,rec=34,err=777)wave(4,iele)
	endif

	write(iout,rec=35,err=777)dang(1)
	write(iout,rec=36,err=777)dang(3)
	nnpts=npts
	if(mpro.eq.1)mpro=1
	if(mpro.eq.4)mpro=2
	if(mpro.eq.3)mpro=3
	if(mpro.ne.1.or.mpro.ne.4.or.mpro.ne.3)mpro=1
	write(iout,rec=37,err=777)nnpts,mpro
	write(iout,rec=38,err=777)dang(10)
	write(iout,rec=44,err=777)dang(4)
	write(iout,rec=45,err=777)npts
	

C
C  WRITE THE INTENSITY DATA...
C
	do i=1,npts
		write(iout,rec=50+i,err=777)yobs(i)
	enddo
	goto 999

C

c	old stuff retained:

777	IERR = 1
999	RETURN
1000	format(i4)
     	END
