* * $Id$ * * $Log$ * Revision 1.1.1.1 1996/04/01 15:01:45 mclareni * Mathlib gen * * #include "gen/pilot.h" SUBROUTINE CLEBS(J1,J2,J3,JM1,JM2, JM3,K,M) C*NS DIMENSION L1(40),L2(40),IB(40),K(2),LS(40,11),LD(40,6),IIL(40,2), C*NS F LLSN(40),LLSD(40),IL(2),LL(40),LR(40,100),LQ(40), DIMENSION IB(40),K(2),LS(40,11),LD(40,6),IIL(40,2), F LLSN(40),LLSD(40), LL(40),LR(40,100),LQ(40), F IS(100),ISK(40),M(41) C*NS DIMENSION LR1(40),ICGC(40) DIMENSION ICGC(40) IF((JM1+JM2).NE.JM3) GO TO 1 CALL U100PR(J3+1,LS(1,1),ID) CALL U100FC((J3+J1-J2)/2,LS(1,2)) CALL U100FC((J3-J1+J2)/2,LS(1,3)) CALL U100FC((J1+J2-J3)/2,LS(1,4)) CALL U100FC((J3+JM3)/2,LS(1,5)) CALL U100FC((J3-JM3)/2,LS(1,6)) CALL U100FC((J1+J2+J3)/2+1,LS(1,7)) CALL U100FC((J1-JM1)/2,LS(1,8)) CALL U100FC((J1+JM1)/2,LS(1,9)) CALL U100FC((J2-JM2)/2,LS(1,10)) CALL U100FC((J2+JM2)/2,LS(1,11)) DO 2 LZ=1,11 IF (LS(1,LZ) .EQ. (-77)) GO TO 45 2 CONTINUE CALL VZERO (M,41) CALL VZERO (LLSN,40) CALL VZERO (LLSD, 40) DO 5 J=1,40 DO 5 I=1,6 5 LLSN(J)=LLSN(J)+LS(J,I) DO 6 J=1,40 DO 6 I=7,11 6 LLSD(J)=LLSD(J)+LS(J,I) CALL U100DV(LLSN,LLSD,LL) MJ=1 N=-1 MM=0 3 N=N+1 CALL U100FC((J2+J3+JM1)/2-N,LD(1,1)) CALL U100FC((J1-JM1)/2+N,LD(1,2)) CALL U100FC(N,LD(1,3)) CALL U100FC((J3-J1+J2)/2-N,LD(1,4)) CALL U100FC((J3+JM3)/2-N,LD(1,5)) CALL U100FC((J1-J2-JM3)/2+N,LD(1,6)) IF(LD(1,1).EQ.(-77)) GO TO 4 IF(LD(1,4).EQ.(-77)) GO TO 4 IF(LD(1,5).EQ.(-77)) GO TO 4 IF(LD(1,2).EQ.(-77)) GO TO 3 IF(LD(1,6).EQ.(-77)) GO TO 3 MM=MM+1 IS(MM)=(-1)**(N+(J2+JM2)/2) DO 7 JK=1,40 IIL(JK,1)=LD(JK,1)+LD(JK,2) 7 IIL(JK,2)=LD(JK,3)+LD(JK,4)+LD(JK,5)+LD(JK,6) CALL U100DV (IIL(1,1),IIL(1,2),LR(1,MM)) GO TO 3 4 DO 31 JJ=1,40 IB(JJ)=10000 DO 31 JK=1,MM IF (LR(JJ,JK) .LT. IB(JJ)) IB(JJ)=LR(JJ,JK) 31 CONTINUE ISUM=0 DO 32 JM=1,MM DO 33 IO=1,40 33 LQ(IO)=LR(IO,JM)-IB(IO) CALL U100PM(LQ,K(1),K(2)) 32 ISUM=ISUM+K(1)*IS(JM) IX=ABS(ISUM) IF(IX.EQ.0) GO TO 1 CALL U100PR(IX,ISK,IP) DO 22 LK=1,40 22 ICGC(LK)=LL(LK)+2*IB(LK)+2*ISK(LK) IXX=IP* ISUM/ABS(ISUM) ISIGN=ISUM/ABS(ISUM) IXXX=IP*ISIGN M(41)=IXXX CALL UCOPY (ICGC, M, 40) CALL U100PM(ICGC,K(1),K(2)) K(1)=K(1)*IXX RETURN 45 WRITE(6,50) 50 FORMAT(1H ,'CHECK YOUR PARAMETERS ONCE MORE'///) 1 K(1)=0 K(2)=1 RETURN END