INTEGER * 4 FUNCTION PRIME(I)
INTEGER * 4 I
INTEGER FD,JUNK
INTEGER OPEN,MAPFD
INTEGER AAAAA0(13)
DATA AAAAA0/189,225,245,248,189,175,240,242,233,237,229,243,0/
IF((I.LT.1))GOTO 10001
IF((I.GT.78498))GOTO 10001
GOTO 10000
10001 PRIME=0
RETURN
10000 FD=OPEN(AAAAA0,1)
IF((FD.NE.-3))GOTO 10002
PRIME=0
RETURN
10002 CALL PRWF$$(:1+:10,MAPFD(FD),LOC(PRIME),2,(I-1)*2,JUNK,JUNK)
CALL CLOSE(FD)
RETURN
END
INTEGER * 4 FUNCTION INVMOD(X1,X0)
INTEGER * 4 X1,X0
INTEGER * 4 XI,XIM1,XIM2
INTEGER * 4 AI,AIM1,AIM2,BI,BIM1,BIM2
INTEGER * 4 FACTOR
XIM2=X0
AIM2=1
BIM2=0
XIM1=X1
AIM1=0
BIM1=1
10003 IF((XIM2.LE.XIM1))GOTO 10004
FACTOR=XIM2/XIM1
XI=MOD(XIM2,XIM1)
AI=AIM2-FACTOR*AIM1
BI=BIM2-FACTOR*BIM1
GOTO 10005
10004 IF((XIM1.LE.XIM2))GOTO 10006
FACTOR=XIM1/XIM2
XI=MOD(XIM1,XIM2)
AI=AIM1-FACTOR*AIM2
BI=BIM1-FACTOR*BIM2
GOTO 10007
10006 INVMOD=-3
RETURN
10007 CONTINUE
10005 XIM2=XIM1
AIM2=AIM1
BIM2=BIM1
XIM1=XI
AIM1=AI
BIM1=BI
IF((XI.NE.1))GOTO 10003
IF((BI.GT.0))GOTO 10008
INVMOD=BI+X0
RETURN
10008 INVMOD=BI
RETURN
END
INTEGER * 4 FUNCTION PWRMOD(P,EAAAA0,N)
INTEGER * 4 P,EAAAA0,N
INTEGER I
INTEGER * 4 RESULT
RESULT=1
I=1
GOTO 10011
10009 I=I+(1)
10011 IF((I.GT.32))GOTO 10010
IF((RT(RS(EAAAA0,32-I),1).NE.0))GOTO 10012
RESULT=MOD(RESULT*RESULT,N)
GOTO 10013
10012 RESULT=MOD(MOD(RESULT*RESULT,N)*P,N)
10013 GOTO 10009
10010 PWRMOD=RESULT
RETURN
END
INTEGER * 4 FUNCTION GCD(X0,X1)
INTEGER * 4 X0,X1
INTEGER * 4 XI,XIM1,XIM2
INTEGER * 4 MAX0,MIN0,IABS
XIM2=MAX0(X0,X1)
XIM1=MIN0(X0,X1)
10014 IF((XIM2.LE.XIM1))GOTO 10015
XI=MOD(XIM2,XIM1)
GOTO 10016
10015 XI=MOD(XIM1,XIM2)
10016 XIM2=XIM1
XIM1=XI
IF((XI.NE.0))GOTO 10014
GCD=IABS(XIM2)
RETURN
END
INTEGER FUNCTION SETCR0(SET,SIZE)
INTEGER SET
INTEGER SIZE
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER DSGET
SET=DSGET(((SIZE+16-1)/16)+1)
MEMAA0(SET)=SIZE
CALL SETIN0(SET)
SETCR0=SET
RETURN
END
SUBROUTINE SETRE0(SET)
INTEGER SET
CALL DSFREE(SET)
RETURN
END
SUBROUTINE SETIN0(SET)
INTEGER SET
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER I,SIZE
SIZE=((MEMAA0(SET)+16-1)/16)
DO 10017 I=1,SIZE
MEMAA0(SET+I)=0
10017 CONTINUE
10018 RETURN
END
SUBROUTINE SETCO0(SOURCE,DESTI0)
INTEGER SOURCE,DESTI0
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER I,SIZE
SIZE=((MIN0(MEMAA0(SOURCE),MEMAA0(DESTI0))+16-1)/16)
DO 10019 I=1,SIZE
MEMAA0(DESTI0+I)=MEMAA0(SOURCE+I)
10019 CONTINUE
10020 RETURN
END
SUBROUTINE SETIO0(SET1,SET2,DESTI0)
INTEGER SET1,SET2,DESTI0
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER I,SIZE
INTEGER AND
SIZE=((MIN0(MEMAA0(DESTI0),MIN0(MEMAA0(SET1),MEMAA0(SET2)))+16-1)/
*16)
DO 10021 I=1,SIZE
MEMAA0(DESTI0+I)=AND(MEMAA0(SET1+I),MEMAA0(SET2+I))
10021 CONTINUE
10022 RETURN
END
SUBROUTINE SETUN0(SET1,SET2,DESTI0)
INTEGER SET1,SET2,DESTI0
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER I,SIZE
INTEGER OR
SIZE=((MIN0(MEMAA0(DESTI0),MIN0(MEMAA0(SET1),MEMAA0(SET2)))+16-1)/
*16)
DO 10023 I=1,SIZE
MEMAA0(DESTI0+I)=OR(MEMAA0(SET1+I),MEMAA0(SET2+I))
10023 CONTINUE
10024 RETURN
END
SUBROUTINE SETIP0(ELEME0,SET)
INTEGER ELEME0
INTEGER SET
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER WORD
INTEGER OR,LS
IF((ELEME0.GT.MEMAA0(SET)))GOTO 10026
IF((ELEME0.LT.1))GOTO 10026
GOTO 10025
10026 CALL ERROR('in set_insert: element out of range.')
10025 WORD=SET+(ELEME0-1)/16+1
MEMAA0(WORD)=OR(MEMAA0(WORD),LS(1,16-1-MOD(ELEME0-1,16)))
RETURN
END
SUBROUTINE SETDE0(ELEME0,SET)
INTEGER ELEME0
INTEGER SET
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER WORD
INTEGER AND,NOT,LS
IF((ELEME0.GT.MEMAA0(SET)))GOTO 10028
IF((ELEME0.LT.1))GOTO 10028
GOTO 10027
10028 CALL ERROR('in set_delete: element out of range.')
10027 WORD=SET+(ELEME0-1)/16+1
MEMAA0(WORD)=AND(MEMAA0(WORD),NOT(LS(1,16-1-MOD(ELEME0-1,16))))
RETURN
END
INTEGER FUNCTION SETEL0(ELEME0,SET)
INTEGER ELEME0
INTEGER SET
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER WORD
INTEGER AND,LS
IF((ELEME0.GT.MEMAA0(SET)))GOTO 10030
IF((ELEME0.LT.1))GOTO 10030
GOTO 10029
10030 CALL ERROR('in set_element: element out of range.')
10029 WORD=SET+(ELEME0-1)/16+1
IF((AND(MEMAA0(WORD),LS(1,16-1-MOD(ELEME0-1,16))).EQ.0))GOTO 10031
SETEL0=1
RETURN
10031 SETEL0=0
RETURN
END
LOGICAL FUNCTION SETEQ0(SET1,SET2)
INTEGER SET1,SET2
LOGICAL SETSU0
SETEQ0=SETSU0(SET1,SET2).AND.SETSU0(SET2,SET1)
RETURN
END
LOGICAL FUNCTION SETSU0(SET1,SET2)
INTEGER SET1,SET2
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER I,SIZE,SIZE1,SIZE2
INTEGER AND,NOT,SETEL0
SIZE1=MEMAA0(SET1)
SIZE2=MEMAA0(SET2)
IF((SIZE1.LE.SIZE2))GOTO 10032
I=SIZE2+1
GOTO 10035
10033 I=I+(1)
10035 IF((I.GT.SIZE1))GOTO 10034
IF((SETEL0(I,SET1).NE.1))GOTO 10036
SETSU0=.FALSE.
RETURN
10036 GOTO 10033
10034 CONTINUE
10032 IF((SIZE2.LE.SIZE1))GOTO 10037
I=SIZE1+1
GOTO 10040
10038 I=I+(1)
10040 IF((I.GT.SIZE2))GOTO 10039
IF((SETEL0(I,SET2).NE.1))GOTO 10041
SETSU0=.FALSE.
RETURN
10041 GOTO 10038
10039 CONTINUE
10037 SIZE=((MIN0(SIZE1,SIZE2)+16-1)/16)
DO 10042 I=1,SIZE
IF((AND(MEMAA0(SET1+I),NOT(MEMAA0(SET2+I))).EQ.0))GOTO 10044
SETSU0=.FALSE.
RETURN
10044 CONTINUE
10042 CONTINUE
10043 SETSU0=.TRUE.
RETURN
END
SUBROUTINE SETSV0(SET1,SET2,DESTI0)
INTEGER SET1,SET2,DESTI0
INTEGER MEMAA0(1)
COMMON /DS$MEM/MEMAA0
INTEGER I,SIZE
INTEGER AND,NOT
SIZE=((MIN0(MEMAA0(DESTI0),MIN0(MEMAA0(SET1),MEMAA0(SET2)))+16-1)/
*16)
DO 10045 I=1,SIZE
MEMAA0(DESTI0+I)=AND(MEMAA0(SET1+I),NOT(MEMAA0(SET2+I)))
10045 CONTINUE
10046 RETURN
END
C ---- Long Name Map ----
C setequal seteq0
C setdelete setde0
C setcreate setcr0
C setintersect setio0
C element eleme0
C destination desti0
C setunion setun0
C E eaaaa0
C Mem memaa0
C setinit setin0
C setremove setre0
C setsubtract setsv0
C setelement setel0
C setcopy setco0
C setinsert setip0
C setsubset setsu0