C	PROGRAM SPACE_GROUP
C
C	SELECTION BY SPACE GROUP NUMBER

	INTEGER*4 TABLE(2000),NTABLE,MASK
	INTEGER*2 NSPGC,COMP
	CHARACTER*46 STUFF
        CHARACTER*25 MORESTUFF
        CHARACTER*1 ANS

      WRITE(6,123)
123   FORMAT(' VAX VERSION AUG 1, 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 SPACE GROUP'/
     1  10X,'AND SYSTEM (BY SPECIFYING A RANGE OF SPACE GROUPS).'//)
11233 WRITE(6,11234)
11234 FORMAT(' SINCE THE CHEMICAL ELEMENTS ARE "INDEXED", SEARCHES'/
     1  10X,'ON ELEMENTS ARE VERY FAST.  SEARCHES ON FUNCTIONAL'/
     2  10X,'GROUPS, SPACE GROUPS, AND/OR SYSTEM 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

      WRITE(6,11556)
11556 FORMAT(/' THE FOLLOWING TABLE MAY BE OF USE FOR SEARCHES'
     1 ,1X,'ON SYSTEMS.'/
     1  10X,'THIS HOWEVER PRESENTS A PROBLEM, SINCE IF THE SYSTEM'/
     1  10X,'IS KNOWN, BUT THE SPACE GROUP IS NOT, THE SPACE GROUP'/
     1  10X,'IS ENTERED A ZERO. THERE IS ANOTHER WAY, ENTER THE'/
     1  10X,'VALUE IN THE (), IF YOU WANT TO IGNOR THE SPACE GROUP'/
     1  10X,'AND SEE MORE, THEN REVIEW AND SELECT LATER ON SPACE'
     1   1X,'GROUP.'//
     1  10X,'   SYSTEM          RANGE      CODE'//
     1  10X,'   ANORTHIC         1,2       (-1)'/
     1  10X,'   MONOCLINIC       3,15      (-2)'/
     1  10X,'   ORTHORHOMBIC    16,74      (-3)'/
     1  10X,'   TETRAGONAL      75,142     (-4)'/
     1  10X,'   RHOMBOHEDRAL   143,167     (-5)'/
     1  10X,'   HEXAGONAL      168,194     (-6)'/
     1  10X,'   CUBIC          195,230     (-7)'//)
199   WRITE(6,200)
200   FORMAT(' PLEASE ENTER THE SPACE GROUP, OR SPACE GROUP'/
	110X,'RANGE (1,230), OR CODE IN WHICH YOU ARE INTERESTED:  ',$)
      READ(5,201,ERR=199,END=20) N1,N2
201   FORMAT(2I)
C     THIS LOOP CHECK IF 'SYSTEM' REQUEST
      IF(N1.LT.0) THEN
                  IF(N1.LT.(-7).OR.N1.GT.(-1)) GO TO 199
C
C     INTERESTING PROBLEM HERE
C     HARLOW HAS THEM CODED 1 TRI (ANORTHIC)
C                           2 MONO
C                           3 ORTHO
C                           4 TETR
C                           5 HEX
C                           6 RHOMB
C                           7 CUBIC
C     I WILL MAKE CONSISTANT
C
                  ITEMP=0
                  IF(N1.EQ.5) ITEMP=6
                  IF(N1.EQ.6) ITEMP=5
                  IF(ITEMP.NE.0) N1=ITEMP
                  GO TO 4000
      ENDIF
C     THIS LOOP CHECK IF 'SPACE GROUP' REQUEST
      IF(N1.LT.1.OR.N1.GT.230) GOTO 199
	IF (N2.EQ.0) N2=N1
	IF (N2.LT.1.OR.N2.GT.230.OR.N2.LT.N1) GO TO 199
4000  CONTINUE
      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,NSPGC,MORESTUFF,COMP
        IF(N1.LT.0) THEN
                    ISYS=IBITS(COMP,7,3)
C       ISYS=1 ANORTHIC
C           =2 MONO
C           =3 ORTHO
C           =4 TETRA
C           =5 HEX
C           =6 RHOMB
C           =7 CUBIC
C
C
        	IF(ISYS.EQ.IABS(N1)) THEN
                          NUMANS=NUMANS+1
                          GO TO 390
                ENDIF
	TABLE(N)=IBCLR(TABLE(N),J)
C       SYSTEM SEARCH HERE
C
C
        ENDIF
      IF(N1.GT.0) THEN
	IF(NSPGC.GE.N1.AND.NSPGC.LE.N2) THEN
                          NUMANS=NUMANS+1
                          GO TO 390
        ENDIF
	TABLE(N)=IBCLR(TABLE(N),J)
      ENDIF
390   CONTINUE
400   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)
C
C
C
20    STOP 'END OF SPACE GROUP SELECTION' 
      END
