C*********************************************************************
C
C  PROGRAM QUANT TO PROCESS RUN FILES CREATED BY RUNFIL AND
C  EXECUTED BY AUTO FOR INTERNAL STANDARD AND INTENSITY
C  RATIO QUANTITATIVE ANALYSIS
C
C          WRITTEN BY
C
C  R. L. SNYDER   NYS COLLEGE OF CERAMICS
C                 ALFRED UNIVERSITY
C                 ALFRED, NEW YORK
C
C and
C
C  C.R. HUBBARD   NATIONAL BUREAU OF STANDARDS
C                 A221 MATL
C                 WASHINGTON D.C. 20234
C
C
C  USES SUBROUTINE QNDATA WHICH CALLS AUTOLU, QUANRD AND NETINT
C
C*********************************************************************
C  RELATIVE INTENSITY VALUES FOR THE INTERNAL STANDARD METHOD
C  IF ENTERED, WILL BE USED TO SCALE ALL LINES FROM EACH
C  STANDARD TO THE 100% LINE.  THIS ALLOWS COMPARISON
C  OF THE STANDARD INTENSITY VALUES WITH ALL ON THE SAME
C  SCALE.  IF RELATIVE INTENSITY VALUES WERE NOT INPUT
C  TO PROGRAM AUTO THEN THEY ARE
C  COMPUTED FOR EACH LINE OF EACH STANDARD.
C
C
C  THE FOLLOWING PARAMETER STATMENT DEFINES THE DIMENSIONS FOR
C  THE QUANTATATIVE ANALYSIS SUBROUTINES.  TO REDIMENSION
C  SIMPLY CHANGE THIS STATMENT HERE AND IN EACH SUBROUTINE.
C      NF = THE NUMBER OF DATA FILES ALLOWED FOR INPUT
C      NR = THE MAXIMUM NUMBER OF REFLECTIONS WHICH CAN BE PROCESSED
C      NP = THE MAXIMUM NUMBER OF PHASES ALLOWED
C      NT = THE MAXIMUM NUMBER OF DATA POINTS FOR ANY REFLECTION
C      NS = THE MAXIMUM NUMBER OF LINES FOR THE STANDARD PHASE
C      NU = THE MAXIMUM NUMBER OF LINES FOR ALL UNKNOWN PHASES
C
	PARAMETER (NF=30, NR=100, NP=10, NT=1000, NS=5, NU=20)
	COMMON/IO/ IRD,ITYP,IPRT,ISCRT,ICOBRG,LIMPRT,IDBUG
	COMMON /FILE/ LU,ITYPE,IEND
	COMMON /FILEC/ NAME
	COMMON /RECRD1/ IFLAG(10)
	COMMON /RECR1C/ TITLE,DATE,TIME,RNFLNM
	COMMON /RECRD2/ XLAMBD,TAKEOF,DIVANG,RADIUS,SOLLIN,
     1 SOLLOT,RECSLT,DEADTM,STABIL,TBASE
	COMMON /RECR2C/ UNIT,TARGET,LINE,FOCAL,DIVSLT,MONOCH,DETECT
	COMMON /RECRD6/ XWT(10),SIG(10)
	COMMON /RECR6C/ ELEMNT(10)
	COMMON /RECRD8/ FRELOV(2),SRELOV(2),WTPCPH(8)
	COMMON /RECR8C/ NAMEOV(2),JKLOV(2),ELMTPH(8)
	COMMON/RECRD7/BANG,PANG,EANG,DANG,RATE,MVCNT,TIMLIM,FIXERR,
     * LIMCNT,KODE,IOVLP,IPK,NPK,NBG,FREL,STDREL,STD,SIGSTD,
     * WTPRCT,PKTIME,BKGTIM,IOPTIM,ILOC,CONSTD
	COMMON /RECR7C/ NAM,JKL
	COMMON/SVDAT1/ AINT(NR,NF),VINT(NR,NF),NREFL,IFILE
	COMMON/LABELS/ PHASE(NR),HKL(NR)
	COMMON/SVDAT2/ FRELS(NR),SRELS(NR),WT(NF),KODES(NR),STDS(NR),
     * SSTDS(NR),IOVS(NR),IPKS(NR),RELOV(2,NR),
     * RELOVS(2,NR), WTP(8,NR), CONC(NF), XMURHO(NR)
	COMMON /SVDA2C/ MAN(2,NR),KHL(2,NR),ELM(8,NR)
	COMMON/DATA/ PEAK,VPEAK,AREA,VAREA,XBKG,VBKG
	DIMENSION SUM(NU),NOV(NU),KIND(NR)
	DIMENSION COP(NP), JCOP(NP),AVS(NU),AVSS(NU),NAVS(NU)
	CHARACTER*6 PHASE,HKL,BL,ALL,EL6
	CHARACTER*100 TITLE
	CHARACTER*6 DATE,TIME,MAN,JKL,NAMEOV,JKLOV,NAM,KHL,RNFLNM
	CHARACTER*20 NAME
	CHARACTER*2 ELMTPH, ELM, ELEMNT
	CHARACTER*4 UNIT
	CHARACTER*2 TARGET,LINE,FOCAL,DIVSLT,MONOCH,DETECT
	CHARACTER*8 DAT, TIM
	CHARACTER*7 AVL
	CHARACTER*9 ESDHDG(2)
       CHARACTER FILNAM*40
	ESDHDG(1) = ' STANDARD'
	ESDHDG(2) = 'DEVIATION'
	DATA AVL/'Wt mean'/, BL/'      '/, ALL/'  all '/
