C------------------------------------------------------------------------
	SUBROUTINE PARSELEM (formula, ELEMS, NELEMS, CHECKLIST, STATUS)
C=======================================================================
C	   Return unique elements in the chemical formula as a character
C	   string, and the number of unique elements.
C
C	   formula       - Character string array of elements
C	   ELEMS         - Character string array of elements
C	   NELEMS        - number of unique elements
C	   CHECKLIST     - logical array, .true. if element is present
C	   STATUS        - 0 if no error, 1 if error
C
C	   By: Mark Holomany. modified by Brian Toby
C
C=======================================================================
C
	IMPLICIT INTEGER (A-Z)
	CHARACTER*(*) formula
	CHARACTER*2   ELEMS(25)
	LOGICAL*1     CHECKLIST(104)
	INTEGER       NELEMS

	CHARACTER     TOKEN*20
	CHARACTER*135 STRING
	CHARACTER*2   CHSYM(104)
	INTEGER       COUNT_NELEMS(10)

C	CHARACTER*2   CHNELEMS(10), NELEMS_CODE(2)
C	DATA CHNELEMS/'^1','^2','^3','^4','^5','^6','^7','^8','^9','^A'/

      DATA CHSYM/'H ','He','Li','Be','B ','C ','N ','O ','F ','Ne',
     1'Na','Mg','Al','Si','P ','S ','Cl','Ar','K ','Ca','Sc','Ti','V ',
     2'Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se','Br','Kr',
     3'Rb','Sr','Y ','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In',
     4'Sn','Sb','Te','I ','Xe','Cs','Ba','La','Ce','Pr','Nd','Pm','Sm','
     5Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb','Lu','Hf','Ta','W ','Re','O
     6s','Ir','Pt','Au','Hg','Tl','Pb','Bi','Po','At','Rn','Fr','Ra',
     7'Ac','Th','Pa','U ','Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md',
     8 'No','Lw','Ln'/

	INCLUDE  'PDFDATA.CMN'

	ELEMENT_COUNT = 0
	NELEMS = 0
	STATUS = 0
	NLANTH = 0
	krd = 1
C drop a leading symbol (if any); terminated by a --
	i1 = 1
	DO I=1,lench(formula)-1
	  IF (formula(i:i+1) .eq. '--') THEN
	    i1 = I+2
	    goto 100
	  ENDIF
	ENDDO

100	CALL SCANIN (formula(i1:), ' ')
C======================================================================

	DO 4010 N=1,104
4010	CHECKLIST(N) = .FALSE.

3000	CONTINUE
	CALL SCANER(TOKEN,SIZE)
	IF(SIZE.EQ.-1) THEN
	   GO TO 9000
	ENDIF
C
C	... Element symbol plus optional subscripted number(s)
	IF(TOKEN(1:1).GE.'A' .AND. TOKEN(1:1).LE.'Z')      THEN
	   IF( (TOKEN(2:2).GE.'a' .AND. TOKEN(2:2).LE.'y') .AND.
	1       TOKEN(2:2).NE.'x')  THEN
C	      .. two character element symbol
	      SIZE = 2
	   ELSE
C	      .. one character element symbol
	      SIZE = 1
	   ENDIF

	   DO 4030 N=1,104
	   IF(TOKEN(1:SIZE) .EQ. CHSYM(N)) THEN
	      IF(.NOT. CHECKLIST(N)) THEN
	         NELEMS = NELEMS + 1
	         ELEMS(NELEMS) = TOKEN(1:SIZE)
	         CHECKLIST(N) = .TRUE.
	         ELEMENT_COUNT = ELEMENT_COUNT + 1
	      ENDIF
	      GO TO 3000
	   ENDIF
4030	   CONTINUE

	      IF(TOKEN(1:SIZE).EQ.'D' .OR. TOKEN(1:SIZE).EQ.'T') THEN
	         IF(.NOT. CHECKLIST(1)) THEN
	            NELEMS = NELEMS + 1
	            ELEMS(NELEMS) = 'H '
	            CHECKLIST(1) = .TRUE.
	            ELEMENT_COUNT = ELEMENT_COUNT + 1
	         ENDIF
	      ELSE
	         CALL ERRTXT ('W',
	1          'Problem with element '//TOKEN(1:SIZE))
		 STATUS = 1
	      ENDIF
	ENDIF
	GO TO 3000

9000	CONTINUE

	RETURN
	END
