SUBROUTINE WRWXRR C C PROGRAMMER: R.S. ZHOU C ALFRED UNIVERSITY FEB-1987 C C THIS ROUTINE WRITES OUT AN X-RAY RIETVELD RAW DATA FILE C FROM THE COMMON BLOCKS C INCLUDE 'FILECONV.CBS' CHARACTER IQS*1, DAY*9, TIM*8 CALL COLORS(1) CALL PUTEXT('Write the output file in (A)SCII or (B)INARY ', 1 49, 23, 1 ) READ(5,1000,ERR=777,END=777) IQS CALL COLORS(-1) CALL PUTEXT('Writing the output file... Please wait...',41,24,1) IF( IQS.EQ.'B' .OR. IQS.EQ.'b' ) GOTO 111 C C WRITE OUT AN ASCII FILE... C CLOSE( UNIT=IOUT ) OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', ERR=888, 1 FORM='FORMATTED', CARRIAGECONTROL='LIST' ) WRITE(IOUT,1000,ERR=888) SLID 1000 FORMAT(20A4) CALL CODDAT( DAY, DATM ) CALL CODTIM( TIM, TIMM ) WRITE(IOUT,1001,ERR=888) DAY, TIM 1001 FORMAT(A9,A8) WRITE(IOUT,1002,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10) 1002 FORMAT(4F10.4) WRITE(IOUT,1003,ERR=888) (YOBS(I), I=1, NPTS) 1003 FORMAT(10F7.0) GOTO 999 C C WRITE OUT A BINARY FILE... C 111 CLOSE( UNIT=IOUT ) OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', 1 FORM='UNFORMATTED', ERR=888 ) IQS = ' ' WRITE(IOUT,ERR=888) SLID CALL CODDAT( DAY, DATM ) CALL CODTIM( TIM, TIMM ) WRITE(IOUT,ERR=888) DAY, TIM WRITE(IOUT,ERR=888) DANG(1),DANG(2),DANG(3),DANG(10) NLINE = NPTS/10 IF( NLINE*10 .LT. NPTS ) NLINE = NLINE + 1 DO I=1, NLINE WRITE(IOUT,ERR=888) (YOBS(J), J=1+(I-1)*10, I*10) ENDDO GOTO 999 777 IERR = 3 !BAIL OUT GOTO 999 888 IERR = 1 999 RETURN END