C
C-----LOGICAL UNIT# ASSIGNMENTS
C     IRD IS FOR CRT TERMINAL INPUT OR CARD READER INPUT
C     ITYP IS FOR CRT TERMINAL OUTPUT (REQUESTING USER RESPONSES)
C     IPRT IS FOR 132 COLUMN PRINTER OUTPUT (FINAL RESULTS)
C     LU   IS FOR AUTO DATA FILE INPUT (OPENED BY QUANT82 ROUTINES)
C     ICOBRG IS FOR COPLAND-BRAGG BINARY FILE (SEE QUANT AND COBRAG)
C     ISCRT  IS FOR TEMPORARY SCRATCH FILE IN RUNFIL
C
	IRD  = 5
	ITYP = 5
	IPRT = 5
	LU    = 10
	ICOBRG= 30
	ISCRT = 40
C-----IDBUG = DEBUG PRINT CONTROL. =0 FOR OFF, =1 FOR ON
	IDBUG=0
C       IDBUG =1
	NRFL = 0
	CALL DATIM(DAT,TIM)
C
C-----PRINT PROGRAM HEADING
C
	WRITE(ITYP,10)DAT,TIM
10	FORMAT(/10X,'Program NBS*QUANT84-QUANT',5X,'Revision Date:',
     & ' 29 FEB 1984'/
     * /5X,'Quantitative Analysis by the Internal Standard or '
     * 'Intensity Ratio Methods'/
     * /17X,'Written by R. L. Snyder and C. R. Hubbard '/
     * /21X,'run on ',A8,5X,' at ',A8)
C
C  SELECT OUTPUT DESTINATION
C
        WRITE(ITYP,1)
1	FORMAT(/' Select Output Mode Desired:  (Output is 132 characte',
     1'rs wide)'/'       1 	- causes output to be put on the inter',
     2'active terminal.'/'       newname 	- causes output to go ',
     3'to the named file.'/'       <CR> 	- causes output to go ',
     4'to a file named QUANT.LIS.'/' Enter the output destination: '$)
       READ(IRD,2) FILNAM
2	FORMAT(A40)
       IF(FILNAM(1:1) .EQ. '1') GO TO 3
       IPRT = 6
       IF(FILNAM(1:1) .EQ. ' ') THEN
		OPEN(UNIT=IPRT,FILE='QUANT.LIS',STATUS='NEW',
     1 ACCESS='SEQUENTIAL',FORM='FORMATTED')
       		GO TO 3
       ENDIF
	OPEN(UNIT=IPRT,FILE=FILNAM,STATUS='NEW',ACCESS='SEQUENTIAL',
     1 FORM='FORMATTED')
C-----LIMPRT CONTROL RAW DATA FILE PRINTING AND HEADINGS
C           =0 FOR FULL LISTING
C           =1 FOR HEADING ON FIRST FILE ONLY
C           =2 FOR BRIEFEST RAW DATA LISTING (FILE TITLE ONLY)
3	IF(ITYP.NE.IPRT) WRITE(IPRT,10) DAT,TIM
	WRITE(ITYP,11)
