SUBROUTINE WDI011 C C PROGRAMMER: R.S. ZHOU C ALFRED UNIVERSITY FEB-1987 C C THIS ROUTINE WRITES OUT A DIFFRAC-11 DIFILE C FROM THE COMMON BLOCKS C INCLUDE 'FILECONV.CBS' CHARACTER DAY*12, TIM*8 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 WRITE(IOUT,REC= 1,ERR=888) SLID(1) WRITE(IOUT,REC= 2,ERR=888) SLID(2) WRITE(IOUT,REC= 3,ERR=888) SLID(3) WRITE(IOUT,REC= 4,ERR=888) SLID(4) CALL CODDAT( DAY, DATM ) WRITE(IOUT,REC= 5,ERR=888) DAY(1:4) WRITE(IOUT,REC= 6,ERR=888) DAY(5:8) WRITE(IOUT,REC= 7,ERR=888) DAY(9:12) CALL CODTIM( TIM, TIMM ) WRITE(IOUT,REC= 8,ERR=888) TIM(1:4) WRITE(IOUT,REC= 9,ERR=888) TIM(5:8) WRITE(IOUT,REC= 10,ERR=888) NAME(1) WRITE(IOUT,REC= 11,ERR=888) NAME(2) WRITE(IOUT,REC= 12,ERR=888) NAME(3) C C WRITE THE LINE MEASUREMENT BLOCK... C WRITE(IOUT,REC= 13,ERR=888) DANG(1) WRITE(IOUT,REC= 14,ERR=888) DANG(2) WRITE(IOUT,REC= 15,ERR=888) DANG(3) WRITE(IOUT,REC= 16,ERR=888) DANG(10) C C WRITE THE INSTRUMENTATION BLOCK... C IF( WAVE(1,IELE).EQ.0.0 ) IELE = 4 !ASSUME CU WRITE(IOUT,REC= 19,ERR=888) WAVE(1,IELE) WRITE(IOUT,REC= 21,ERR=888) NPKS C C WRITE THE DIFILE DATA BLOCK... C IREC = 40 DO I=1, NPKS WRITE(IOUT,REC= IREC+1,ERR=888) FDSP(I) C WRITE(IOUT,REC= IREC+2,ERR=888) AREA(I,1) WRITE(IOUT,REC= IREC+2,ERR=888) RELA(I) WRITE(IOUT,REC= IREC+3,ERR=888) FWHM(I) WRITE(IOUT,REC= IREC+4,ERR=888) AREA(I,2) IREC = IREC + 6 ENDDO GOTO 999 888 IERR = 1 999 RETURN END