	SUBROUTINE GETELEM(*,trace,tracelen)
C
C Subroutine to get element input and logic
C
	include 'logic.common'
	LOGICAL*1 reqelem(121),ignelem(121)
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	EXTERNAL SS$_NORMAL,CLI$_PRESENT,CLI$_NEGATED,CLI$_ABSENT
	INTEGER*2 nreq,nign,ilogic,tracelen
	CHARACTER*(*) trace
	INTEGER*2 ITMP,csym
	byte bsym(2),COMMAF
	equivalence (csym,bsym(1))
	CHARACTER*40 parm
	integer*2 specsym(15,18) /
C element "104" symbol LN - Lanthanides (La - Lu)
	4 57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,
C element "105" symbol 1A - period 1 (H,Li,Na,K,Rb,Cs,Fr)
	5  1, 3,11,19,37,55,87, 0, 0, 0, 0, 0, 0, 0, 0,
C element "106" symbol 2A - period 2 (Be,Mg,Ca,Sr,Ba,Ra)
	6  4,12,20,38,56,88, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "107" symbol 3A - period 3 (B,Al,Ga,In,Tl)
	7  5,13,31,49,81, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "108" symbol 4A - period 4 (C,Si,Ge,Sn,Pb)
	8  6,14,32,50,82, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "109" symbol 5A - period 5 (N,P,As,Sb,Bi)
	9  7,15,33,51,83, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "110" symbol 6A - period 6 (O,S,Se,Te,Po)
	1  8,16,34,52,84, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "111" symbol 7A - period 7 (H,F,Cl,Br,I,At)
	1  1, 9,17,35,53,85, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "112" symbol 8A - period 8 (He,Ne,Ar,Kr,Xe,Rn)
	2 10,18,36,54,86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "113" symbol 1B - transition metals block 9 (Cu,Ag,Au)
	3 29,47,79, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "114" symbol 1B - transition metals block 10 (Zn,Cd,Hg)
	4 30,48,80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "115" symbol 3B - transition metals block 1 (Sc,Y,La,Ac)
	5 21,39,57,89, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "116" symbol 4B - transition metals block 2 (Ti,Zr,Hf)
	6 22,40,72, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "117" symbol 5B - transition metals block 3 (V,Nb,Ta)
	7 23,41,73, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "118" symbol 6B - transition metals block 4 (Cr,Mo,W)
	8 24,42,74, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "119" symbol 7B - transition metals block 5 (Mn,Tc,Re)
	9 25,43,75, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
C element "120" symbol 8B - transition metals block 6-8 (Fe-Ni,Ru-Pd,Os-Pt)
	1 26,27,28,44,45,46,76,77,78, 0, 0, 0, 0, 0, 0,
C element "121" symbol AD - Actinides (Ac-Lr)
	1 89,90,91,92,93,94,95,96,97,98,99,100,101,102,103/

	nreq = 0
	nign = 0
	do i=1,121
	  reqelem(i) = .false.
	  ignelem(i) = .false.
	enddo

	COMMAF = .true.
	IF (CLI$PRESENT('elements') .eq. %LOC(CLI$_PRESENT)) THEN
	  do i=1,121
	    status = CLI$GET_VALUE('elements',parm,len)
	    IF (status .eq. %LOC(CLI$_ABSENT)) 	GOTO 200
C	is the element name valid?
	    CALL CHECKELEM(K,PARM,LEN,121,*102)
	    reqelem(K) = .TRUE.
	    nreq = nreq + 1
	  ENDDO
	ENDIF
	IF (CLI$PRESENT('E_SPAN')) THEN
	  ilogic = 3
	  do i=1,121
	    status = CLI$GET_VALUE('E_SPAN',parm,len)
	    IF (status .eq. %LOC(CLI$_ABSENT)) GOTO 200
C	is the element name valid?
	    CALL CHECKELEM(K1,PARM,LEN,103,*102)
	    status = CLI$GET_VALUE('E_SPAN',parm,len)
	    IF (status .eq. %LOC(CLI$_ABSENT)) GOTO 102
C	is the element name valid?
	    CALL CHECKELEM(K2,PARM,LEN,103,*102)
	    DO K=min(k1,k2),max(k1,k2)
	      reqelem(K) = .TRUE.
	      nreq = nreq + 1
	    ENDDO
	  ENDDO
	ENDIF

