File SIMUL.MA (MACREL macro assembler source file)

Directory of image this file is from
This file as a plain text file

	SUBROUTINE SIMUL(N,EP,INDIC)
	COMMON IBUFF(255),DUM(85),MANU,IBLK,CP,CV,CF
	COMMON/BLK1/VOLN(100),VOLX(100),FLON(110),FLOX(110),PRSN(100)
	COMMON/BLK2/ACCN(100),ACCX(100),PRSX(100)
	COMMON/BLK3/INEG,IPOS,IDIM,ITMP,IDIM1,IPAS,ISTOP,IREC
	COMMON/BLK4/HOLD(30),K,BUFF(1400),X,Y,APOS,J
	COMMON/BLK5/A(5,5),COEF(4),COV(5,5),COR(5,5),A21(4)
	COMMON/BLK6/SD(5),A12(4),CEPT,DET,EPS,SX(5),SXY(5),SY
	DIMENSION IROW(10),JCOL(10),JORD(10),Y1(10)
	MAX=N
	IF(INDIC.GE.0)MAX=N+1
C	.....N > 10?....
	IF(N.LE.10)GO TO 5
	WRITE(4,200)
	DET=0.
	RETURN
C	...BEGIN ELIMINATION PROC
  5	DET=1.
	DO 18 K=1,N
	KM1=K-1
C	.....SEARCH FOR PIVOT ELEMENT
	PIVOT=0.
	DO 11 I=1,N
	DO 11 JJ=1,N
C	.....SCAN IROW AND JCOL VECTORS FOR BAD PIVOT SUBSCRIPTS
	IF(K.EQ.1)GO TO 9
	DO 8 ISCAN=1,KM1
	DO 8 JSCAN=1,KM1
	IF(I.EQ.IROW(ISCAN))GO TO 11
	IF(JJ.EQ.JCOL(JSCAN))GO TO 11
  8	CONTINUE
  9	IF(ABS(A(I,JJ)).LE.ABS(PIVOT))GO TO 11
	PIVOT=A(I,JJ)
	IROW(K)=I
	JCOL(K)=JJ
  11	CONTINUE
C	.....INSURE PIVOT > EPS
	IF(ABS(PIVOT).GT.EP)GO TO 13
	DET=0.
	RETURN
C	.....UPDATE DETERMINANT
  13	IROWK=IROW(K)
	JCOLK=JCOL(K)
	DET=DET*PIVOT
C	.....NORMALIZE PIVOT ROW ELEMENTS
	DO 14 JJ=1,MAX
  14	A(IROWK,JJ)=A(IROWK,JJ)/PIVOT
C	.....COMPLETE ELIMINATION AND DEVELOP INVERSE
	A(IROWK,JCOLK)=1./PIVOT
	DO 18 I=1,N
	AIJCK=A(I,JCOLK)
	IF(I.EQ.IROWK)GO TO 18
	A(I,JCOLK)=-AIJCK/PIVOT
	DO 17 JJ=1,MAX
  17	IF(JJ.NE.JCOLK)A(I,JJ)=A(I,JJ)-AIJCK*A(IROWK,JJ)
  18	CONTINUE
C	.....ORDER SOLNS(IF ANY) AND CREATE JORD VECTOR
	DO 20 I=1,N
	IROWI=IROW(I)
	JCOLI=JCOL(I)
	JORD(IROWI)=JCOLI
  20	IF(INDIC.GE.0)COEF(JCOLI)=A(IROWI,MAX)
C	.....ADJUST SIGN OF DETERMINANT
	INTCH=0
	NM1=N-1
	DO 22 I=1,NM1
	IP1=I+1
	DO 22 JJ=IP1,N
	IF(JORD(JJ).GE.JORD(I))GO TO 22
	JTEMP=JORD(JJ)
	JORD(JJ)=JORD(I)
	JORD(I)=JTEMP
	INTCH=INTCH+1
  22	CONTINUE
	IF(INTCH/2*2.NE.INTCH)DET=-DET
C	.....IF INDIC POSITIVE RETURN WITH RESULTS
	IF(INDIC.LE.0)GO TO 26
	RETURN
C	.....IF INDIC NEGATIVE OR ZERO, UNSCRAMBLE THE INVERSE
C	.....FIRST BY ROWS
  26	DO 28 JJ=1,N
	DO 27 I=1,N
	IROWI=IROW(I)
	JCOLI=JCOL(I)
  27	Y1(JCOLI)=A(IROWI,JJ)
	DO 28 I=1,N
  28	A(I,JJ)=Y1(I)
C	.....THEN BY COLUMNS
	DO 30 I=1,N
	DO 29 JJ=1,N
	IROWJ=IROW(JJ)
	JCOLJ=JCOL(JJ)
  29	Y1(IROWJ)=A(I,JCOLJ)
	DO 30 JJ=1,N
  30	A(I,JJ)=Y1(JJ)
C	.....RETURN FOR INDIC NEGATIVE OR ZERO
	RETURN
C	...IT'S TOOOOOOO BIG
  200	FORMAT('  N TOO BIG')
	END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search