C******************** START FILE GAUSSE.FOR ; GROUP FRSUBS ******************
C-------------------------------------
C  THIS FILE WILL HOLD SUBROUTINES OF FRANTIC NEUTRALS CODE
C  WHICH DON'T USE COMMON BLOCKS AND WHICH THEREFORE MAY BE
C  EXCLUDED FROM THE "OLYMPUSIZATION" PROCESS FOR NOW, ANYWAY.
C     D. MC CUNE  15 MAY 1981
C-------------------------------------
      SUBROUTINE GAUSSE(A,IROW,N,M,X,EPS,IW)
C	11/7/76
C	THIS PROGRAM WAS WRITTEN BY HARRY H. TOWNER OF THE PRINCETON
C	PLASMA PHYSICS LAB.  THIS ROUTINE WILL SOLVE A SYSTEM OF LINEAR
C	EQUATIONS BY USING GAUSS ELIMATION AND BACKWORD SUBSITUTION.
C	PARAMETER LIST:
C	A - THE N BY M AUGMENTED MATRIX WITH THE RIGHT HAND VECTOR
C		IN COLUMN M.
C	IROW - THE ROW DIMENSION OF A AS DEFINED BY THE CALLING PROGRAM.
C	N - THE # EQUATIONS.
C	M - N+1.
C	X - SOLUTION VECTOR WITH N ELEMENTS.
C	EPS - EVERY PIVOT ELEMENT MUST BE GREATER THAN EPS.  IF
C		A PIVOT ELEMENT IS SMALLER THE EQUATIONS ARE
C		DECLARED SINGULAR.
C	IW - THE LOGICAL UNIT USED FOR PRINTING.
C	NOTE THAT THE MATRIX A IS DESTROYED.
      DIMENSION A(IROW,M),X(N)
      NN=N-1
C	I FIRST REDUCE MATRIX A.
      DO 320 J=1,NN
C	MAXROW WILL GIVE THE ROW IN WHICH THE MAXIMUM ELEMENT WAS FOUND.
      MAXROW=J
      AMAX=0.E00
C	I NOW SEARCH FOR THE MAXIMUM ELEMENT IN ROW J AND GREATER.
      DO 270 I=J,N
      ABSA=ABS(A(I,J))
      IF(ABSA-AMAX) 270,270,260
260   AMAX=ABSA
      MAXROW=I
270   CONTINUE
C	NOW THE MAXIMUM ELEMENT IN COL. J HAS THE VALUE OF AMAX AND
C	IS IN ROW=MAXROW.
C	I NOW CHECK TO SEE IF EQUATIONS ARE SINGULAR.
      IF(AMAX.GT.EPS) GO TO 275
      WRITE(IW,50) MAXROW,J
50    FORMAT(1X,'A PIVOT ELEMENT WAS FOUND TO BE LESS THAN EPS',
     >' THE ELEMENT IS (',I3,',',I3,')')
C  INSERT CALL TO TRANSP abort ROUTINE
      write(iw,*) ' [... error in GAUSSE ...]'
      call bad_exit
C	IF MAXROW DOES NOT EQUAL J SWITCH ROWS.
275   IF(MAXROW.EQ.J) GO TO 290
      DO 280 I=J,M
      STORE=A(J,I)
      A(J,I)=A(MAXROW,I)
280   A(MAXROW,I)=STORE
C	ROWS ARE NOW SWITCHED.
C	I NOW NORMALIZE ROW J SO THAT A(J,J)=1.
290   ANORM=A(J,J)
      DO 295 I=J,M
295   A(J,I)=A(J,I)/ANORM
C	I NOW SUBTRACT ROW J FROM ROWS GREATER THEN J SUCH THAT
C	THERE ARE ZEROS IN COLUMN J.
      JJ=J
300   JJ=JJ+1
      ASUB=A(JJ,J)
      DO 310 I=J,M
310   A(JJ,I)=A(JJ,I)-A(J,I)*ASUB
      IF(JJ.LT.N) GO TO 300
320   CONTINUE
C	I NOW PREFORM BACKWARD SUBSITION.
      X(N)=A(N,M)/A(N,N)
      DO 340 K=1,NN
      SUM=0.E00
      L1=N-K
      DO 330 I=1,K
330   SUM=SUM+A(L1,L1+I)*X(L1+I)
340   X(L1)=A(L1,M)-SUM
      RETURN
      END
C******************** END FILE GAUSSE.FOR ; GROUP FRSUBS ******************