200	IF (nreq .eq. 0 .and. PROMPT .and. 
	1	(CLI$PRESENT('elements') .ne. %LOC(CLI$_NEGATED))) THEN
	  WRITE(lo,'(/,a,/,a)') ' Enter the chemical symbols for elements '
	2	//'one per line (case will be ignored)'
	2	,' Enter a blank line when done.'
	  DO I=1,121
201	    WRITE(lo,'(a)') '$ELEMENT> '
	    READ(li,'(Q,a2)',END=300) LEN,PARM
	    IF (len .EQ. 0 .or. PARM(1:LEN) .EQ.'  ') GO TO 300
	    CALL CHECKELEM(K,PARM,LEN,121,*202)
	    nreq = nreq + 1
	    reqelem(K) = .TRUE.
	  ENDDO
	ENDIF

C now get the type of logic
300	ilogic = 0
	IF (CLI$PRESENT('OPTIONAL')) THEN
	  ilogic = 3
	  do i=1,121
	    status = CLI$GET_VALUE('OPTIONAL',parm,len)
	    IF (status .eq. %LOC(CLI$_ABSENT)) 	GOTO 350
C	is the element name valid?
	    CALL CHECKELEM(K,PARM,LEN,121,*302)
	    IGNelem(K) = .TRUE.
	    nign = nign + 1
	  ENDDO
	ENDIF
	IF (CLI$PRESENT('O_SPAN')) THEN
	  ilogic = 3
	  do i=1,121
	    status = CLI$GET_VALUE('O_SPAN',parm,len)
	    IF (status .eq. %LOC(CLI$_ABSENT)) 	GOTO 350
C	is the element name valid?
	    CALL CHECKELEM(K1,PARM,LEN,103,*302)
	    status = CLI$GET_VALUE('O_SPAN',parm,len)
	    IF (status .eq. %LOC(CLI$_ABSENT)) 	GOTO 302
C	is the element name valid?
	    CALL CHECKELEM(K2,PARM,LEN,103,*302)
	    DO K=min(k1,k2),max(k1,k2)
	      IGNelem(K) = .TRUE.
	      nign = nign + 1
	    ENDDO
	  ENDDO
	ENDIF
	IF (ilogic .eq. 3) GOTO 400

	IF (CLI$PRESENT('OR')) THEN
	  ilogic = 1
	ELSEIF (CLI$PRESENT('AND')) THEN
	  ilogic = 2
	ELSEIF (CLI$PRESENT('EXACT')) THEN
	  ilogic = 3
	ELSEIF (nreq .eq. 0) THEN
	  write (lo,'(A)') 
	1 ' Warning -- No required elements input, /OPTIONAL logic assumed'
	2 ,' '
	  goto 360
	ENDIF

350	IF (ilogic .eq. 0) then
	  IF (PROMPT) THEN
	    write (lo,'(A)') ' Choose a logic type: '
	    if (nreq .gt. 1) then 
	      write (lo,'(A)') 
	1 '   (1) OR       -- materials with ANY of the selected elements',
	2 '   (2) AND      -- materials with ALL of the selected elements',
	3 '   (3) EXACT    -- materials with ALL of the selected elements',
	4 '                   and no others',
	5 '   (4) OPTIONAL -- same as EXACT but specified optional elements',
	6 '                   may or may not be present'
	    else
	      write (lo,'(A)') 
	1 '   (2) OR       -- all materials containing the selected element',
	1 '   (3) EXACT    -- materials containing only the selected element',
	2 '                   and no others',
	5 '   (4) OPTIONAL -- same as EXACT but specified optional elements',
	6 '                   may or may not be present'
	    endif
	    write (lo,'(A)') '$Enter your choice (default=2): '
	    read(li,'(q,i)') ITMP,ILOGIC
	    IF (ITMP .eq. 0 .or. ILOGIC .gt. 4 .or. ILOGIC .le. 0) then
	      ILOGIC = 2
	    ELSEIF (ILOGIC .eq. 4) THEN 
