     	SUBROUTINE WDI05A
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE WRITES OUT A DIFFRAC-5 (ALFRED) DIFILE
C	FROM THE COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	CHARACTER IQS*1, TEXT*9

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

     	IQS = ' '
C     	DO I=1, 7	!SKIP 7 LINES
C  WE ARE MAKING 6 TO GO ALONG WITH THE INDEXING .ADR FILES
     	DO I=1, 6	!SKIP 6 LINES
     	   WRITE(IOUT,1000,ERR=888) IQS
     	ENDDO
1000	FORMAT(A)
C
C  WRITE THE FILE HEADER INFORMATION...
C
     	WRITE(IOUT,1001,ERR=888) SLID
1001	FORMAT(13X,20A4)
     	CALL CODDAT( TEXT(1:9), DATM )
     	WRITE(IOUT,1002,ERR=888) TEXT(1:9)
1002	FORMAT(14X,A9)
     	WRITE(IOUT,1000,ERR=888) IQS	!SKIP 1 LINE
     	WRITE(IOUT,1003,ERR=888) DANG(1), DANG(10)
1003	FORMAT(17X,F9.4,4X,F7.2)
     	WRITE(IOUT,1003,ERR=888) DANG(2)
     	WRITE(IOUT,1003,ERR=888) DANG(3)
     	WRITE(IOUT,1000,ERR=888) IQS
     	WRITE(IOUT,1000,ERR=888) IQS
     	TEXT = 'PEAK'				!PEAK LIST ID
     	WRITE(IOUT,1000,ERR=888) TEXT(1:4)

     	DUMY = 0.0
     	DO I=1, NPKS
     	   IQS = ' '
     	   IF( PEAK(I).EQ.'KA2' ) IQS = '*'
     	   WRITE(IOUT,1100,ERR=888) I, F2TH(I), IQS, FDSP(I),
     	1  RELA(I), DUMY, AREA(I,JRES), FWHM(I)
     	ENDDO
1100	FORMAT(I3,F10.4,A1,F8.3,F8.2,10X,F6.4,F9.1,F9.4)

     	GOTO 999
888	IERR = 2
999	RETURN
     	END
