C	PROGRAM SUBFILE
C
C	SELECTION BY SUBFILE EITHER MINERAL OR ALLOY

	INTEGER*4 TABLE(2000),NTABLE,MASK
        INTEGER*2 MAT,IX,OX,MX,AX,NREC
	CHARACTER*75 STUFF
        CHARACTER*1 ANS

      WRITE(6,123)
123   FORMAT(' VAX VERSION AUG 2, 1988'/
     1  10X,'GERALD G. JOHNSON JR., MRL/PSU'/
     1  10X,'RICHARD L. HARLOW, I, DUPONT'/
     1  10X,'PROGRAM TO SELECT SUBFILE "MINERAL" OR "ALLOY"'/)
11233 WRITE(6,11234)
11234 FORMAT(' SINCE THE CHEMICAL ELEMENTS ARE "INDEXED", SEARCHES'/
     1  10X,'ON ELEMENTS ARE VERY FAST.  SEARCHES ON SUBFILES'
     1   1X,'MUST SEARCH THE'/
     3  10X,'FILE IN A SEQUENTIAL MANNER, SO THESE TYPES OF SEARCHES'/
     4  10X,'SHOULD BE DONE AFTER THE OTHER RESTRICTIVE SEARCHES'/
     5  10X,'ARE COMPLETED.'//
     6  10X,'DO YOU WANT TO CONTINUE (Y/N) ?  ',$)
      READ(5,11235) ANS
11235 FORMAT(1A1)
      KEY=STR$UPCASE(ANS,ANS)
      IF(ANS.EQ.'N') STOP 'JOB ABORTED--START AGAIN'
      IF(ANS.NE.'Y') GO TO 11233
      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

199   WRITE(6,200)
200   FORMAT(' PLEASE ENTER THE SUBFILE:'/
     1 10X,'0 QUIT'/
     1 10X,'1 MINERAL                              ( 7780/59613)'/
     1 10X,'2 ALLOY, METAL, INTERMETALLIC MATERIAL (18038/59613)'/
     1 10X,'PLEASE ENTER YOU CHOICE [1] ',$)
      READ(5,201,ERR=199,END=20) NCR,ISUB
201   FORMAT(Q,I)
      IF(NCR.EQ.0) ISUB=1
      IF(ISUB.EQ.0) STOP 'JOB ABORTED--START AGAIN'
      IF(ISUB.LT.0.OR.OISUB.GT.2) GO TO 199
      DO 400 N=1,NSIZE
	DO 405 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)
405	CONTINUE
	NTABLE=TABLE(N)
	IF (NTABLE.EQ.0) GO TO 400
	DO 390 J=0,31
	I=(N-1)*32+(J+1)
	MASK =IBITS(NTABLE,J,1)
	IF (MASK.EQ.0) GO TO 390
	READ (20,REC=I,ERR=401) STUFF,MAT,NREC
C
C
C       SOME STRANGE GOING ON HERE-----SEE NBSENCODE.FOR
C
C
D        IX=IBITS(MAT,0,1)
D        OX=IBITS(MAT,1,1)
D        MX=IBITS(MAT,2,1)
D        AX=IBITS(MAT,3,1)
D        WRITE(6,6000) IX,OX,MX,AX,NREC
        IX=IBITS(MAT,8,1)
        OX=IBITS(MAT,9,1)
        MX=IBITS(MAT,10,1)
        AX=IBITS(MAT,11,1)
D        WRITE(6,6000) IX,OX,MX,AX,NREC
6000    FORMAT(10X,4I2,I10)
	If((ISUB.EQ.1.AND.MX.EQ.1).OR.(ISUB.EQ.2.AND.AX.EQ.1)) THEN
                          NUMANS=NUMANS+1
                          GO TO 390
      ENDIF
	TABLE(N)=IBCLR(TABLE(N),J)
390	CONTINUE
400   CONTINUE
401   CONTINUE
      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)
C
C
C
20    STOP 'END OF SUBFILE SELECTION' 
      END