360	      ilogic = 3
	      WRITE(lo,'(a)') ' Enter the chemical symbol for '
	1	//'elements to be ignored'
	      DO i=1,121
		WRITE(lo,'(a)') '$OPTIONAL> '
		READ(li,'(Q,a2)',END=400) LEN,PARM
		IF (LEN .EQ. 0 .or. PARM(1:LEN) .EQ.'  ') GO TO 400
C	is the element name valid?
		CALL CHECKELEM(K,PARM,LEN,121,*402)
		ignelem(k) = .true.
		nign = nign + 1
	      ENDDO
	    ENDIF
	  ELSE
	    write (lo,'(A)') ' Logic type not set: defaulting to /AND'
	    ilogic = 2
	  ENDIF
	ENDIF

400	IF (nreq .eq. 0 .and. ilogic .lt. 3) THEN
	  write (lo,'(A)') ' Error -- no required elements input'//
	1	' for /AND or /OR search'
	  return 1
	ELSEIF (nreq .eq. 0 .and. nign .eq. 0) THEN
	  write (lo,'(A)') ' Error -- no required or optional elements input'
	  return 1
	endif

C correct for usage of special element symbols (104-121)
C   /ELEMENT=xx where xx is a "special symbol" for a group of "real" elements
C	for /OR, /AND, and /EXACT remove the "real" elements from the 
C	   required array and give a warning if any have been set.
C	for /EXACT set the "real" elements to be set as /OPTIONAL,
C   When using the required special element OR together all the real elements
C   comprising the "special symbol, except for 104 (Ln) which already has 
C   its own bitmap
C
C   /OPTIONAL=xx where xx is a "special symbol" for a group of "real" elements
C	set all "real" elements to be ignored and remove the special symbol
C      from the table

      DO J=104,121
	IF (reqelem(j)) then
	  DO i1=1,15
	    i = specsym(i1,J-103)
	    if (i .eq. 0) goto 313
	    IF (reqelem(i)) then
	      write (lo,'(a,a2,a,a2,a)') ' Reseting element ',
	1	      CHSYM(i),' because ',CHSYM(j),' was coded'
	      reqelem(i) = .false.
	    ENDIF
	    IF (ilogic .eq. 3) then
	      ignelem(i) = .true.
	      nign = nign + 1
	    ENDIF
	  ENDDO
	ENDIF
313	IF (ignelem(j)) then
	  ignelem(j) = .false.
	  DO i1=1,15
	    i = specsym(i1,J-103)
	    if (i .eq. 0) goto 314
	    ignelem(i) = .true.
	    nign = nign + 1
	  ENDDO
314	ENDIF
      ENDDO

C set up trace line
	tracelen = 11
	if (nreq .eq. 0) then 
	  trace = '/NOELEMENTS'
	ELSE
	  trace = '/ELEMENTS=('
 	  DO J=1,121
	    IF (reqelem(J)) then 
	      csym = CHSYM(j)
	      IF (bsym(2) .eq. ' ') then
		write(trace(tracelen+1:),'(2a1)') bsym(1),','
		tracelen = tracelen + 2
	      ELSE
		write(trace(tracelen+1:),'(a2,a1)') CHSYM(j),','
		tracelen = tracelen + 3
	      ENDIF
	    ENDIF
	  ENDDO
	  trace(tracelen:tracelen) = ')'
	ENDIF
	IF (ilogic .eq. 1) THEN
	  trace = trace(1:tracelen)//'/OR'
	  tracelen = tracelen + 3
	ELSEIF (ilogic .eq. 2) THEN
	  trace = trace(1:tracelen)//'/AND'
	  tracelen = tracelen + 4
	ELSEIF (ilogic .eq. 3) THEN
	  trace = trace(1:tracelen)//'/EXACT'
	  tracelen = tracelen + 6
	  if (Nign .gt. 0) then 
	    trace = trace(1:tracelen)//'/OPTIONAL=('
	    tracelen = tracelen + 11
	    DO J=1,121
	      IF (ignelem(J)) then
		csym = CHSYM(j)
		IF (bsym(2) .eq. ' ') then
		  write(trace(tracelen+1:),'(2a1)') bsym(1),','
		  tracelen = tracelen + 2
		ELSE
		  write(trace(tracelen+1:),'(a2,a1)') CHSYM(j),','
		  tracelen = tracelen + 3
		ENDIF
	      ENDIF
	    ENDDO
	    trace(tracelen:tracelen) = ')'
	  ENDIF
	ELSE
	  type *,'ilogic = ',ilogic
	  STOP 'GETELEM ERROR -- This should not happen'
	ENDIF
