SUBROUTINE SERHIT (IRSTST) C DETERMINE RSPACE HITS C C IRSTST RSPACE BIT MAP FOR THE COMPOUND TO BE TESTED C C CALLED BY: SERSRC C CALLS: NONE C INCLUDE 'SEARCH.INC' DIMENSION IRSTST(11),LFSET(40) C ZERO COUNTERS ITOTBT = 0 !ZERO BIT COUNTER IDHCNT = 0 !DOUBLET COUNTER DO 5 I=1,3 5 IRCNT(I) = 0 !ZERO DIRECT,-,+ COUNTERS DO 7 I=1,NSPACE 7 LFSET(I) = .FALSE. !CLEAR BIT SET FLAGS C CONSIDER ALL SINGLET AND DOUBLET BITS BEFORE THE MAP AS BEING SET C FIND HIGHEST BIT SET IN IRSTST (IHIGH) IHIGH = IRBMAX DO 50 I=11,1,-1 IF (IRSTST(I) .EQ. 0) THEN IHIGH = IHIGH - 16 !NO BITS SET IN WORD ELSE C HIGHEST BIT IS IN THE CURRENT IRSTST LOCATION C FIND THE BIT THAT IS SET DO 25 J=16,1,-1 IF ((IRSTST(I).AND.IBITS(J)) .NE. 0) THEN C BIT WAS FOUND, NOW DETERMINE WHICH ENTERED RSPACES ARE ABOVE THIS BIT DO 10 II=1,NSPACE IF ((ISPNUM(II)-1) .GT. IHIGH) THEN LFSET(II) = .TRUE. !SET BIT SET FLAG ITOTBT = ITOTBT + 1 !COUNT # BITS SET END IF 10 CONTINUE C DETERMINE WHICH DOUBLET ARE ABOVE THIS BIT DO 20 II=1,IDCNT IF ((ISDNUM(II)-1) .GT. IHIGH) THEN C LFSET MAY ALREADY BE TRUE BECAUSE SINGLET WAS SET LFSET(II) = .TRUE. !SET BIT SET FLAG ITOTBT = ITOTBT + 1 !COUNT # BITS SET END IF 20 CONTINUE GOTO 60 END IF IHIGH = IHIGH - 1 !HIGHEST BIT 25 CONTINUE END IF 50 CONTINUE C NOT RSPACES BITS ARE SET, ENTRY IS BLANK SO RETURN RETURN C NOW SEARCH FOR BIT MATCHES C SET # OF BITS SO THAT AT LEAST 1 REAL BIT MATCH MUST OCCUR 60 ITOTBT = MIN0(ITOTBT,IHMIN-1) DO 100 I=1,NSPACE LSING = .FALSE. !FLAG FOR SINGLET MATCH C TEST SINGLETS FOR A MATCH DO 75 J=1,3 IF (IRLOC(J,I) .GT. 0) THEN IF ((IRSPAC(J,I) .AND. IRSTST(IRLOC(J,I))) .NE. 0) THEN IRCNT(J) = IRCNT(J) + 1 !COUNT DIRECT,LEFT OR RIGHT LFSET(I) = .TRUE. !SET BIT SET FLAG LSING = .TRUE. !SET SINGLET FLAG END IF END IF 75 CONTINUE C TEST FOR DOUBLETS ONLY 80 LDOUB = .FALSE. !DOUBLET SET FLAG DO 90 J=4,6 IF (IRLOC(J,I) .GT. 0) THEN IF ((IRSPAC(J,I) .AND. IRSTST(IRLOC(J,I))) .NE. 0) THEN LFSET(I) = .TRUE. !SET BIT SET FLAG LDOUB = .TRUE. !SET DOUBLET FLAG IT = J-3 IRCNT(IT) = IRCNT(IT) + 1 !COUNT DIRECT,LEFT OR RIGHT END IF END IF 90 CONTINUE C COUNT BITS IF (LSING) ITOTBT = ITOTBT + 1 IF (LDOUB) ITOTBT = ITOTBT + 1 C DOUBLET ONLY COUNTER IF (.NOT. LSING .AND. LDOUB) IDHCNT = IDHCNT + 1 100 CONTINUE C DETERMINE FIGURE OF MERIT SUM C EACH ENTERED VALUE IS WEIGHTED SO THE SMALLEST HAS THE HIGHEST C WEIGHT. IFOM IS SET TO THE SUM OF THE BIT WEIGHTS OF THE BITS C THAT WERE SET (LFSET = TRUE). IFOM = 0 IVAL = NSPACE DO 150 I=1,NSPACE IF (LFSET(I)) IFOM = IFOM + IVAL IVAL = IVAL - 1 150 CONTINUE RETURN END