[u/mrichter/AliRoot.git] / GEANT321 / ghutils / minv.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:14  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.40  by  S.Giani
*-- Author :
      SUBROUTINE MINV(A,N,D,L,M)
      DIMENSION A(1),L(1),M(1)
C
C *** NVE 18-MAR-1988 CERN GENEVA ***
C
C ORIGIN : H.FESEFELDT (27-OCT-1983)
C
C        ...............................................................
C
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
C        STATEMENT WHICH FOLLOWS.
C
C     DOUBLE PRECISION A,D,BIGA,HOLD
C
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
C        ROUTINE.
C
C        ...............................................................
C
C        SEARCH FOR LARGEST ELEMENT
C
      D=1.0
      NK=-N
      DO 80 K=1,N
      NK=NK+N
      L(K)=K
      M(K)=K
      KK=NK+K
      BIGA=A(KK)
      DO 20 J=K,N
      IZ=N*(J-1)
      DO 20 I=K,N
      IJ=IZ+I
   10 IF( ABS(BIGA)- ABS(A(IJ))) 15,20,20
   15 BIGA=A(IJ)
      L(K)=I
      M(K)=J
   20 CONTINUE
C
C        INTERCHANGE ROWS
C
      J=L(K)
      IF(J-K) 35,35,25
   25 KI=K-N
      DO 30 I=1,N
      KI=KI+N
      HOLD=-A(KI)
      JI=KI-K+J
      A(KI)=A(JI)
   30 A(JI) =HOLD
C
C        INTERCHANGE COLUMNS
C
   35 I=M(K)
      IF(I-K) 45,45,38
   38 JP=N*(I-1)
      DO 40 J=1,N
      JK=NK+J
      JI=JP+J
      HOLD=-A(JK)
      A(JK)=A(JI)
   40 A(JI) =HOLD
C
C        DIVIDE COLUMN BY MINUS PIVOT (VALUE OF PIVOT ELEMENT IS
C        CONTAINED IN BIGA)
C
   45 IF(BIGA) 48,46,48
   46 D=0.0
      RETURN
   48 DO 55 I=1,N
      IF(I-K) 50,55,50
   50 IK=NK+I
      A(IK)=A(IK)/(-BIGA)
   55 CONTINUE
C
C        REDUCE MATRIX
C
      DO 65 I=1,N
      IK=NK+I
      HOLD=A(IK)
      IJ=I-N
      DO 65 J=1,N
      IJ=IJ+N
      IF(I-K) 60,65,60
   60 IF(J-K) 62,65,62
   62 KJ=IJ-I+K
      A(IJ)=HOLD*A(KJ)+A(IJ)
   65 CONTINUE
C
C        DIVIDE ROW BY PIVOT
C
      KJ=K-N
      DO 75 J=1,N
      KJ=KJ+N
      IF(J-K) 70,75,70
   70 A(KJ)=A(KJ)/BIGA
   75 CONTINUE
C
C        PRODUCT OF PIVOTS
C
      D=D*BIGA
C
C        REPLACE PIVOT BY RECIPROCAL
C
      A(KK)=1.0/BIGA
   80 CONTINUE
