C	PROGRAM YES_FG
C
C     POSITIVE FUNCTIONAL GROUPS

      INTEGER LENS(5)
	INTEGER*4 TABLE(2000),NTABLE,MASK
	CHARACTER*47 ELEM
	CHARACTER*81 STUFF
      CHARACTER*10 NUMBER(5)
      CHARACTER*1 ANS



      WRITE(6,123)
123   FORMAT(' VAX VERSION NOV 19, 1987'/
     1  10X,'GERALD G. JOHNSON JR., MRL/PSU'/
     1  10X,'RICHARD L. HARLOW, I, DUPONT'/
     1  10X,'PROGRAM TO SEARCH CRYSTAL DATA FILE USING CHEMISTRY.'/
     1  10X,'THIS PROGRAM WILL USE 1 TO 5 FUNCTIONAL GROUPS'/
     1  10X,'USING AND/OR LOGIC.')
      NUMANS=0


      CALL GET(TABLE,ISIZE,NSIZE)
      IF(ISIZE.EQ.59613) KEY=1
      IF(ISIZE.EQ.56140) KEY=2
      IF(KEY.EQ.1) THEN
                   OPEN(UNIT=20,STATUS='OLD',ACCESS='DIRECT',
     1             READONLY,SHARED,FORM='UNFORMATTED',RECL=32,
     2             FILE='LATTICEI')
      ENDIF
      IF(KEY.EQ.2) THEN
                   OPEN(UNIT=20,STATUS='OLD',ACCESS='DIRECT',
     1             READONLY,SHARED,FORM='UNFORMATTED',RECL=32,
     2             FILE='LATTICEO')
      ENDIF


229   WRITE(6,230)
230   FORMAT(' PLEASE ENTER THE NUMBER OF FUNCTIONAL GROUPS'
     1  ,1X,'TO BE ENTERED ',$)
      READ(5,231,ERR=229,END=20) NUM_EL
231   FORMAT(I10)
      IF(NUM_EL.LE.0.OR.NUM_EL.GT.5) GO TO 229
      IF(NUM_EL.EQ.1) THEN
                      ANS='O'
                      GO TO 6500
      ENDIF
6999  WRITE(6,7000)
7000  FORMAT(' DO YOU WANT TO DO "OR" LOGIC or "AND" LOGIC (O/[A])'
     1    ,1X,'  ',$)
      READ(5,7001) NCR,ANS
      KEY=STR$UPCASE(ANS,ANS)
7001  FORMAT(Q,1A1)
      IF(NCR.EQ.0) ANS='A'
      ITYPE=0
      IF(ANS.EQ.'A') ITYPE=1
6500  IF(ANS.EQ.'O') ITYPE=2
      IF(ITYPE.EQ.0) GO TO 6999
      DO 3425 I=1,NUM_EL
199   WRITE(6,200) I
200   FORMAT(' ENTER FUNCTIONAL GROUP IN WHICH YOU ARE'
     1   ,1X,'INTERESTED  '/
     1   10X,'ENTER IT IN UPPER/LOWER CASE WITH PROPER SPACING '/
     1   10X,'PLEASE ENTER FUNCTIONAL GROUP #',I2,'            ',$)
      READ(5,9201,ERR=199,END=20) NCR,NUMBER(I)
9201  FORMAT(Q,A)
      IF(NCR.EQ.0) GO TO 199
      LENS(I)=NCR
3425  CONTINUE
       K1=LENS(1)
       K2=LENS(2)
       K3=LENS(3)
       K4=LENS(4)
       K5=LENS(5)
      WRITE(6,2356) NUMBER
2356  FORMAT(' THE FOLLOWING FUNCTIONAL GROUP(S) IS(ARE) INCLUDED '
     1      /,1X,5(A10,1X))


      DO 23400 N=1, NSIZE
	DO 900 K=0,31
	I=(N-1)*32+(K+1)
      IF(MOD(I,1000).EQ.0) WRITE(6,1000) I,NUMANS
