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