C
C Now set the bit map by selected elements and by logic 
C
	OPEN(unit=LUNC,file='PS_BITMAP:CHEM.BITMAP',status='old',shared,
	1	readonly,access='direct',form='unformatted',
	2	err=717)

C OR together "real" elements
	IF (ilogic .eq. 1) then
	  CALL TBLCLR(TABLE1,N_Lwords,nph1)
	  DO I=1,104
	    IF (reqelem(i)) then
	      READ(LUNC,rec=i) (TABLE2(j1),j1=1,N_Lwords)
	      CALL TBLOR(TABLE1,TABLE2,TABLE1,N_Lwords)
	    ENDIF
	  ENDDO
C OR together special elements
	  DO j=105,121
	    IF (reqelem(j)) then
	      DO i1=1,15
		i = specsym(i1,J-103)
		if (i .ne. 0) then
		  READ(LUNC,rec=i) (TABLE2(j1),j1=1,N_Lwords)
		  CALL TBLOR(TABLE1,TABLE2,TABLE1,N_Lwords)
		ENDIF
	      ENDDO
	    ENDIF
	  ENDDO

C AND together elements
	ELSEIF (ilogic .eq. 2) then 
	  CALL TBLSET(TABLE1,N_cards,nph1)
	  DO I=1,121
	    IF (reqelem(i) .and. i .le. 104) then
	      READ(LUNC,rec=i) (TABLE2(j1),j1=1,N_Lwords)
	      CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	    ELSEIF (reqelem(i)) then
C OR together all "real" elements comprising a special element 
C and then AND as if a "real" element.
	      CALL TBLCLR(TABLE2,N_Lwords,nph1)
	      DO i1=1,15
		j = specsym(i1,i-103)
		if (j .ne. 0) then
		  READ(LUNC,rec=j) (TABLE3(j1),j1=1,N_Lwords)
		  CALL TBLOR(TABLE2,TABLE3,TABLE2,N_Lwords)
		ENDIF
	      ENDDO
	      CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	    ENDIF
	  ENDDO

C EXACT elements list
	ELSEIF (ilogic .eq. 3) then 
C    OR together elements that are not allowed
	  CALL TBLCLR(TABLE1,N_Lwords,nph1)
	  DO I=1,103
	    IF (.not. (reqelem(i) .or. IGNELEM(I))) THEN
	      READ(LUNC,rec=i) (TABLE2(j1),j1=1,N_Lwords)
	      CALL TBLOR(TABLE1,TABLE2,TABLE1,N_Lwords)
	    ENDIF
	  ENDDO
C we now have a list of unallowed cards, so .NOT. the list to get 
C the allowed list of cards
	  CALL TBLnot(TABLE1,TABLE1,N_cards)
C now AND list with required elements
	  DO I=1,121
	    IF (reqelem(i) .and. i .le. 104) then
	      READ(LUNC,rec=i) (TABLE2(j1),j1=1,N_Lwords)
	      CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	    ELSEIF (reqelem(i)) then
C OR together all "real" elements comprising a special element 
C and then AND as if a "real" element.
	      CALL TBLCLR(TABLE2,N_Lwords,nph1)
	      DO i1=1,15
		j = specsym(i1,i-103)
		if (j .ne. 0) then
		  READ(LUNC,rec=j) (TABLE3(j1),j1=1,N_Lwords)
		  CALL TBLOR(TABLE2,TABLE3,TABLE2,N_Lwords)
		ENDIF
	      ENDDO
	      CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	    ENDIF
	  ENDDO
	ENDIF

	CLOSE(LUNC)
	RETURN
C----------------------------------------------------------------------
717	stop 'ERROR -- Unable to open Chemistry INDEX file 
	1 (PS_BITMAP:CHEM.BITMAP)'
