This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / u / clebs.F.ori
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:01:45  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE CLEBS(J1,J2,J3,JM1,JM2, JM3,K,M)
11 C*NS  DIMENSION L1(40),L2(40),IB(40),K(2),LS(40,11),LD(40,6),IIL(40,2),
12 C*NS F                LLSN(40),LLSD(40),IL(2),LL(40),LR(40,100),LQ(40),
13       DIMENSION               IB(40),K(2),LS(40,11),LD(40,6),IIL(40,2),
14      F                LLSN(40),LLSD(40),      LL(40),LR(40,100),LQ(40),
15      F IS(100),ISK(40),M(41)
16 C*NS  DIMENSION LR1(40),ICGC(40)
17       DIMENSION         ICGC(40)
18       IF((JM1+JM2).NE.JM3)     GO TO 1
19       CALL U100PR(J3+1,LS(1,1),ID)
20       CALL U100FC((J3+J1-J2)/2,LS(1,2))
21       CALL U100FC((J3-J1+J2)/2,LS(1,3))
22       CALL U100FC((J1+J2-J3)/2,LS(1,4))
23       CALL U100FC((J3+JM3)/2,LS(1,5))
24       CALL U100FC((J3-JM3)/2,LS(1,6))
25       CALL U100FC((J1+J2+J3)/2+1,LS(1,7))
26       CALL U100FC((J1-JM1)/2,LS(1,8))
27       CALL U100FC((J1+JM1)/2,LS(1,9))
28       CALL U100FC((J2-JM2)/2,LS(1,10))
29       CALL U100FC((J2+JM2)/2,LS(1,11))
30       DO 2    LZ=1,11
31       IF (LS(1,LZ) .EQ. (-77))   GO TO 45
32     2 CONTINUE
33       CALL VZERO (M,41)
34       CALL VZERO (LLSN,40)
35       CALL VZERO (LLSD, 40)
36       DO 5  J=1,40
37       DO 5 I=1,6
38     5 LLSN(J)=LLSN(J)+LS(J,I)
39       DO 6  J=1,40
40       DO 6  I=7,11
41     6 LLSD(J)=LLSD(J)+LS(J,I)
42       CALL U100DV(LLSN,LLSD,LL)
43       MJ=1
44       N=-1
45       MM=0
46     3 N=N+1
47       CALL U100FC((J2+J3+JM1)/2-N,LD(1,1))
48       CALL U100FC((J1-JM1)/2+N,LD(1,2))
49       CALL U100FC(N,LD(1,3))
50       CALL U100FC((J3-J1+J2)/2-N,LD(1,4))
51       CALL U100FC((J3+JM3)/2-N,LD(1,5))
52       CALL U100FC((J1-J2-JM3)/2+N,LD(1,6))
53       IF(LD(1,1).EQ.(-77))    GO TO 4
54       IF(LD(1,4).EQ.(-77))    GO TO 4
55       IF(LD(1,5).EQ.(-77))    GO TO 4
56       IF(LD(1,2).EQ.(-77))  GO TO 3
57       IF(LD(1,6).EQ.(-77))  GO TO 3
58       MM=MM+1
59       IS(MM)=(-1)**(N+(J2+JM2)/2)
60       DO 7    JK=1,40
61       IIL(JK,1)=LD(JK,1)+LD(JK,2)
62     7 IIL(JK,2)=LD(JK,3)+LD(JK,4)+LD(JK,5)+LD(JK,6)
63       CALL U100DV (IIL(1,1),IIL(1,2),LR(1,MM))
64       GO TO 3
65     4 DO 31 JJ=1,40
66       IB(JJ)=10000
67       DO 31  JK=1,MM
68       IF (LR(JJ,JK) .LT. IB(JJ))   IB(JJ)=LR(JJ,JK)
69    31 CONTINUE
70       ISUM=0
71       DO 32 JM=1,MM
72       DO 33 IO=1,40
73    33 LQ(IO)=LR(IO,JM)-IB(IO)
74       CALL U100PM(LQ,K(1),K(2))
75    32 ISUM=ISUM+K(1)*IS(JM)
76       IX=ABS(ISUM)
77       IF(IX.EQ.0) GO TO 1
78       CALL U100PR(IX,ISK,IP)
79       DO 22 LK=1,40
80    22 ICGC(LK)=LL(LK)+2*IB(LK)+2*ISK(LK)
81       IXX=IP*   ISUM/ABS(ISUM)
82       ISIGN=ISUM/ABS(ISUM)
83       IXXX=IP*ISIGN
84       M(41)=IXXX
85       CALL UCOPY (ICGC, M, 40)
86       CALL U100PM(ICGC,K(1),K(2))
87       K(1)=K(1)*IXX
88       RETURN
89    45 WRITE(6,50)
90    50 FORMAT(1H ,'CHECK YOUR PARAMETERS ONCE MORE'///)
91     1 K(1)=0
92       K(2)=1
93       RETURN
94       END