C
C        FINAL ROW AND COLUMN INTERCHANGE
C
      K=N
  100 K=(K-1)
      IF(K) 150,150,105
  105 I=L(K)
      IF(I-K) 120,120,108
  108 JQ=N*(K-1)
      JR=N*(I-1)
      DO 110 J=1,N
      JK=JQ+J
      HOLD=A(JK)
      JI=JR+J
      A(JK)=-A(JI)
  110 A(JI) =HOLD
  120 J=M(K)
      IF(J-K) 100,100,125
  125 KI=K-N
      DO 130 I=1,N
      KI=KI+N
      HOLD=A(KI)
      JI=KI-K+J
      A(KI)=-A(JI)
  130 A(JI) =HOLD
      GO TO 100
  150 RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:21:14 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.40 by S.Giani
	11	*-- Author :
	12	SUBROUTINE MINV(A,N,D,L,M)
	13	DIMENSION A(1),L(1),M(1)
	14	C
	15	C * NVE 18-MAR-1988 CERN GENEVA *
	16	C
	17	C ORIGIN : H.FESEFELDT (27-OCT-1983)
	18	C
	19	C ...............................................................
	20	C
	21	C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
	22	C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
	23	C STATEMENT WHICH FOLLOWS.
	24	C
	25	C DOUBLE PRECISION A,D,BIGA,HOLD
	26	C
	27	C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
	28	C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
	29	C ROUTINE.
	30	C
	31	C ...............................................................
	32	C
	33	C SEARCH FOR LARGEST ELEMENT
	34	C
	35	D=1.0
	36	NK=-N
	37	DO 80 K=1,N
	38	NK=NK+N
	39	L(K)=K
	40	M(K)=K
	41	KK=NK+K
	42	BIGA=A(KK)
	43	DO 20 J=K,N
	44	IZ=N*(J-1)
	45	DO 20 I=K,N
	46	IJ=IZ+I
	47	10 IF( ABS(BIGA)- ABS(A(IJ))) 15,20,20
	48	15 BIGA=A(IJ)
	49	L(K)=I
	50	M(K)=J
	51	20 CONTINUE
	52	C
	53	C INTERCHANGE ROWS
	54	C
	55	J=L(K)
	56	IF(J-K) 35,35,25
	57	25 KI=K-N
	58	DO 30 I=1,N
	59	KI=KI+N
	60	HOLD=-A(KI)
	61	JI=KI-K+J
	62	A(KI)=A(JI)
	63	30 A(JI) =HOLD
	64	C
65	C INTERCHANGE COLUMNS
66	C
67	35 I=M(K)
68	IF(I-K) 45,45,38
69	38 JP=N*(I-1)
70	DO 40 J=1,N
71	JK=NK+J
72	JI=JP+J
73	HOLD=-A(JK)
74	A(JK)=A(JI)
75	40 A(JI) =HOLD
76	C
77	C DIVIDE COLUMN BY MINUS PIVOT (VALUE OF PIVOT ELEMENT IS
78	C CONTAINED IN BIGA)
79	C
80	45 IF(BIGA) 48,46,48
81	46 D=0.0
82	RETURN
83	48 DO 55 I=1,N
84	IF(I-K) 50,55,50
85	50 IK=NK+I
86	A(IK)=A(IK)/(-BIGA)
87	55 CONTINUE
88	C
89	C REDUCE MATRIX
90	C
91	DO 65 I=1,N
92	IK=NK+I
93	HOLD=A(IK)
94	IJ=I-N
95	DO 65 J=1,N
96	IJ=IJ+N
97	IF(I-K) 60,65,60
98	60 IF(J-K) 62,65,62
99	62 KJ=IJ-I+K
100	A(IJ)=HOLD*A(KJ)+A(IJ)
101	65 CONTINUE
102	C
103	C DIVIDE ROW BY PIVOT
104	C
105	KJ=K-N
106	DO 75 J=1,N
107	KJ=KJ+N
108	IF(J-K) 70,75,70
109	70 A(KJ)=A(KJ)/BIGA
110	75 CONTINUE
111	C
112	C PRODUCT OF PIVOTS
113	C
114	D=D*BIGA
115	C
116	C REPLACE PIVOT BY RECIPROCAL
117	C
118	A(KK)=1.0/BIGA
119	80 CONTINUE
120	C
121	C FINAL ROW AND COLUMN INTERCHANGE
122	C
123	K=N
124	100 K=(K-1)
125	IF(K) 150,150,105
126	105 I=L(K)
127	IF(I-K) 120,120,108
128	108 JQ=N*(K-1)
129	JR=N*(I-1)
130	DO 110 J=1,N
131	JK=JQ+J
132	HOLD=A(JK)
133	JI=JR+J
134	A(JK)=-A(JI)
135	110 A(JI) =HOLD
136	120 J=M(K)
137	IF(J-K) 100,100,125
138	125 KI=K-N
139	DO 130 I=1,N
140	KI=KI+N
141	HOLD=A(KI)
142	JI=KI-K+J
143	A(KI)=-A(JI)
144	130 A(JI) =HOLD
145	GO TO 100
146	150 RETURN
147	END