     	SUBROUTINE WDIRIG
C
C  PROGRAMMER:  R. L. SNYDER
C		ALFRED UNIVERSITY,  Jan-1988
C
C	THIS ROUTINE WRITES OUT A RIGAKU DIFILE FROM COMMON BLOCKS
C
     	INCLUDE 'FILECONV.CBS'
     	REAL*4 LAMDA
     	INTEGER*2 ITIT(40), HH, KK, LL
     	EQUIVALENCE (ITIT,SLID)
     	CHARACTER DAY*12, TIM*8, NEW(6)*4
     	DATA NEW(1)/'Cr  '/, NEW(2)/'Fe  '/, NEW(3)/'Co  '/,
     1 NEW(4)/'Cu  '/, NEW(5)/'Mo  '/, NEW(6)/'    '/ 
C
     	CLOSE( UNIT=IOUT )
     	OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888,
     	1 ACCESS='DIRECT', RECL=9 )
C
C  WRITE THE FILE FIRST 3 RECORDS 
C
     		CALL CODDAT( DAY, DATM )
     		CALL CODTIM( TIM, TIMM )
     	WRITE(IOUT,REC= 1,ERR=888) '.PKS', DAY(1:12), TIM(1:8)
     	WRITE(IOUT,REC= 2,ERR=888) (SLID(I),I=1,6)
     	WRITE(IOUT,REC= 3,ERR=888) (SLID(I),I=7,10)
C
C  WRITE THE LINE MEASUREMENT RECORD 4
C DMAX, DMIN, START, END, STEP, SCAN SPEED, COUNT TIME - REAL*4
C
     	A = 0.0
     	WRITE(IOUT,REC=4,ERR=888)A,A,DANG(1),DANG(2),DANG(3),A,DANG(10)
C
C  WRITE THE RADIATION 
C  EL SYM (A2), KA1, KA2, KB1, KBAR
C
     	WRITE(IOUT,REC= 5,ERR=888) NEW(IELE), WAVE(1,IELE), 
     1   WAVE(2,IELE), WAVE(4,IELE), WAVE(3,IELE) 
C
C  WRITE DUMMY RECORDS FOR 6 AND 7
C
     	WRITE(IOUT,REC=6,ERR=888)A,A,A,A,A,A,A,A,A
     	WRITE(IOUT,REC=7,ERR=888)A,A,A,A,A,A,A,A,A
C
C  WRITE THE DAT AND TIME AGAIN
C
     	WRITE(IOUT,REC= 8,ERR=888) DAY(1:12), TIM(1:8)
C
C  WRITE THE NUMBER OF PEAKS
C
     	WRITE(IOUT,REC=9,ERR=888) NPKS
C
C  WRITE THE D'S AND I'S
C
     	IREC = 9
     	DO I=1, NPKS
     	   WRITE(IOUT,REC= IREC+I,ERR=888) ' ', F2TH(I), FDSP(I),
     1        RELA(I), PHGH(I), FWHM(I)
     	ENDDO
     	GOTO 999
888	IERR = 1
999	RETURN
     	END
