C	PROGRAM DENSITY
C
C	SELECTION BY DENSITY--EITHER CAL OR MEASURED

	INTEGER*4 TABLE(2000),NTABLE,MASK
        INTEGER*2 IDMA,IDXC
	CHARACTER*48 STUFF
        CHARACTER*1 ANS

      WRITE(6,123)
123   FORMAT(' VAX VERSION JULY 29, 1988'/
     1  10X,'GERALD G. JOHNSON JR., MRL/PSU'/
     1  10X,'RICHARD L. HARLOW, I, DUPONT'/
     1  10X,'PROGRAM TO SEARCH CRYSTAL DATA FILE FOR DENSITY'/
     1  20X,'(EITHER EXPERIMENTAL OR CALCULATED).'//)
11233 WRITE(6,11234)
11234 FORMAT(' SINCE THE CHEMICAL ELEMENTS ARE "INDEXED", SEARCHES'/
     1  10X,'ON ELEMENTS ARE VERY FAST.  SEARCHES ON DENSITY'
     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 DENSITY,(RHO (LO), RHO(HIGH)'/
     1 10X,'IN WHICH YOU ARE INTERESTED:(0.0 TO 30.0)  ',$)
      READ(5,201,ERR=199,END=20) RHOLO,RHOHI
201   FORMAT(2F10.5)
      IF(RHOLO.LT.0.0.OR.RHOLO.GT.30.0) GO TO 199
      IF(RHOHI.LT.0.0.OR.RHOHI.GT.30.0) GO TO 199
      IF(RHOLO.GT.RHOHI)                GO TO 199
299   WRITE(6,300)
300   FORMAT(' DO YOU WANT IN THE FINAL LIST THOSE ENTRIES WHERE'/
     1 10X,'BOTH DENSITY MEASURED AND CALCULATED ARE ZERO ? ([Y]/N) '
     1  ,$)
      READ(5,301)NCR,ANS
301   FORMAT(Q,1A1)
      IF(NCR.EQ.0) ANS='Y'
      KEY=STR$UPCASE(ANS,ANS)
      IF(ANS.EQ.'Y'.OR.ANS.EQ.'N') GO TO 302
      GO TO 299
302   CONTINUE
      IF(ANS.EQ.'Y') IFLAG=1
      IF(ANS.EQ.'N') IFLAG=0
      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,IDMA,IDXC
C       FOLLOWING NECESSARY DUE TO OVERFLOW
        iidma=idma
        iidxc=idxc
        ISUM=iIDMA+iIDXC
        IF(ISUM.EQ.0) THEN
D                      WRITE(6,2233)
                      IF(IFLAG.EQ.1) THEN
                                     NUMANS=NUMANS+1
                                     GO TO 390
                      ENDIF
2233    FORMAT(' BOTH DENSITY MEASURED AND CALCULATED ARE ZERO')
        ENDIF
        XIDMA=IDMA
        XIDXC=IDXC
        DMA=0.001*XIDMA
        DXC=0.001*XIDXC
D        WRITE(6,2234) DMA,DXC
2234    FORMAT(2F10.3)
	IF(RHOLO.LE.DMA.AND.RHOHI.GE.DMA.OR.
     1     RHOLO.LE.DXC.AND.RHOHI.GE.DXC) THEN
                          NUMANS=NUMANS+1
                          GO TO 390
      ENDIF
	TABLE(N)=IBCLR(TABLE(N),J)
390	CONTINUE
400   CONTINUE
401   WRITE(6,5004) RHOLO,RHOHI
5004  FORMAT(//' THE DENSITY RANGE WAS ',2f8.2)
      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 DENSITY SELECTION' 
      END
