SUBROUTINE RRW500 C C PROGRAMMER: R.S. ZHOU C ALFRED UNIVERSITY FEB-1987 C MODIFIED: JDW 4-JUL-89 TO READ A PSD FILE. C C THIS ROUTINE READS FROM A DIFFRAC-500 RAW DATA FILE C AND STORES IN THE CORRESPONDING COMMON BLOCKS C INCLUDE 'FILECONV.CBS' INTEGER*2 IDUM,DUMY DIMENSION NRNS(20) REAL*4 PSDANG CLOSE( UNIT=IINP ) OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', ERR=888, 1 ACCESS='DIRECT', RECL=1, READONLY ) C C READ THE FILE HEADER BLOCK... C READ(IINP,REC= 1,ERR=777) IDUM,ITYP IF( ITYP.NE.1 ) GOTO 777 READ(IINP,REC= 2,ERR=777) NHDB READ(IINP,REC= 3,ERR=777) ISBF READ(IINP,REC= 4,ERR=777) LENG READ(IINP,REC= 5,ERR=777) IDUM C IF( LENG.LT.3 ) GOTO 777 C C READ THE SPECIFICATION BLOCK REFERENCES... C IREC = ISBF DO I=1, LENG/3 C READ(IINP,REC= IREC ,ERR=777) IRPR(I,1) C READ(IINP,REC= IREC+1,ERR=777) IRPR(I,2) C READ(IINP,REC= IREC+2,ERR=777) IRLR(I) READ(IINP,REC= IREC ) IRPR(I,1) READ(IINP,REC= IREC+1) IRPR(I,2) READ(IINP,REC= IREC+2) IRLR(I) IREC = IREC + 3 ENDDO C C READ THE INSTRUMENTATION BLOCK... C IREC = IRPR(1,1) + 5 DO I=1, 5 !READ THE WAVE SOURCES READ(IINP,REC=IREC,ERR=777) WAVE(I,6) IREC = IREC + 1 ENDDO IF( WAVE(1,6).LE.0.0 ) GOTO 777 DO I=1, 5 IF( ABS(WAVE(1,6)-WAVE(1,I)).LT.0.001 ) IELE = I ENDDO READ(IINP,REC=IRPR(1,1)+22) PSDANG !JDW C C READ THE FILE DESCRIPTION BLOCK... C IREC = IRPR(3,1) READ(IINP,REC= IREC ,ERR=777) NAME(1) READ(IINP,REC= IREC+1,ERR=777) NAME(2) READ(IINP,REC= IREC+2,ERR=777) NAME(3) READ(IINP,REC= IREC+3,ERR=777) DATM READ(IINP,REC= IREC+4,ERR=777) TIMM READ(IINP,REC= IREC+5,ERR=777) FTYP,MTYP READ(IINP,REC= IREC+8,ERR=777) NREP,MPRO IF( NREP.LT.1 ) GOTO 777 READ(IINP,REC= IREC+9,ERR=777) NRNG,SCAN C IF( NRNG.LT.1 .OR. SCAN.NE.'S' ) GOTO 777 !JDW IF( NRNG.LT.1 ) GOTO 777 !JDW READ(IINP,REC= IREC+14,ERR=777) STYP IREC = IREC + 15 DO I=1, 15 READ(IINP,REC= IREC,ERR=777) SLID(I) IREC = IREC + 1 ENDDO C C READ THE LINE MEASUREMENT BLOCK... C IREC = IRPR(4,1) C C SHOW ALL THE RANGES... C IF( NRNG.GT.1 ) WRITE(6,2000) 2000 FORMAT(/' RANGE BEGIN ENDING STEP SECS MAXCOUNTS', 1' MAX2THETA MINCOUNTS MIN2THETA'/,X,80('-')) 2001 FORMAT(X,I3,2X,4(F7.3,X),X,2(G11.4,X,F8.3)) NPTS = 0 DO J=1, NRNG DO I=1, 14 READ(IINP,REC= IREC,ERR=777) BANG(I) IREC = IREC + 1 ENDDO IF(NRNG.GT.1)IREC = IREC + 1 !this line added 4/12/88 !by Martin McMillan C Fudge the count time in a PSD file. !JDW IF(SCAN.EQ.'C') BANG(10) = 60.0 * PSDANG / BANG(10) !JDW IF( BANG(3).LE.0.0 .OR. BANG(10).LE.0.0 ) GOTO 777 IF( NRNG.GT.1 ) WRITE(6,2001) J, BANG(1),BANG(2), 1 BANG(3),BANG(10),BANG(4),BANG(5),BANG(6),BANG(7) NRNS(J) = INT( (BANG(2)-BANG(1))/BANG(3)+0.5 ) + 1 NPTS = NPTS + NRNS(J) ENDDO IRNG = NRNG IF( NRNG.GT.1 ) THEN C C GET A SPECIFIC RANGE... C 2004 WRITE(6,2005) READ(5,1001,ERR=2004,END=2004) DUMY IF( DUMY.LT.1 .OR. DUMY.GT.NRNG ) DUMY = 1 IRNG = DUMY IREC = IRPR(4,1) + 15*(IRNG-1) !changed from ... + 14*(irng-1) !on 4/12/88 by Martin McMillan DO I=1, 14 READ(IINP,REC= IREC,ERR=777) BANG(I) IREC = IREC + 1 ENDDO 2005 FORMAT(/ 1' Only one range can be converted at a time.'/ 1'$Which range to use? <1> ') ENDIF C C READ THE INTENSITY DATA BLOCK... C IF( NREP.GT.1 ) THEN DUMY = LDIGIT( NREP ) 1002 WRITE(6,1000) NREP READ(5,1001,ERR=1002,END=1002) DUMY IF( DUMY.LT.1 .OR. DUMY.GT.NREP ) DUMY = 1 NREP = DUMY ENDIF 1000 FORMAT(/ 1' Input file contains ',I,' series of measurements'/ 1' but only one measurement can be converted at a time.'/ 1'$Which measurement to use? <1> ') 1001 FORMAT(I) IREC = IRPR(6,1) IREC = IREC + (NREP-1)*NPTS !JUMP TO THE MEASUEMENT NPTS = 0 DO I=1, IRNG-1 NPTS = NPTS + NRNS(I) ENDDO IREC = IREC + NPTS !JUMP TO THE RANGE NPTS = INT( (BANG(2)-BANG(1))/BANG(3)+0.5 ) + 1 DO I=1, NPTS READ(IINP,REC= IREC,ERR=777) YOBS(I) IREC = IREC + 1 ENDDO GOTO 999 777 IERR = 1 GOTO 999 888 IERR = 2 999 RETURN END