1000  FORMAT(' PASSING PATTERN NUMBER ',I6,' WITH TOTAL HITS =',I6)
900	CONTINUE
	NTABLE=TABLE(N)
	IF (NTABLE.EQ.0) GO TO 23400
	DO 23300 J=0,31
	I=(N-1)*32+(J+1)
	MASK=IBITS(NTABLE,J,1)
	IF (MASK.EQ.0) GO TO 23300
      READ(20,REC=I,ERR=401) STUFF,ELEM
      IF(ITYPE.EQ.2) GO TO 9977
      GO TO (1001,1002,1003,1004,1005),NUM_EL
1001  IF(INDEX(ELEM,NUMBER(1)(1:K1)).NE.0) THEN
             NUMANS=NUMANS+1
D             WRITE(6,202) ELEM
202	FORMAT (1X,A)
             GO TO 23300
      ENDIF
      TABLE(N)=IBCLR(TABLE(N),J)
      GO TO 23300
1002  CONTINUE
      IF((INDEX(ELEM,NUMBER(1)(1:K1)).NE.0).AND.
     1   (INDEX(ELEM,NUMBER(2)(1:K2)).NE.0)) THEN
             NUMANS=NUMANS+1
D             WRITE(6,202) ELEM
             GO TO 23300
      ENDIF
      TABLE(N)=IBCLR(TABLE(N),J)
      GO TO 23300
1003  CONTINUE
       IF((INDEX(ELEM,NUMBER(1)(1:K1)).NE.0).AND.
     1    (INDEX(ELEM,NUMBER(2)(1:K2)).NE.0).AND.
     2    (INDEX(ELEM,NUMBER(3)(1:K3)).NE.0))THEN
             NUMANS=NUMANS+1
D             WRITE(6,202) ELEM
             GO TO 23300
      ENDIF
      TABLE(N)=IBCLR(TABLE(N),J)
      GO TO 23300
1004  CONTINUE
      IF((INDEX(ELEM,NUMBER(1)(1:K1)).NE.0).AND.
     1   (INDEX(ELEM,NUMBER(2)(1:K2)).NE.0).AND.
     2   (INDEX(ELEM,NUMBER(3)(1:K3)).NE.0).AND.
     3   (INDEX(ELEM,NUMBER(4)(1:K4)).NE.0))THEN
D             WRITE(6,202) ELEM
             NUMANS=NUMANS+1
             GO TO 23300
      ENDIF
      TABLE(N)=IBCLR(TABLE(N),J)
      GO TO 23300
1005  CONTINUE
      IF((INDEX(ELEM,NUMBER(1)(1:K1)).NE.0).AND.
     1   (INDEX(ELEM,NUMBER(2)(1:K2)).NE.0).AND.
     2   (INDEX(ELEM,NUMBER(3)(1:K3)).NE.0).AND.
     3   (INDEX(ELEM,NUMBER(4)(1:K4)).NE.0).AND.
     4   (INDEX(ELEM,NUMBER(5)(1:K5)).NE.0))THEN
D             WRITE(6,202) ELEM
             NUMANS=NUMANS+1
             GO TO 23300
      ENDIF
      TABLE(N)=IBCLR(TABLE(N),J)
      GO TO 23300
9977  CONTINUE
1009  DO 6000 II=1,NUM_EL
      IF(INDEX(ELEM,NUMBER(II)(1:LENS(II))).NE.0) THEN
D             WRITE(6,202) ELEM
             NUMANS=NUMANS+1
             GO TO 23300
      ENDIF
6000  CONTINUE
      TABLE(N)=IBCLR(TABLE(N),J)
23300	CONTINUE
23400 CONTINUE
401   WRITE(6,402)
402   FORMAT(' TASK COMPLETED')
      IF(NUMANS.EQ.0) THEN
                      WRITE(6,700)
700   FORMAT(' THIS IS A VERY STRANGE RESULT--THERE ARE NO ANSWERS'/
     110X,'RATHER THAN GIVING YOU AN EMPTY SET, THIS SELECTION'/
     210X,'IS BEING IGNORED--THE RESULTS ARE BEING RESET AS BEFORE.')
      CALL GET(TABLE,ISIZE,NSIZE)
      ENDIF
      CALL PUT(TABLE,ISIZE,NSIZE)
D      KEY=LIB$SPAWN('$ SET TERM/WIDTH=80')
C
C
C
20    STOP 'END OF CHEMISTRY SELECTION'
      END
