1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
| C***********************************************************C
C SOLVE LINEAR SYSTEM VIA GAUSSIAN ELIMINATION C
C ORDER UP TO 10 C
C ( 10.01.1979 K. BANSE ) C
C (SACLAY - HPCCD - 1982/84) C
C***********************************************************C
SUBROUTINE LNSYS(ARRAY,X,NORDER,IERR)
DIMENSION ARRAY(10,11), X(10)
DOUBLE PRECISION ARRAY, SAVE,RMAX,X
IERR=0
DO 100 K=1,NORDER-1
SAVE=0.D0
DO 30 J=K,NORDER
RMAX=DABS(ARRAY(J,K))
IF(SAVE.GE.RMAX)GO TO 30
SAVE=RMAX
MXROW=J
30 CONTINUE
DO 40 J=K,NORDER+1
SAVE=ARRAY(K,J)
ARRAY(K,J)=ARRAY(MXROW,J)
ARRAY(MXROW,J)=SAVE
40 CONTINUE
IF(DABS(ARRAY(K,K)).LT.10.D-12) GO TO 300
DO 60 I=K+1,NORDER
SAVE=ARRAY(I,K)/ARRAY(K,K)
ARRAY(I,K)=0.D0
DO 61 J=K+1,NORDER+1
ARRAY(I,J)=ARRAY(I,J)-SAVE*ARRAY(K,J)
61 CONTINUE
60 CONTINUE
100 CONTINUE
X(NORDER)=ARRAY(NORDER,NORDER+1)/ARRAY(NORDER,NORDER)
DO 200 NN=2,NORDER
I=NORDER+1-NN
SAVE=ARRAY(I,NORDER+1)
DO 150 J=I+1,NORDER
SAVE=SAVE-ARRAY(I,J)*X(J)
150 CONTINUE
X(I)=SAVE/ARRAY(I,I)
200 CONTINUE
GO TO 333
300 DO 310 N=1,NORDER
X(N)=0.0
310 CONTINUE
IERR=-1
333 RETURN
END |
Partager