	SUBROUTINE FOM(DIREC,jmiss,jmatch,NDSINT,FOMI,FOMA,FOMF,AVEI,
	1	STATUS)
C**********************************************************************
C This subroutine matches an unknown pattern against a JCPDS pattern
C Two peaks are considered to match if the JCPDS peak is between 
C OBL and OBH. (Note that a OBS peak may match more than one JCPDS line 
C but not vice-versa). 
C 
C NDSINT =  total number of JCPDS lines 
C jmiss  =  number of unmatched JCPDS lines (not counting excluded peaks)
C jmatch =  number of matched JCPDS lines (not counting excluded peaks)
C FOMI   =  intensity figure of merit
C FOMA   =  angle figure of merit
C FOMF   =  Full pattern FOM
C AVEI	 =  average ratio of intensities, JCPDS/OBS
C STATUS = .FALSE. if there is one or zero matching peaks
C**********************************************************************
	INTEGER STATUS
	integer*4 DIREC,jmiss,jmatch,NDSINT
	REAL FOMI,FOMA,FOMF,AVEI

	include '[-.shared]jcpds.parms'
	include 'SEARCH.cmn'
	include 'SEARCH.par'

	REAL IROBS(210)
	INTEGER*2 JC(210)
	INTEGER*2 JC1(42),JC2(42),JC3(42),JC4(42),JC5(42)
	EQUIVALENCE (JC1(1),JC(1))
	EQUIVALENCE (JC2(1),JC(43))
	EQUIVALENCE (JC3(1),JC(85))
	EQUIVALENCE (JC4(1),JC(127))
	EQUIVALENCE (JC5(1),JC(169))

	BYTE INTB(210)
	BYTE IN1(42),IN2(42),IN3(42),IN4(42),IN5(42)
	EQUIVALENCE (IN1(1),INTB(1))
	EQUIVALENCE (IN2(1),INTB(43))
	EQUIVALENCE (IN3(1),INTB(85))
	EQUIVALENCE (IN4(1),INTB(127))
	EQUIVALENCE (IN5(1),INTB(169))
	INTEGER*2    NUMJC,dummy2,i2
	LOGICAL EXRtst

	STATUS = .false.
	jmiss = 0
	jmatch = 0
	IMATCH = 0
	sumdif = 0.
	sumdif2 = 0.
	sumi = 0.1
	avei = 0.0

C	get D/I info -- all records
	READ(LPDF,REC=DIREC) NUMJC,JC1,IN1
	IF (NUMJC .ge. 43) THEN 
	  READ(LPDF,REC=DIREC+1) dummy2,JC2,IN2
	  IF (NUMJC .ge. 85) THEN
	    READ(LPDF,REC=DIREC+2) dummy2,JC3,IN3
	    IF (NUMJC .ge. 127) THEN
	      READ(LPDF,REC=DIREC+3) dummy2,JC4,IN4
	      IF (NUMJC .ge. 169) READ(LPDF,REC=DIREC+4) dummy2,JC5,IN5
	    ENDIF
	  ENDIF
	ENDIF
	NDSINT = NUMJC

C	Check for match of two-theta
	jmin = 1
	DO 14 I=1,NUMJC
C 	find the closest OBS peak
	  diffp = ABS(1.*JC(I) - 1.*OB2T(jmin))
	  jmat = jmin
	  DO J=jmin,nobs
	    diff = ABS(1.*JC(I) - 1.*OB2T(J))
	    IF (diff .gt. diffp) then 
	      jmin = min(1,J-1)
	      goto 16
	    else	    
	      diffp = diff
	    endif
	    jmat = j
	  ENDDO
C	OK, so this is the closest line, is it a match?
16	  IF (JC(I) .lt. OBL(jmat) .or. JC(I) .gt. OBH(jmat)) then
C	no, this is not a match, is it above the threshold?
C is JCPDS peak excluded? is it above the threshold?
	    if (INTB(I) .gt. IMIN .and. .not. EXRtst(extbl,JC(I))) 
	1     jmiss = jmiss + 1
	  ELSE
C   match, so compute difference between peak positions in deg@Cu Ka1*100
	    jmatch = jmatch + 1
	    diff = 100. * ABS(1.*JC(I) - 1.*OB2T(jmat)) * 90. / 31415.9
	    SUMDIF = SUMDIF + DIFF
	    SUMDIF2 = SUMDIF2 + DIFF**2
	    IF ((INTB(I) + IOBS(jmat)) .gt. 0.0) then
	      IF (INTB(I) .gt. 0) then 
		AVEI = AVEI + IOBS(jmat) * 1.0/INTB(I)
	      ELSE
		AVEI = AVEI + IOBS(jmat)
	      ENDIF
	      SUMI = SUMI + ABS(INTB(I)-IOBS(jmat)) * 1.0/
	1	(INTB(I)+IOBS(jmat))
	      IMATCH = IMATCH + 1
	    ENDIF
	  ENDIF
14	CONTINUE
C   now compute the various FOM's (need more than 1 matching line)
	IF (IMATCH .LE. 1 .OR. JMATCH .LE. 1) RETURN
	AVEI = AVEI / imatch
	FOMI = SUMI / imatch
	IF (jmatch .LE. 2) THEN 
	  FOMA = SUMDIF / jmatch
	ELSE
	  FOMA = SQRT((SUMDIF2 - SUMDIF**2/jmatch)/(jmatch-1))
	ENDIF

C now compute the full-pattern FOM
	STATUS = .true.
	FOMF = 999.0
	IF (NPTS .le. 0) RETURN
C   determine the intensity at each peak
	n = 0
	sumi = 0.
	sumo = 0.
	DO 24 I=1,NUMJC
C is the JCPDS peak excluded? if so go on to next peak
	  if (EXRtst(extbl,JC(I)) .or. (INTB(I) .le. 0)) goto 24
	  I2 = NPTS
	  j = locate2(I2,prdat,JC(I))
	  n = n + 1
	  irobs(n) = irdat(j)
	  sumi = sumi + intb(i)
	  sumo = sumo + irobs(n)
24	CONTINUE
	IF (sumo .le. 0 .or. sumi .le. 0) RETURN
	xnorm = sumo / sumi
	sum = 0.
	n = 0
	DO 25 I=1,NUMJC
	  if (EXRtst(extbl,JC(I)) .or. (INTB(I) .le. 0)) goto 25
	  n = n + 1
	  sum = sum + (INTB(I) - IROBS(N)/XNORM)**2
25	CONTINUE
	FOMF = sqrt(sum)/SUMI
	RETURN
	END