C----------------------------------------------------------------------
C  oops, invalid name
102	WRITE(lo,9050) PARM(1:LEN)
9050	FORMAT(' WARNING -- Chemical symbol ',a,' is illegal')
	IF (PROMPT) THEN
	  WRITE(lo,'(A)') ' Please reinput all required elements'
	  nreq = 0
	  do i=1,121
	    reqelem(i) = .false.
	  enddo
	  GOTO 200
	ELSE
	  STOP 'LOGIC -- Error in input, unable to prompt'
	ENDIF
C----------------------------------------------------------------------
C  oops, invalid name
202	WRITE(lo,9050) PARM(1:LEN)
	GOTO 201
C----------------------------------------------------------------------
302	WRITE(lo,9050) ITMP
	IF (PROMPT) THEN
	  WRITE(lo,'(A)') ' Please reinput all optional elements'
	  nign = 0
	  do i=1,121
	    ignelem(i) = .false.
	  enddo
	  GOTO 360
	ELSE
	  STOP 'LOGIC -- Error in input, unable to prompt'
	ENDIF
C----------------------------------------------------------------------
C  oops, invalid name
402	WRITE(lo,9050) ITMP
	ilogic = 0
	GOTO 350
	END

C----------------------------------------------------------------------
	SUBROUTINE CHECKELEM(K,PARM,LEN,maxno,*)
	include 'logic.common'
	CHARACTER*(*) parm
	INTEGER*2 ITMP
C  is the element name valid?
	read(unit=parm(1:len),fmt='(a2)') ITMP
	CALL UPCASE(ITMP,2)
	DO J=1,maxno
	  k = J
	  IF (ITMP .EQ. UPSYM(J)) RETURN 
	ENDDO
	RETURN 1
	END
	SUBROUTINE GETELMC(trace,tracelen,ilogic,*)
C
C Subroutine to get element count 
C
	include 'logic.common'
	INTEGER*2 tracelen
	CHARACTER*(*) trace
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	CHARACTER*8 str1,str2
	INTEGER*4 CARDNO
	INTEGER*4 num1,num2
	LOGICAL GET_NUMBER,flag
	
	FLAG = GET_NUMBER('COUNT',Num1)
	IF (FLAG) THEN
	  IF (.not. prompt) THEN
200	    WRITE(lo,'(a)') ' ERROR -- unable to prompt for element count'
	    RETURN 1
	  ENDIF
101	  WRITE(lo,'(a)') '$Enter the element count lower limit: '
	  READ(li,'(q,i6)',END=200,err=101) i,num1
	  if (i .le. 0) goto 101
	  WRITE(lo,'(a,i3,a)') 
	1	'$Enter the element count upper limit (default=',num1,'): '
	  READ(li,'(q,i6)',END=200,err=101) i,num2
	  if (i .le. 0) num2 = num1
	ELSE 
	  NUM2 = NUM1
	  FLAG = GET_NUMBER('COUNT',Num2)
	ENDIF
	CALL TBLCLR(TABLE1,N_Lwords,nph1)

	WRITE(str1,'(i8)') num1
	call press(str1,l1)
	IF (num1 .eq. num2) THEN
	  trace = '/COUNT='//str1(:l1)
	  tracelen = 7 + l1
	ELSE	  
	  WRITE(str2,'(i8)') num2
	  call press(str2,l2)
	  trace = '/COUNT=('//str1(:l1)//','//str2(:l2)//')'
	  tracelen = 10 + l1 + l2
	ENDIF
	OPEN(unit=LUNC,file='PS_BITMAP:ELMCOUNT.BITMAP',status='old',shared,
	1	readonly,access='direct',form='unformatted',
	2	err=717)
	DO J=max(0,num1),min(num2,N_ELEMC-1)
	  read(LUNC,rec=j+1) (TABLE2(I),i=1,N_Lwords)
	  CALL TBLOR(TABLE1,TABLE2,TABLE1,N_Lwords)
C count the number of matching cards
	  CALL TBLCOUNT(TABLE2,N_Lwords,nph2)
	  write (lo,'(1x,a,i3,a,i6)') 'Element count=',j,'  # entries =',nph2
	ENDDO
	CLOSE(unit=LUNC)
	RETURN
717	WRITE (*,'(A)') ' ERROR -- Unable to open Element Count INDEX file '
	1 //'(PS_BITMAP:ELMCOUNT.BITMAP)'
3	RETURN 1
	END
