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