11	FORMAT(/' Select a print control option (I1):'/
     & ' 0 = Full listing of data files'/
     & ' 1 = Heading on first data file only'/
     & ' 2 = Data file titles only')
	READ(IRD,12) LIMPRT
12	FORMAT(I1)
	IF(LIMPRT.LT.0 .OR. LIMPRT.GT.3) LIMPRT=0
C
C-----ALLOW FOR USE OF UNIT WEIGHTS OR COUNTING STATISTIC WEIGHTS
C-----IN FORMING AVERAGES OF WEIGHT FRACTION AND RMS DEVIATION
C
34	WRITE(ITYP,3020)
3020	FORMAT(/' Enter weighting choice:'/
     1       ' 0 for counting statistical weights'/
     2       ' 1 for unit weights')
	READ(IRD,*) IWT
	IF( IWT .NE.0 .AND. IWT .NE.1) THEN
	  WRITE(ITYP,3030) IWT
3030	FORMAT(/' Input option of ',i3,' not equal to 0 or 1')
	  GOTO 34
	ENDIF
	IF(IWT.EQ.1) THEN
	   ESDHDG(1) = '   UNIT  '
	   ESDHDG(2) = ' WEIGHT  '
	   AVL = '  MEAN '
	ENDIF
	WRITE(ITYP,13)
13	FORMAT(/' Input all data files collected for any one sample')
C
C-----READ RAW DATA AND DO PRELIMINARY PROCESSING INTO NET INTENSITY AND
C-----PEAK HEIGHTS.
C
	ITYPE=-2
	CALL QNDATA
	IF(IEND.EQ.1) GOTO 999
C********************************************************************
C-----BEGIN CALCULATION OF THE INDIVIDUAL INTENSITY RATIOS AND VARIANCES
C**********************************************************************
C
C  FIRST DETERMINE WHICH REFLECTIONS BELONG TO WHICH PHASE
C
	NUNK = 0
	L = 0
	DO 15 I=1,NREFL
15	KIND(I) = 0
	DO 30 I=1,NREFL
	IF(KODES(I).EQ.3)L=I
	IF(KODES(I).NE.1)GO TO 30
C
C  KIND(I) = 0 MEANS A STANDARD OR REFERENCE LINE
C          = 1 MEANS I IS A LINE FROM UNKNOWN #1
C          = N MEANS I IS A LINE FROM UNKNOWN #N (10 MAX)
C      L   = THE NUMBER OF THE REFERENCE LINE FOR INT. RATIO METHOD
C
C     NUMK IS THE NUMBER OF UNIQUE ANALYTE PHASES
C
C     JCOP IS A POINTER TO THE CORRESPONDING PHASE NAME
C
	IF(KIND(I).NE.0)GO TO 30
	NUNK = NUNK + 1
	DO 20 J=1,NREFL
	IF(PHASE(I).NE.PHASE(J))GO TO 20
	KIND(J) = NUNK
	JCOP(NUNK) = J
20	CONTINUE
30	CONTINUE
C
C  ZERO THE COMPOSITION ARRAYS
C
	DO 32 I=1,NU
	SUM(I) = 0.0
	NOV(I) = 0
	AVS(I) = 0.0
	AVSS(I) = 0.0
32	NAVS(I) = 0
C
C  IF THIS IS THE INTENSITY RATIO METHOD JUMP TO 1000
C
	IF(IFLAG(3).GT.1)GO TO 1000
C******************************************************************
C
C  ALL CODE FROM HERE TO 1000 IS FOR INTERNAL STANDARD METHOD
C
C*******************************************************************
	WRITE(ITYP,1900)
	IF(ITYP.NE.IPRT) WRITE(IPRT,1900)
1900	FORMAT(/' ',15X,'Internal Standard Analysis'/
     *       ' ',16X,'**Resolved lines only**')
C
C  ATTACH THE OUTPUT FILE FOR COPLAND BRAGG ANALYSIS ON LOGICAL UNIT= IC
C
36	WRITE(ITYP,1920)
1920	FORMAT(/' Input the 6 letter name of the Copland-Bragg',
     1' output file (blank=do not use)')
	READ(IRD,1940)NAME
