SUBROUTINE WRWSPP C C PROGRAMMER: R.S. ZHOU C ALFRED UNIVERSITY FEB-1987 C C THIS ROUTINE WRITES OUT A SPECPLOT RAW DATA FILE C FROM THE COMMON BLOCKS C INCLUDE 'FILECONV.CBS' INTEGER*2 SNUM, MONT, DATE, YEAR, ELEM, NPTT, INST(2) BYTE TITL(48) CHARACTER ANOD*2 EQUIVALENCE (TITL(1),SLID(1)) EQUIVALENCE (ELEM, ANOD) CLOSE( UNIT=IOUT ) OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', 1 FORM='UNFORMATTED', ERR=888 ) C C WRITE THE HEADER INFORMATION FIRST... C SNUM = 1 !???? JUNK1= INT(DATM*1.0E-4) JUNK2= INT(DATM*1.0E-2) - JUNK1*100 JUNK3= INT(DATM*1.0E-0) - JUNK1*10000 - JUNK2*100 DATE = JUNK1 MONT = (JUNK2-1)/3 + 1 YEAR = JUNK3 NPTT = NPTS ANOD = ANODE(IELE) WLEN = WAVE(1,IELE) INST(1) = 'DI' !ID FOR DIFFRACTION FILE WRITE(IOUT,ERR=888) SNUM, DATE, MONT, YEAR, INST, TITL, 1 DANG(1), DANG(3), DANG(10), ELEM, WLEN, DANG(2), NPTT C C WRITE OUT THE INTENSITY DATA --- 32 POINTS PER RECORD... C NLINE = NPTS/32 IF( NLINE*32 .LT. NPTS ) NLINE = NLINE + 1 YOBS(NPTS+1) = -999.0 !EOF FLAG DO I=1, NLINE WRITE(IOUT,ERR=888) (YOBS(J), J=1+32*(I-1), 32*I) ENDDO GOTO 999 888 IERR = 1 999 RETURN END