This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / h / assndx.F
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