1940	FORMAT(A20)
	IF(NAME.EQ.'      ') GOTO 38
	NAME(7:11) = '.COP '
	OPEN(UNIT=ICOBRG,FILE=NAME,ERR=37,STATUS='NEW',
     1 ACCESS='SEQUENTIAL',FORM='UNFORMATTED',IOSTAT=IOS)
	WRITE(ICOBRG)TITLE
C
C  WRITE THE NUMBER OF UNKNOWNS AND THEIR NAMES
C  ( JCOP CONTAINS THE INDEX OF THE LAST PHASE OF TYPE J)
C
	WRITE(ICOBRG)NUNK,(PHASE(JCOP(I)),I=1,NUNK)
	WRITE(IPRT,1960) NAME
1960	FORMAT(/' Copland-Bragg binary file name=',A11)
	GOTO 38
C
C-----ERROR ON OPENING FILE FOR COBRAG EQUATIONS
C
37	WRITE(ITYP,1970) NAME,IOS
1970	FORMAT(/' **Error** file name=',A11,' IOSTAT=',I10,
     * ' **try again**')
	GOTO 36
38	WRITE(IPRT,2000)
2000	FORMAT(/' ',15X,'Line by line composition analysis:')
C
C-----FIND THE NEXT REFERENCE REFLECTION
C
	NSTD=0
C
C  SET THE NOV FLAG IF ANY OVERLAPPED LINES ARE TO BE USED
C
	DO 45 I=1,NREFL
	IF(IOVS(I) - 1)45,41,44
C
C  CHECK IF THE OVERLAPPED PHASE BELONGS TO THE STANDARD
C
41	J=0
	DO 42 J=1,NREFL
	IF(KODES(J).EQ.2)GO TO 43
42	CONTINUE
43	IF(MAN(1,I).NE.PHASE(J))GO TO 44
C
C  THIS LINE WILL BE USED IN THE COMPUTATION
C
	NOV(I) = J
	GO TO 45
44	NOV(I) = -1
45	CONTINUE
	DO 300 I=1,NREFL
	IF(KODES(I).NE.2) GOTO 300
	IF(IOVS(I).EQ.0)GO TO 48
C
C  IF A STANDARD LINE IS ALSO OVERLAPPED BAIL OUT
C
	WRITE(ITYP,2050)PHASE(I),HKL(I)
	IF(ITYP.NE.IPRT) WRITE(IPRT,2050)PHASE(I),HKL(I)
2050	FORMAT(/' Standard line ',2A6,' is labled as overlapped',
     1/' if it is really overlapped you must call it an',
     2' unknown line not a standard!'/
     3' Change your input file and start over')
	CALL EXIT
C
C-----FOUND THE NEXT REFERENCE REFLECTION.  USE IT TO CALCULATE THE
C-----RIR FOR ALL COMBINATIONS OF THIS REFERENCE REFLECTION WITH UP TO
C-----NR-1    REFLECTIONS FROM THE "UNKNOWN"
C
48	NSTD=NSTD+1
	IF(NSTD.LE.NS) GOTO 50
	WRITE(ITYP,49)NS
	IF(ITYP.NE.IPRT) WRITE(IPRT,49)NS
49	FORMAT(/' # of reference lines exceeds array limits NS=',I3,
     *' skip the extra lines')
	NSTD=NSTD-1
	GOTO 300
C
C-----SELECT NEXT SAMPLE LINE
C
50	NRFL = 0
	DO 200 J=1,NREFL
	IF(KODES(J).NE.1) GOTO 200
C
C  SKIP ALL OVERLAPPED LINES EXCEPT THE CASE WHERE A SINGLE LINE
C  OVERLAPS A STANDARD LINE (THIS ONE CAN BE COMPUTED!)
C
	IF(NOV(J).GE.0)GO TO 55
	WRITE(IPRT,2055)PHASE(J),HKL(J)
2055	FORMAT(/' ',2A6,' overlapped line can be used only by program '
     * 'COBRAG')
C
C-----FOUND A SAMPLE REFLECTION.  NOW CALCULATE THE COMP FOR ALL OBSERVA
C-----OF THE PAIR (I,J). (IE FOR ALL FILES)
C
55	NRFL=NRFL+1
	IF(NRFL.LE.NU) GOTO 70
	WRITE(ITYP,60)NU
	IF(ITYP.NE.IPRT) WRITE(IPRT,60)NU
