Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0025/lineq.for
There is 1 other file named lineq.for in the archive. Click here to see a list.
00100	C	LINEQ*****SOLUTION OF SIMULTANEOUS LINEAR
00110	C	      EQUATIONS     GAUSSIAN ELIMINATION
00120		SUBROUTINE LINEQ(A,B,NAARG,NBARG)
00130		DIMENSION A(25,100),B(25,100)
00140	1	NA = NAARG
00150		NB = NBARG
00160		DO 291 J1 = 1,NA
00170	C	FIND REMAINING ROW CONTAINING LARGEST ABSOLUTE
00180	C	VALUE IN PIVOTALCOLUMN
00190	101	TEMP = 0.0
00200		DO 121 J2 = J1,NA
00210		IF(ABS(A(J2,J1))-TEMP) 121,111,111
00220	111	TEMP = ABS(A(J2,J1))
00230		IBIG = J2
00240	121	CONTINUE
00250		IF(IBIG-J1)5001,201,131
00260	C	REARRANGE ROWS TO PLACE LARGEST ABSOLUTE
00270	C	VALUE IN PIVOT POSITION
00280	131	DO 141 J2 = J1,NA
00290		TEMP = A(J1,J2)
00300		A(J1,J2)=A(IBIG,J2)
00310	141	A(IBIG,J2) = TEMP
00320		DO 161 J2=1,NB
00330		TEMP=B(J1,J2)
00340		B(J1,J2)=B(IBIG,J2)
00350	161	B(IBIG,J2) = TEMP
00360	C	COMPUTE COEFFICIENTS IN PIVOTAL ROW
00370	201	TEMP = A(J1,J1)
00380		DO 221 J2 = J1,NA
00390	221	A(J1,J2)=A(J1,J2)/TEMP
00400		DO 231 J2=1,NB
00410	231	B(J1,J2)=B(J1,J2)/TEMP
00420		IF(J1-NA)236,301,5001
00430	C	COMPUTE NEW COEFFICIENTS IN REMAINING ROWS
00440	236	N1 = J1 + 1
00450		DO 281 J2 = N1,NA
00460		TEMP = A(J2,J1)
00470		DO 241 J3 = N1,NA
00480	241	A(J2,J3)=A(J2,J3)-TEMP*A(J1,J3)
00490			DO 251 J3 = 1,NB
00500	251	B(J2,J3)=B(J2,J3)-TEMP*B(J1,J3)
00510	281	CONTINUE
00520	291	CONTINUE
00530	C	OBTAIN SOLUTIONS
00540	301	IF(NA-1)5001,5001,311
00550	311	DO 391 J1=1,NB
00560		N1 = NA
00570	321	DO 341 J2= N1,NA
00580	341	B(N1-1,J1) = B(N1-1,J1)-B(J2,J1)*A(N1-1,J2)
00590		N1 = N1-1
00600		IF(N1-1)5001,391,321
00610	391	CONTINUE
00620	5001	CONTINUE
00630		END