CTITLEMLNSYS -- SOLVE LINEAR SYSTEM 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. D. THOMPSON 00000020 CA DESIGNER D. D. THOMPSON 00000030 CA LANGUAGE FORTRAN 77 00000040 CA SYSTEM IBM & CRAY 00000041 CA WRITTEN 1972 00000050 C REVISED MO-DA-YR 00000060 C REVISED 05-20-85 TWH. ADAPTED TO IBM & CRAY. 00000061 C 00000070 CA 00000080 CA 00000090 CA CALL MLNSYS (PR, N, Y, IPR) 00000100 CA INPUT PR = SYSTEM MATRIX INPUT (PACKED UPPER R4 00000110 CA TRIANGULAR PART ONLY STORED BY COLUMNS) 00000120 CA INPUT N = SYSTEM DIMENSION I4 00000130 CA IN/OUT Y = INPUT VECTOR - ON RETURN, SOLUTION R4 00000140 CA VECTOR 00000150 CA INPUT IPR = PRINTER UNIT NUMBER I4 00000160 CA 00000170 CA 00000180 CA 00000190 CA THIS ROUTINE SOLVES A LINEAR SYSTEM HAVING A 00000200 CA POSITIVE-DEFINITE AND SYMMETRIC SYSTEM MATRIX. 00000210 CA 00000220 CA 00000230 C 00000240 C SUBROUTINES CALLED: MFSD 00000250 C 00000260 C EJECT 00000270 C 00000280 SUBROUTINE MLNSYS(PR,N,Y,IPR) 00000290 CAEND 00000300 C 00000310 DOUBLE PRECISION T,Q 00000320 DIMENSION PR(1),Y(1) 00000330 EPS=1.E-10 00000340 CALL MFSD(PR,N,EPS,IER) 00000350 IF(IER.LT.0) GO TO 50 00000360 IF(IER.GT.0) WRITE(IPR, 9000 ) EPS,K 00000370 Y(1)=DBLE(Y(1))/DBLE(PR(1)) 00000380 C 00000390 DO 20 00000400 * K=2,N 00000410 T=Y(K) 00000420 KQ=(K*(K-1))/2 00000430 KM1=K-1 00000440 C 00000450 DO 10 00000460 * L=1,KM1 00000470 C 00000480 10 T=T-Y(L)*DBLE(PR(L+KQ)) 00000490 C 00000500 20 Y(K)=T/DBLE(PR(K+KQ)) 00000510 C 00000520 Y(N)= Y(N)/DBLE(PR((N*(N+1))/2)) 00000530 C 00000540 DO 40 00000550 * K=2,N 00000560 J=N-K+1 00000570 JP1=J+1 00000580 T=Y(J) 00000590 C 00000600 DO 30 00000610 * L=JP1,N 00000620 C 00000630 30 T=T- Y(L)*DBLE(PR(J+(L*(L-1))/2)) 00000640 C 00000650 40 Y(J)=T/DBLE(PR((J*(J+1))/2)) 00000660 C 00000670 RETURN 00000680 C 00000690 50 WRITE(IPR, 9010 ) 00000700 STOP 00000710 C 00000720 9000 FORMAT('0***** ACCURACY WARNING--TOLLERANCE',E15.3, 00000730 * ' VIOLATED AFTER PIVOT', I5) 00000740 C 00000750 9010 FORMAT('0SINGULAR SYSTEM -- COMPUTATION STOPS') 00000760 END 00000770