     	SUBROUTINE GRADAT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A BINARY DATA FILE FOR GRAFIT
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1
     	REAL*4 LAMDA
     	PARAMETER F4PI= 12.56636, F2PI = 6.28318

     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     	1 FORM='UNFORMATTED', ERR=888 )

     	IF( ITYI.NE.1 ) GOTO 111
C
C  WRITE OUT THE RAW PATTERN DATA...
C
     	IXTY = MODE
     	LAMDA = WAVE(1,IELE)
     	IF( LAMDA.EQ.0.0 ) LAMDA = WAVE(1,4)
C
C  PRESENT THE CONVERSION OPTIONS...
C
101	CALL CURSOR(18,1)
     	CALL CLEARS(2)
     	CALL COLORS(1)
     	WRITE(5,1000) IXTY+1
1000	FORMAT(' Output pattern could have one of the following',
     	1' types of X-axes:'/
     	19x' [1] TWO-THETA in degrees'/
     	19x' [2] d-spacing in angstroms'/
     	19x' [3] Q-spacing (Q = 2pi/d = 4pi*sin(theta)/lamda)'/
     	1'$Your choice <',I1,'> ')
     	READ(5,1001,ERR=101,END=777) IQS
1001	FORMAT(A)
     	IF( IQS.EQ.'1' ) IXTY = 1
     	IF( IQS.EQ.'2' ) IXTY = 2
     	IF( IQS.EQ.'3' ) IXTY = 3
     	IXTY = IXTY-1

     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)
C
C  CALCULATE THE X-AXIS VALUES...
C
     	DO I=1, NPTS
     	   XOBS(I) = DANG(1) + DANG(3)*(I-1)
     	ENDDO
     	IF( IXTY.NE.MODE ) THEN
     	    IF( MODE.EQ.0 ) THEN
     		IF( IXTY.EQ.1 ) THEN
     		DO I=1, NPTS		!TWO-THETA ---> D-SPACING
     		   XOBS(I)= 0.5*LAMDA / SIN(DTOR*XOBS(I))
     		ENDDO
     		ENDIF
     		IF( IXTY.EQ.2 ) THEN
     		DO I=1, NPTS		!TWO-THETA ---> Q-SPACING
     		   XOBS(I)= F4PI*SIN(DTOR*XOBS(I)) / LAMDA
     		ENDDO
     		ENDIF
     	    ENDIF
     	    IF( MODE.EQ.1 ) THEN
     		IF( IXTY.EQ.0 ) THEN
     		DO I=1, NPTS		!D-SPACING ---> TWO-THETA
     		   XOBS(I)= RTOD*ASIN(0.5*LAMDA/XOBS(I))
     		ENDDO
     		ENDIF
     		IF( IXTY.EQ.2 ) THEN
     		DO I=1, NPTS		!D-SPACING ---> Q-SPACING
     		   XOBS(I)= F2PI / XOBS(I)
     		ENDDO
     		ENDIF
     	    ENDIF
     	    IF( MODE.EQ.2 ) THEN
     		IF( IXTY.EQ.0 ) THEN
     		DO I=1, NPTS		!Q-SPACING ---> TWO-THETA
     		   XOBS(I)= RTOD*ASIN(LAMDA*XOBS(I)/F4PI)
     		ENDDO
     		ENDIF
     		IF( IXTY.EQ.1 ) THEN
     		DO I=1, NPTS		!Q-SPACING ---> D-SPACING
     		   XOBS(I)= F2PI / XOBS(I)
     		ENDDO
     		ENDIF
     	    ENDIF
     	ENDIF
C
C  WRITE OUT THE DATA SET...
C
     	ID = 0
     	WRITE(IOUT,ERR=888) NPTS, ID
     	WRITE(IOUT,ERR=888) ( XOBS(I), I=1, NPTS )
        IF(DANG(10).EQ.0) DANG(10)=1    !S.Z. AUG-18-93
     	WRITE(IOUT,ERR=888) ( YOBS(I)/DANG(10), I=1, NPTS )
     	GOTO 999

111	IF( ITYI.NE.2 ) GOTO 999
C
C  WRITE OUT THE PEAKS...
C
200	CALL CURSOR( 15, 1 )
     	CALL CLEARS( 2 )
     	CALL COLORS(1)
     	WRITE(6,2000)
2000	FORMAT(
     	1'       OUTPUT  X  TYPES',20X'OUTPUT  Y  TYPES'/,X,75('-')/
     	1'   [1] OBSERVED   TWO-THETA',12X,'[1] RELATIVE INTENSITY'/
     	1'   [2] CALIBRATED TWO-THETA',12X,'[2] INTEGRATED INTENSITY'/
     	1'   [3] OBSERVED   D-SPACING',12X,'[3] FWHM'/
     	1'   [4] CALIBRATED D-SPACING'/,X,75('-')//
     	1'$Enter option numbers (X,Y) <1,1> ')
     	READ(5,2001,ERR=200,END=777) IX, IY
2001	FORMAT(2I)
     	CALL COLORS(-1)
     	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)

     	IF( IX.LT.1 .OR. IX.GT.4 ) IX = 1
     	IF( IY.LT.1 .OR. IY.GT.3 ) IY = 1
     	ID = 0
     	WRITE(IOUT,ERR=888) NPKS, ID
     	IF( IX.EQ.1 ) WRITE(IOUT,ERR=888) (F2TH(I),I=1,NPKS)
     	IF( IX.EQ.2 ) WRITE(IOUT,ERR=888) (C2TH(I),I=1,NPKS)
     	IF( IX.EQ.3 ) WRITE(IOUT,ERR=888) (FDSP(I),I=1,NPKS)
     	IF( IX.EQ.4 ) WRITE(IOUT,ERR=888) (CDSP(I),I=1,NPKS)
     	IF( IY.EQ.1 ) WRITE(IOUT,ERR=888) (RELA(I),I=1,NPKS)
     	IF( IY.EQ.2 ) WRITE(IOUT,ERR=888) (AREA(I,JRES),I=1,NPKS)
     	IF( IY.EQ.3 ) WRITE(IOUT,ERR=888) (FWHM(I),I=1,NPKS)
     	GOTO 999

777	IERR = 3		!BAIL OUT
     	GOTO 999
888	IERR = 1		!ERROR DURING WRITE
999	RETURN
     	END
