C C .................................................................. C C SUBROUTINE GELG C C PURPOSE C TO SOLVE A GENERAL SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS. C C USAGE C CALL GELG(R,A,M,N,EPS,IER) C C DESCRIPTION OF PARAMETERS C R - THE M BY N MATRIX OF RIGHT HAND SIDES. (DESTROYED) C ON RETURN R CONTAINS THE SOLUTION OF THE EQUATIONS. C A - THE M BY M COEFFICIENT MATRIX. (DESTROYED) C M - THE NUMBER OF EQUATIONS IN THE SYSTEM. C N - THE NUMBER OF RIGHT HAND SIDE VECTORS. C EPS - AN INPUT CONSTANT WHICH IS USED AS RELATIVE C TOLERANCE FOR TEST ON LOSS OF SIGNIFICANCE. C IER - RESULTING ERROR PARAMETER CODED AS FOLLOWS C IER=0 - NO ERROR, C IER=-1 - NO RESULT BECAUSE OF M LESS THAN 1 OR C PIVOT ELEMENT AT ANY ELIMINATION STEP C EQUAL TO 0, C IER=K - WARNING DUE TO POSSIBLE LOSS OF SIGNIFI- C CANCE INDICATED AT ELIMINATION STEP K+1, C WHERE PIVOT ELEMENT WAS LESS THAN OR C EQUAL TO THE INTERNAL TOLERANCE EPS TIMES C ABSOLUTELY GREATEST ELEMENT OF MATRIX A. C C REMARKS C INPUT MATRICES R AND A ARE ASSUMED TO BE STORED COLUMNWISE C IN M*N RESP. M*M SUCCESSIVE STORAGE LOCATIONS. ON RETURN C SOLUTION MATRIX R IS STORED COLUMNWISE TOO. C THE PROCEDURE GIVES RESULTS IF THE NUMBER OF EQUATIONS M IS C GREATER THAN 0 AND PIVOT ELEMENTS AT ALL ELIMINATION STEPS C ARE DIFFERENT FROM 0. HOWEVER WARNING IER=K - IF GIVEN - C INDICATES POSSIBLE LOSS OF SIGNIFICANCE. IN CASE OF A WELL C SCALED MATRIX A AND APPROPRIATE TOLERANCE EPS, IER=K MAY BE C INTERPRETED THAT MATRIX A HAS THE RANK K. NO WARNING IS C GIVEN IN CASE M=1. C C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED C NONE C C METHOD C SOLUTION IS DONE BY MEANS OF GAUSS-ELIMINATION WITH C COMPLETE PIVOTING. C C .................................................................. C SUBROUTINE GELG(R,A,M,N,EPS,IER) C C DIMENSION A(1),R(1) IF(M)23,23,1 C C SEARCH FOR GREATEST ELEMENT IN MATRIX A 1 IER=0 PIV=0. MM=M*M NM=N*M DO 3 L=1,MM TB=ABS(A(L)) IF(TB-PIV)3,3,2 2 PIV=TB I=L 3 CONTINUE TOL=EPS*PIV C A(I) IS PIVOT ELEMENT. PIV CONTAINS THE ABSOLUTE VALUE OF A(I). C C C START ELIMINATION LOOP LST=1 DO 17 K=1,M C C TEST ON SINGULARITY IF(PIV)23,23,4 4 IF(IER)7,5,7 5 IF(PIV-TOL)6,6,7 6 IER=K-1 7 PIVI=1./A(I) J=(I-1)/M I=I-J*M-K J=J+1-K C I+K IS ROW-INDEX, J+K COLUMN-INDEX OF PIVOT ELEMENT C C PIVOT ROW REDUCTION AND ROW INTERCHANGE IN RIGHT HAND SIDE R DO 8 L=K,NM,M LL=L+I TB=PIVI*R(LL) R(LL)=R(L) 8 R(L)=TB C C IS ELIMINATION TERMINATED IF(K-M)9,18,18 C C COLUMN INTERCHANGE IN MATRIX A 9 LEND=LST+M-K IF(J)12,12,10 10 II=J*M DO 11 L=LST,LEND TB=A(L) LL=L+II A(L)=A(LL) 11 A(LL)=TB C C ROW INTERCHANGE AND PIVOT ROW REDUCTION IN MATRIX A 12 DO 13 L=LST,MM,M LL=L+I TB=PIVI*A(LL) A(LL)=A(L) 13 A(L)=TB C C SAVE COLUMN INTERCHANGE INFORMATION A(LST)=J C C ELEMENT REDUCTION AND NEXT PIVOT SEARCH PIV=0. LST=LST+1 J=0 DO 16 II=LST,LEND PIVI=-A(II) IST=II+M J=J+1 DO 15 L=IST,MM,M LL=L-J A(L)=A(L)+PIVI*A(LL) TB=ABS(A(L)) IF(TB-PIV)15,15,14 14 PIV=TB I=L 15 CONTINUE DO 16 L=K,NM,M LL=L+J 16 R(LL)=R(LL)+PIVI*R(L) 17 LST=LST+M C END OF ELIMINATION LOOP C C C BACK SUBSTITUTION AND BACK INTERCHANGE 18 IF(M-1)23,22,19 19 IST=MM+M LST=M+1 DO 21 I=2,M II=LST-I IST=IST-LST L=IST-M L=A(L)+.5 DO 21 J=II,NM,M TB=R(J) LL=J DO 20 K=IST,MM,M LL=LL+1 20 TB=TB-A(K)*R(LL) K=J+L R(J)=R(K) 21 R(K)=TB 22 RETURN C C C ERROR RETURN 23 IER=-1 RETURN END