     	SUBROUTINE WRW500
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-500 RAW DATA FILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	INTEGER*2 IDUM
     	CHARACTER IQS*1

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=1 )
C
C  WRITE THE FILE HEADER BLOCK...
C
     	IDUM = 1
     	ITYP = ITYI
     	NHDB = 5
     	ISBF = 6
     	LENG = 3*NSBR
     	DO I=1, NSBR
     	   IRPR(I,1) = 0
     	   IRPR(I,2) = 0
     	ENDDO
     	IRPR(1,1) = 73
     	IRPR(1,2) = 72
     	IRPR(3,1) = 42
     	IRPR(3,2) = 31
     	IRPR(4,1) = 145
     	IRPR(4,2) = 15
     	IRPR(6,1) = 163
     	IRPR(6,2) = NPTS
     	IRPR(10,1) = 160
     	IRPR(10,2) = 3
     	WRITE(IOUT,REC= 1,ERR=888) IDUM,ITYP
     	WRITE(IOUT,REC= 2,ERR=888) NHDB
     	WRITE(IOUT,REC= 3,ERR=888) ISBF
     	WRITE(IOUT,REC= 4,ERR=888) LENG
     	WRITE(IOUT,REC= 5,ERR=888) IDUM,IDUM
C
C  WRITE THE SPECIFICATION BLOCK REFERENCES...
C

C        TYPE 2,(I,IRPR(I,1),IRPR(I,2),I=1,LENG/3)
C2       FORMAT(3X,I3,3X,' REC=',I5,3X,'LENGHT='I5)
     	IREC = ISBF-1
     	DO I=1, LENG/3
     	   WRITE(IOUT,REC= IREC+1,ERR=888) IRPR(I,1)
     	   WRITE(IOUT,REC= IREC+2,ERR=888) IRPR(I,2)
     	   WRITE(IOUT,REC= IREC+3,ERR=888) IRLR(I)
     	   IREC = IREC + 3
     	ENDDO
C
C  WRITE THE INSTRUMENTATION BLOCK...
C
     	IREC = IRPR(1,1)-1
     	IDUM = 4
     	IQS = 'A'
     	IF( WAVE(1,IELE).EQ.0.0 ) IELE = 4		!ASSUME CU
     	WRITE(IOUT,REC= IREC+1,ERR=888) IDUM,IQS
     	IDUM = 1
     	WRITE(IOUT,REC= IREC+5,ERR=888) ANODE(IELE),IDUM
     	IREC = IREC + 5
     	DO I=1, 5
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) WAVE(I,IELE)
     	ENDDO
C
C  WRITE THE FILE DESCRIPTION BLOCK...
C
     	IREC = IRPR(3,1)-1
     	WRITE(IOUT,REC= IREC+1,ERR=888) NAME(1)
     	WRITE(IOUT,REC= IREC+2,ERR=888) NAME(2)
     	WRITE(IOUT,REC= IREC+3,ERR=888) NAME(3)
     	WRITE(IOUT,REC= IREC+4,ERR=888) DATM
     	WRITE(IOUT,REC= IREC+5,ERR=888) TIMM
     	WRITE(IOUT,REC= IREC+6,ERR=888) FTYP,MTYP
     	WRITE(IOUT,REC= IREC+7,ERR=888) DANG(4)/DANG(10)
     	WRITE(IOUT,REC= IREC+9,ERR=888) NREP,MPRO
     	WRITE(IOUT,REC= IREC+10,ERR=888) NRNG,SCAN
     	IREC = IREC + 15
     	WRITE(IOUT,REC= IREC,ERR=888) STYP
     	DO I=1, 15
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) SLID(I)
    	ENDDO
C
C  WRITE THE EXPERIMENTAL BLOCK ...
C
     	DUMY = 0.0
     	IREC = IRPR(10,1)-1
     	WRITE(IOUT,REC= IREC+1,ERR=888) DUMY
     	WRITE(IOUT,REC= IREC+2,ERR=888) DUMY
     	WRITE(IOUT,REC= IREC+3,ERR=888) DUMY
C
C  WRITE THE LINE MEASUREMENT BLOCK...
C
     	IREC = IRPR(4,1)-1
     	DO I=1, 14
     	   IREC = IREC + 1
     	   WRITE(IOUT,REC= IREC,ERR=888) DANG(I)
        ENDDO
C
C  WRITE THE INTENSITY DATA BLOCK...
C
     	IREC = IRPR(6,1)-1
     	DO I=1, NPTS
     	   IREC = IREC + 1
c           type*,I,YOBS(I)
     	   WRITE(IOUT,REC= IREC,ERR=888) YOBS(I)
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