60	FORMAT(/' # of sample lines exceeds array limit NU=',I3,
     *' skip the extra lines')
	NRFL=NRFL-1
	GOTO 200
C
C  CALCULATE THE UNKNOWN COMPOSITION FROM EACH MEASURED LINE
C
70	DO 80 K=1,NP
80	COP(K) = 0.0
	IF(NOV(J).GE.0) WRITE(IPRT,2020) ESDHDG
2020	FORMAT(/' File Analyte  Line  Standard Line   Weight  ',
     1 A9,     ' Root MEAN  number of'/' ','  #   Phase  h k l   Name',
     1'   h k l  Fraction ', A9,  ' Square Dev. Measurments')
	IF(NOV(J). LE.0)GO TO 82
	WRITE(IPRT,2100)PHASE(J),HKL(J)
2100	FORMAT(6X,A6,1X,A6,' is overlapped')
82	S1 = 0.0
	S2 = 0.0
	S3 = 0.0
	DO 100 K=1,IFILE
C-----CALCULATE THE RATIO OF OBSERVED INTENSITIES AND VARIANCE
	RIOBS=AINT(J,K)/AINT(I,K)
	VRIOBS=RIOBS*RIOBS*(VINT(J,K)/(AINT(J,K)*AINT(J,K))+
     * VINT(I,K)/(AINT(I,K)*AINT(I,K)))
C
C  COMPUTE THE COPLAND-BRAGG MATRIX ELEMENTS
C  THE TERM (1-WT(K)) IS NECESSARY TO MAKE THE MATRIX COEFFICIENTS
C  RELATE TO THE WT% IN THE ORIGINAL SAMPLE
C
	WTCOR = 1.0-WT(K)
	COP(KIND(J)) = (FRELS(J)/FRELS(I)) * STDS(J) * WTCOR/WT(K)
	IF(NOV(J).EQ.0)GO TO 95
	DO 90 KK=1,IOVS(J)
	IF(NOV(J).LT.0)GO TO 84
	RIOBS = RIOBS - RELOV(KK,J) / FRELS(I)
C
C  FIND THE UNKNOWN NUMBER OF THIS OVERLAPPED LINE
C  (THE FOLLOWING IS TO AVOID THE ZERO FAULT LOOP WARNING)
C
84	IKIND = 0
	IK = 0
	DO 85 KKK=1,NR
	IF(MAN(KK,J).NE.PHASE(KKK))GO TO 85
	IKIND = KIND(KKK)
	IK = KKK
	GO TO 88
85	CONTINUE
	IF(NOV(J).LT.0)GO TO 88
	VRIOBS=RIOBS*RIOBS*(VINT(J,K)/(AINT(J,K)*AINT(J,K))+
     * VINT(I,K)/(AINT(I,K)*AINT(I,K)))
89	VRIOBS = VRIOBS + RIOBS*RIOBS*((RELOVS(1,J)*RELOVS(1,J))
     1 / (RELOV(1,J)*RELOV(1,J)))
88	COP(IKIND) = (RELOV(KK,J)/FRELS(I)) * STDS(IK) * WTCOR/WT(K)
90	CONTINUE
C
C  OUTPUT THE MATRIX ELEMENTS
C
95	IF(NAME.NE.'      ')WRITE(ICOBRG)(COP(KK),KK=1,NUNK),RIOBS,VRIOBS,
     *PHASE(J),HKL(J),MAN(1,J),KHL(1,J),MAN(2,J),KHL(2,J),
     *PHASE(I),HKL(I)
	IF(NOV(J).LT.0)GO TO 100
C----CALCULATE THE COMPOSITION AND VARIANCE OF COMPOSITION
C----NOT CONSIDERING OVERLAP OR CHEMISTRY
	COMTMP=WT(K)*(FRELS(I)/FRELS(J))*RIOBS/STDS(J)
	VTMP=COMTMP*COMTMP*(SRELS(I)*SRELS(I)/(FRELS(I)*
     *FRELS(I)) + SRELS(J)*SRELS(J)/(FRELS(J)*FRELS(J))+VRIOBS/
     *(RIOBS*RIOBS) + SSTDS(J)*SSTDS(J)/(STDS(J)*STDS(J)))
