SUBROUTINE RLSNBS C C PROGRAMMER: R.S. ZHOU C ALFRED UNIVERSITY MAY-1987 C C THIS ROUTINE READS THE PEAK LIST SECTION FROM A NBS C RIETVELD OUTPUT FILE AND STORES IN THE COMMON BLOCKS C INCLUDE 'FILECONV.CBS' REAL*4 LAMDA CHARACTER TEXT*130 DIMENSION RP(10), KP(10) CLOSE( UNIT=IINP ) OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', 1 FORM='FORMATTED', READONLY, ERR=888 ) TEXT = ' ' C C SEARCH FOR RADIATION WAVELENGTH... C 10 READ(IINP,1000,ERR=777,END=666) TEXT(1:25) IF( TEXT.EQ.' ' ) GOTO 10 NCH = INDEX( TEXT(1:25), 'WAVELENGTH=' ) IF( NCH.EQ.0 ) GOTO 10 NCH = INDEX( TEXT(1:25), '=' ) TEXT = TEXT(NCH+1:) NCH = NALPHA( TEXT, 10 ) IF( NCH.GT.0 ) CALL COMMAS( TEXT,NCH,1,RP,KP,IDUM ) IF( NCH.EQ.0 ) GOTO 777 WAVE(1,IELE) = RP(1) C C SEARCH FOR THE BEGINNING OF PEAK LIST SECTION... C 100 READ(IINP,1000,ERR=777,END=666) TEXT(1:20) 1000 FORMAT(A) IF( TEXT.EQ.' ' ) GOTO 100 NCH = INDEX( TEXT(1:20), 'H K L' ) IF( NCH.EQ.0 ) GOTO 100 READ(IINP,1000,ERR=777,END=666) TEXT(1:1) !SKIP ONE LINE? C C READ THE PEAK LIST... C NPKS = 0 LAMDA = 0.5*WAVE(1,IELE) 200 READ(IINP,1001,ERR=777,END=999) TEXT 1001 FORMAT(2X,A) IF( TEXT.EQ.' ' ) GOTO 200 NCH = NBLANK( TEXT, 130 ) IF( NCH.GT.0 ) TEXT = TEXT(NCH+1:) NCH = NALPHA( TEXT, 130 ) CALL COMMAS( TEXT, NCH, 8, RP, KP, IDUM ) IF( NCH.EQ.0 ) GOTO 999 NPKS = NPKS + 1 PEAK(NPKS) = 'KA1' PHKL(1,NPKS) = RP(1) PHKL(2,NPKS) = RP(2) PHKL(3,NPKS) = RP(3) FWHM(NPKS) = 0.100 F2TH(NPKS) = 0.01*RP(4) C2TH(NPKS) = 0.01*RP(4) FDSP(NPKS) = LAMDA/SIN(DTOR*F2TH(NPKS)) CDSP(NPKS) = FDSP(NPKS) AREA(NPKS,JRES) = RP(8) IF( NPKS.EQ.MNK ) GOTO 999 GOTO 200 666 CALL COLORS(-1) CALL PUTEXT('ERROR: no peak list found in the input file.', 1 44, 24, 1 ) CALL PAUSES( 1 ) IERR = 3 GOTO 99 777 IERR = 1 GOTO 99 888 IERR = 2 GOTO 99 999 IF( NPKS.EQ.0 ) GOTO 666 C C CALCULATE THE RELATIVE INTENSITY... C DUMY = AREA(1,JRES) DO I=2, NPKS IF( AREA(I,JRES).GT.DUMY ) DUMY = AREA(I,JRES) ENDDO DO I=1, NPKS RELA(I) = 100.0*AREA(I,JRES)/DUMY ENDDO 99 RETURN END