Category : Miscellaneous Language Source Code
Archive   : FORTRN77.ZIP
Filename : MATINV.FOR

 
Output of file : MATINV.FOR contained in archive : FORTRN77.ZIP
SUBROUTINE MATINV(ISOL,IDSOL,NR,NC,A,MRA,KWA,DET)
C
C THIS SUBROUTINE FINDS THE INVERSE AND/OR SOLVES
C SIMULTANEOUS EQUATIONS, OR NEITHER, AND
C CALCULATES A DETERMINANT OF A REAL MATRIX.
C
DIMENSION A(1), KWA(1)
IR = NR
ISOL = 1
IDSOL = 1
IF(NR.LE.0) GO TO 330
IF((IR-MRA).GT.0) GO TO 330
IC = IABS(NC)
IF ((IC - IR).LT.0) IC = IR
IBMP = 1
JBMP = MRA
KBMP = JBMP + IBMP
NES = IR*JBMP
NET = IC*JBMP
IF(NC) 10,330,20
10 MDIV = JBMP + 1
IRIC = IR - IC
GO TO 30
20 MDIV = 1
30 MAD = MDIV
MSER = 1
KSER = IR
MZ = 1
DET = 1.0
40 PIV = 0.
I = MSER
50 IF (( I - KSER).GT.0) GO TO 70
IF((ABS(A(I))-PIV).LE.0.) GO TO 60
PIV = ABS(A(I))
IP = I
60 I = I + IBMP
GO TO 50
70 IF(PIV.EQ.0.) GO TO 340
IF(NC.LT.0) GO TO 80
I = IP-((IP - 1)/JBMP)*JBMP
J = MSER - ((MSER - 1)/JBMP)*JBMP
JJ = MSER/KBMP + 1
II = JJ + (IP -MSER)
KWA(JJ) = II
GO TO 90
80 I = IP
J = MSER
90 IF (IP - MSER) 330,120,100
100 IF ((J - NET).GT.0) GO TO 110
PSTO = A(I)
A(I) = A(J)
A(J) = PSTO
I = I + JBMP
J = J + JBMP
GO TO 100
110 DET = - DET
120 PSTO = A(MSER)
DET = DET*PSTO
130 IF (DET.eq.0.) GOTO 150
140 PSTO = 1./PSTO
GO TO 160
150 IDSOL = 1
ISOL = 2
RETURN
160 CONTINUE
A(MSER) = 1.0
I = MDIV
170 IF((I - NET).GT.0) GO TO 180
A(I) = A(I)*PSTO
I = I + JBMP
GO TO 170
180 IF((MZ - KSER).GT.0) GO TO 210
IF((MZ-MSER).EQ.0) GO TO 200
I = MAD
J = MDIV
PSTO = A(MZ)
IF(PSTO.EQ.0.) GO TO 200
A(MZ) = 0.
190 IF((J-NET).GT.0) GO TO 200
A(I) = A(I) - A(J)*PSTO
J = J + JBMP
I = I + JBMP
GO TO 190
200 MAD = MAD + IBMP
MZ = MZ + IBMP
GO TO 180
210 continue
C 210 NEED A TEST HERE.....CALL OVERFL(IVF)
C GO TO (350,220),IVF
CCCCCCC NEED AT TEST HERE, ANYHOW
220 KSER = KSER + JBMP
IF ((KSER-NES).GT.0) GO TO 260
MSER = MSER + KBMP
IF(NC.LT.0) GO TO 230
MDIV = MDIV + IBMP
MZ = ((MSER - 1)/JBMP)*JBMP + 1
MAD = 1
GO TO 40
230 MDIV = MDIV + KBMP
IF(IRIC.NE.0) GO TO 240
MZ = MSER + IBMP
GO TO 250
240 MZ = ((MSER - 1)/JBMP)*JBMP + 1
250 MAD = MZ + JBMP
GO TO 40
260 IF(NC.LT.0) RETURN
JR = IR
270 IF(JR) 330,360,280
280 IF(KWA(JR) - JR) 330,320,290
290 K = (JR - 1)*JBMP
J = K + IR
L = (KWA(JR) - 1)*JBMP + IR
300 IF(J - K) 330,320,310
310 PSTO = A(L)
A(L) = A(J)
A(J) = PSTO
J = J - IBMP
L = L - IBMP
GO TO 300
320 JR = JR - 1
GO TO 270
330 ISOL = 3
RETURN
340 DET = 0.
ISOL = 2
IDSOL = 1
RETURN
350 ISOL = 2
IDSOL = 2
360 RETURN
END


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : FORTRN77.ZIP
Filename : MATINV.FOR

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/