C
C-----CONVERT FROM WT FRACTION OF SAMPLE + INTERNAL STANDARD
C-----TO THE WT FRACTION IN THE ORIGINAL SAMPLE BEFORE DILUTION
C-----WITH THE INTERNAL STANDARD
C
	COMTMP = COMTMP/WTCOR
	VTMP = VTMP/(WTCOR*WTCOR)
C
C  SAVE THE SUMS TO TAKE WEIGHTED AVERAGES AND RMS SIGMAS
C
C  WE USE 1/SIGMA**2 AS WEIGHTS (WHERE SIGMA IS FROM COUNTING STATS)
C  OR WE USE UNIT WEIGHTS (IWT=1)
C
	IF(IWT.EQ.1) VTMP = 1.0
	COM = COMTMP / VTMP
	S2 = S2 + COM
	AVS(NRFL) = AVS(NRFL) + COM
	COM = COMTMP*COM
	S1 = S1 + COM
	AVSS(NRFL) = AVSS(NRFL) + COM
	S3 = S3 + 1.0/VTMP
	SUM(NRFL) = SUM(NRFL) + 1.0/VTMP
	NAVS(NRFL) = NAVS(NRFL) + 1
	VV = SQRT(VTMP)
	WRITE(IPRT,2200)K,PHASE(J),HKL(J),PHASE(I),HKL(I),
     1COMTMP,VV
2200	FORMAT(' ',I3,2(2X,A6,1X,A6),2F10.4)
100	CONTINUE
	IF(NOV(J).GE.0)GO TO 190
	NRFL = NRFL - 1
	GO TO 200
190	 WAV = S2 / S3
	WAVS = 0.0
	IF(IWT.NE.1) WAVS = SQRT(1.0 / S3)
	RMS = 0.0
	IF(IFILE.EQ.1)GO TO 200
	T = (S1/S3 - WAV*WAV)/(IFILE-1)
	IF(T.LE.0.0)GO TO 195
	RMS = SQRT(T)
195	WRITE(IPRT,110)PHASE(J),HKL(J),AVL,HKL(I),WAV,WAVS,RMS,IFILE
110	FORMAT(6X,A6,1X,A6,1X,A7,1X,A6,F10.4,F10.4,1X,F10.4,I7)
200	CONTINUE
300	CONTINUE
C
C  DETERMINE THE CHEMICAL CONSTRAINTS FOR COPLAND-BRAGG
C  AND OUTPUT TO THE BINARY FILE
C
	IF(NAME.EQ.'      ') GOTO 319
	IF(IFLAG(4).EQ.0)GO TO 318
	DO 315 I=1,NP
	IF(ELEMNT(I).EQ.'  ')GO TO 315
C
C  WE HAVE AN ELEMENT IN THE UNKNOWN - DETERMINE WHICH PHASES
C  CONTAIN THIS ELEMENT AND AT WHAT PERCENT
C
	DO 310 J=1,NUNK
	COP(J) = 0.0
	DO 305 K=1,8
	IF(ELM(K,J).EQ.'  ')GO TO 305
	IF(ELM(K,J).NE.ELEMNT(I))GO TO 305
	COP(J) = WTP(K,J)
305	CONTINUE
310	CONTINUE
C
C-----EQUATION(S) IN ELEMENTAL COMPOSITION.  WRITE RECORD OF SAME
C-----LENGTH AS FOR XRD DATA (IE FILL WITH BLANKS)
C
	V = 1.0
	EL6 = ELEMNT(I)
	WRITE(ICOBRG)(COP(KK),KK=1,NUNK),XWT(I),V,EL6,BL,BL,BL,BL,BL,BL,BL
315	CONTINUE
318	ENDFILE(ICOBRG)
	CLOSE(UNIT=ICOBRG,STATUS='KEEP')
C
C-----CHECK THAT AT LEAST 1 STANDARD AND AT LEAST 1 SAMPLE LINE WAS INPU
C
319	IF(NSTD.NE.0 .AND. NRFL.NE.0) GOTO 400
	WRITE(ITYP,320) NSTD,NRFL
320	FORMAT(/' **Input error** #reference lines=',I3,3X,
     * '# of sample lines=',I3)
	GOTO 999
