Changes needed by ICC/IFC compiler (Intel)
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / h / assndx.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/04/01 15:02:49 mclareni
6* Mathlib gen
7*
8*
9#include "gen/pilot.h"
10 SUBROUTINE ASSNDX(MODE,A,N,M,IDA,K,SUM,IW,IDW)
11 LOGICAL LSW
12 CHARACTER NAME*(*)
13 CHARACTER*80 ERRTXT
14 PARAMETER (NAME = 'ASSNDX')
15
16 DIMENSION A(IDA,*),K(*),IW(IDW,*)
17
18 IF(N .LT. 1 .OR. M .LT. 1) THEN
19 WRITE(ERRTXT,101) N,M
20 CALL MTLPRT(NAME,'H301.1',ERRTXT)
21 RETURN
22 ENDIF
23 IMAX=MAX(N,M)
24 IMIN=MIN(N,M)
25 SUM=0
26 IF(N .LE. M) THEN
27 DO 1 I = 1,N
28 RMIN=A(I,1)
29 DO 2 J = 1,M
30 2 RMIN=MIN(RMIN,A(I,J))
31 SUM=SUM+RMIN
32 DO 3 J = 1,M
33 3 A(I,J)=A(I,J)-RMIN
34 1 CONTINUE
35 ENDIF
36 IF(N .GE. M) THEN
37 DO 4 J = 1,M
38 RMIN=A(1,J)
39 DO 5 I = 1,N
40 5 RMIN=MIN(RMIN,A(I,J))
41 SUM=SUM+RMIN
42 DO 7 I = 1,N
43 7 A(I,J)=A(I,J)-RMIN
44 4 CONTINUE
45 ENDIF
46 DO 8 I = 1,IMAX
47 K(I)=0
48 8 IW(I,1)=0
49
50 DO 12 I = 1,N
51 DO 13 J = 1,M
52 IF(A(I,J)+IW(J,1) .EQ. 0) THEN
53 K(I)=J
54 IW(J,1)=I
55 GO TO 12
56 ENDIF
57 13 CONTINUE
58 12 CONTINUE
59
60 10 IFLAG=N
61 IRL=0
62 ICL=0
63 IRS=1
64
65 DO 11 I = 1,N
66 IW(I,5)=0
67 IF(K(I) .EQ. 0) THEN
68 IRL=IRL+1
69 IW(IRL,6)=I
70 IW(I,5)=-1
71 IFLAG=IFLAG-1
72 ENDIF
73 11 CONTINUE
74 IF(IFLAG .EQ. IMIN) THEN
75 IF(MODE .EQ. 2) THEN
76 DO 70 I = 1,IMAX
77 70 K(I)=IW(I,1)
78 ENDIF
79 RETURN
80 ENDIF
81
82 DO 14 J = 1,M
83 14 IW(J,4)=0
84
85 30 I=IW(IRS,6)
86 IRS=IRS+1
87 DO 31 J = 1,M
88 IF(A(I,J)+IW(J,4) .EQ. 0) THEN
89 IW(J,4)=I
90 ICL=ICL+1
91 IW(ICL,2)=J
92 NEW=IW(J,1)
93 IF(NEW .EQ. 0) THEN
94 J1=J
95 61 IW(J1,1)=IW(J1,4)
96 I=IW(J1,4)
97 IF(K(I) .EQ. 0) THEN
98 K(I)=J1
99 GO TO 10
100 ENDIF
101 JSV=J1
102 J1=K(I)
103 K(I)=JSV
104 GO TO 61
105 ENDIF
106 IRL=IRL+1
107 IW(IRL,6)=NEW
108 IW(NEW,5)=I
109 ENDIF
110 31 CONTINUE
111 IF(IRS .LE. IRL) GO TO 30
112
113 LSW=.TRUE.
114 ICL0=ICL
115 ICBL=0
116 DO 41 J = 1,M
117 IF(IW(J,4) .EQ. 0) THEN
118 ICBL=ICBL+1
119 IW(ICBL,3)=J
120 ENDIF
121 41 CONTINUE
122 RMIN=A(IW(1,6),IW(1,3))
123 DO 42 I = 1,IRL
124 DO 42 J = 1,ICBL
125 42 RMIN=MIN(RMIN,A(IW(I,6),IW(J,3)))
126 SUM=SUM+RMIN*(IRL+ICBL-IMAX)
127
128 DO 44 I = 1,N
129 IF(IW(I,5) .EQ. 0) THEN
130 DO 49 IPP = 1,ICL0
131 49 A(I,IW(IPP,2))=A(I,IW(IPP,2))+RMIN
132 GO TO 44
133 ENDIF
134 DO 45 IPP = 1,ICBL
135 NEW=IW(IPP,3)
136 A(I,NEW)=A(I,NEW)-RMIN
137 IF(LSW .AND. A(I,NEW)+IW(NEW,4) .EQ. 0) THEN
138 IW(NEW,4)=I
139 IF(IW(NEW,1) .EQ. 0) THEN
140 J1=NEW
141 LSW=.FALSE.
142 ELSE
143 ICL=ICL+1
144 IW(ICL,2)=NEW
145 IRL=IRL+1
146 IW(IRL,6)=IW(NEW,1)
147 END IF
148 END IF
149 45 CONTINUE
150 44 CONTINUE
151 IF(LSW) THEN
152 DO 51 I = ICL0+1,ICL
153 51 IW(IW(IW(I,2),1),5)=IW(I,2)
154 GO TO 30
155 ELSE
156 62 IW(J1,1)=IW(J1,4)
157 I=IW(J1,4)
158 IF(K(I) .EQ. 0) THEN
159 K(I)=J1
160 GO TO 10
161 ENDIF
162 JSV=J1
163 J1=K(I)
164 K(I)=JSV
165 GO TO 62
166 ENDIF
167 101 FORMAT('N = ',I5,' < 1 OR M = ',I5,' < 1')
168 END