C
C-----CALCULATE THE AVERAGE COMPOSITION FOR EACH STANDARD LINE
C
400	WRITE(IPRT,1020)  AVL
1020	FORMAT(///14X, A, ' over the standard lines used:'/)
	WRITE(IPRT,2020) ESDHDG
	NRFL = 0
	DO 420 I=1,NREFL
	IF(KODES(I).NE.1)GO TO 420
	IF(NOV(I).LT.0)GO TO 420
	NRFL = NRFL + 1
	IF(NOV(I).GT.0)WRITE(IPRT,1025)
1025	FORMAT(' The following line is excluded from the final ',
     1'average due to overlap')
	WAV = AVS(NRFL) / SUM(NRFL)
	WAVS = 0.0
	IF(IWT.NE.1) WAVS = SQRT(1.0 / SUM(NRFL))
	RMS = 0.0
	IF(NAVS(NRFL).EQ.1)GO TO 420
	T = (AVSS(NRFL)/SUM(NRFL) - WAV*WAV)/(NAVS(NRFL)-1)
	IF(T.LE.0.0)GO TO 410
	RMS = SQRT(T)
410	WRITE(IPRT,1030)PHASE(I),HKL(I),AVL,ALL,WAV,WAVS,RMS,NAVS(NRFL)
1030	FORMAT(6X,A6,1X,A6,1X,A7,1X,A6,F10.4,F10.4,1X,F10.4,I7)
420	CONTINUE
C
C  LASTLY AVERAGE OVER THE LINES OF EACH PHASE
C
	WRITE(IPRT,1040) AVL
1040	FORMAT(///9X,' Overall ',A,   ' over all lines for each phase:'/)
	WRITE(IPRT,2020) ESDHDG
	DO 450 I=1,NUNK
	S1 = 0.0
	S2 = 0.0
	S3 = 0.0
	NRFL = 0
	N = 0
	K = JCOP(I)
	DO 440 J=1,NREFL
	IF(KODES(J).NE.1)GO TO 440
	IF(NOV(J).LT.0)GO TO 440
	NRFL = NRFL + 1
	IF(KIND(J).NE.I)GO TO 440
	S1 = S1 + AVSS(NRFL)
	S2 = S2 + AVS(NRFL)
	S3 = S3 + SUM(NRFL)
	N = N + NAVS(NRFL)
440	CONTINUE
C-----CHECK IF PHASE K HAD ANY RESOLVED LINES
	IF(N.EQ.0) THEN
	   WRITE(IPRT,1044) PHASE(K)
1044	   FORMAT(6X,A6,' Every line is overlapped - use QUANT+COBRAG!')
	   GOTO 450
	ENDIF
	WAV = S2 / S3
	WAVS = 0.0
	IF(IWT.NE.1) WAVS = SQRT(1.0 / S3)
	RMS = 0.0
	IF(N.EQ.1)GO TO 445
	T = (S1/S3 - WAV*WAV)/(N-1)
	IF(T.LE.0.0)GO TO 445
	RMS = SQRT(T)
445	WRITE(IPRT,1030)PHASE(K),ALL,AVL,ALL,WAV,WAVS,RMS,N
450	CONTINUE
	GO TO 999
C**********************************************************************
C
C  INTENSITY RATIO METHOD CALCULATION
C
C**********************************************************************
1000	WRITE(ITYP,1340)
	IF(ITYP.NE.IPRT) WRITE(IPRT,1340)
1340	FORMAT(//15X,' Intensity Ratio Analysis'/)
C
C  IF THE MU/RO OF THE UNKNOWN WAS NOT INPUT COMPUTE IT
C  FROM THE RECORD 6 CHEMICAL INFORMATION
C
	FMU = WT(1)
	IF(IFLAG(4).GT.0)CALL MUONRO(FMU,ELEMNT,XWT,TARGET)
C
C  CALCULATE COMPOSITION FOR EACH MEASURED LINE IN EACH FILE
C
	WRITE(IPRT,2000)
	NRFL = 0
	LL = L
	IF(L.GT.0)GO TO 1050
	LL = NR
	PHASE(LL) = BL
	HKL(LL) = BL
1050	DO 1500 I=1,NREFL
	IF(I.EQ.L)GO TO 1500
	NRFL = NRFL + 1
	WRITE(IPRT,2020) ESDHDG
	IF(NRFL.LE.NU)GO TO 1060
	WRITE(ITYP,60)NU
	IF(ITYP.NE.IPRT) WRITE(IPRT,60)NU
	NRFL = NRFL -1
	GOTO 1510
1060	DO 1400 J=1,IFILE
	RIOBS = AINT(I,J)
	VRIOBS = VINT(I,J)
	IF(L.EQ.0)GO TO 1350
C
C  A SPECIAL REFERENCE REFLECTION WAS USED
C
	RIOBS = RIOBS / AINT(L,J)
	VRIOBS=RIOBS*RIOBS*(VINT(I,J)/(AINT(I,J)*AINT(I,J))+
     * VINT(L,J)/(AINT(L,J)*AINT(L,J)))
C
C  CALCULATE THE COMPOSITION AND ITS VARIANCE
C
C
C  NOTE AUTO STORES THE MU/RO OF THE REFERENCE AS THE LAST
C  FIELD OF RECORD 7 = CONC(I)
C
1350	COMTMP =(RIOBS / STDS(I)) * (FMU / XMURHO(I))
	IF(IDBUG.EQ.1) WRITE(ITYP,1360) I,J,L,RIOBS,STDS(I),FMU,XMURHO(I)
1360	FORMAT(' ',3I5,4F10.3,' I,J,L,RIOBS,STDS,FMU,XMURHO')
	VTMP=COMTMP*COMTMP*(VRIOBS /
     *(RIOBS*RIOBS) + SSTDS(J)*SSTDS(J)/(STDS(J)*STDS(J)))
C
C  SAVE THE SUMS TO TAKE WEIGHTED AVERAGES AND RMS SIGMAS
C
C  WE USE 1/SIGMA**2 AS WEIGHTS (WHERE SIGMA IS FROM COUNTING STATS)
C  OR WE USE UNIT WEIGHTS (IWT=1)
C
	IF(IWT.EQ.1) VTMP = 1.0
	COM = COMTMP / VTMP
	AVS(NRFL) = AVS(NRFL) + COM
	COM = COMTMP*COM
	AVSS(NRFL) = AVSS(NRFL) + COM
	SUM(NRFL) = SUM(NRFL) + 1.0/VTMP
	NAVS(NRFL) = NAVS(NRFL) + 1
	VV = SQRT(VTMP)
	WRITE(IPRT,2200)J,PHASE(I),HKL(I),PHASE(LL),HKL(LL),COMTMP,VV
1400	CONTINUE
	WAV = AVS(NRFL) / SUM(NRFL)
	WAVS = 0.0
	IF(IWT.NE.1) WAVS = SQRT(1.0 / SUM(NRFL))
	RMS = 0.0
	IF(NAVS(NRFL).EQ.1)GO TO 1500
	T = (AVSS(NRFL)/SUM(NRFL) - WAV*WAV)/(NAVS(NRFL)-1)
	IF(T.LE.0.0)GO TO 1450
	RMS = SQRT(T)
1450	WRITE(IPRT,110)PHASE(I),HKL(I),AVL,HKL(LL),WAV,WAVS,RMS,IFILE
1500	CONTINUE
C
C  LASTLY AVERAGE OVER THE LINES OF EACH PHASE
C
1510	WRITE(IPRT,1040)  AVL
	WRITE(IPRT,2020) ESDHDG
	DO 1700 I=1,NUNK
	NRFL = 0
	S1 = 0.0
	S2 = 0.0
	S3 = 0.0
	N = 0
	K = JCOP(I)
	DO 1600 J=1,NREFL
	IF(KODES(J).NE.1)GO TO 1600
	NRFL = NRFL + 1
	IF(KIND(J).NE.I)GO TO 1600
	S1 = S1 + AVSS(NRFL)
	S2 = S2 + AVS(NRFL)
	S3 = S3 + SUM(NRFL)
	N = N + NAVS(NRFL)
1600	CONTINUE
	WAV = S2 / S3
	 WAVS = 0.0
	IF(IWT.NE.1) WAVS = SQRT(1.0 / S3)
	RMS = 0.0
	IF(N.EQ.1)GO TO 1650
	T = (S1/S3 - WAV*WAV)/(N-1)
	IF(T.LE.0.0)GO TO 1650
	RMS = SQRT(T)
1650	WRITE(IPRT,1030)PHASE(K),ALL,AVL,BL,WAV,WAVS,RMS,N
1700	CONTINUE
999	STOP
	END
