--- /dev/null
+*
+* $Id$
+*
+* $Log$
+* Revision 1.1.1.1 1996/04/01 15:01:46 mclareni
+* Mathlib gen
+*
+*
+#include "gen/pilot.h"
+#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
+ FUNCTION CLEBSG(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
+#endif
+#if !defined(CERNLIB_IBM)||!defined(CERNLIB_F4)
+ FUNCTION CLEBSG( A , B , C , XX , YY , ZZ , GG , HH , PP )
+#endif
+C
+C ADAPTED FROM HARWELL LIBRARY BY T. LINDELOF AND F. JAMES
+C 08/01/74 LAST UPDATE OF HARWELL LIBRARY
+C
+C WIGN3J- WIGNER 3-J SYMBOL
+C CLEBSG- CLEBSCH-GORDAN COEFFICIENT
+C WIGN6J- WIGNER 6-J SYMBOL
+C RACAHC- RACAH COEFFICIENT
+C JAHNUF- U-FUNCTION (JAHN)
+C WIGN9J- WIGNER 9-J SYMBOL
+C
+#if !defined(CERNLIB_F4)
+ REAL JAHNUF
+#endif
+ DIMENSION H(101),J(101)
+ DIMENSION AY(4),IAY(4)
+ COMMON/FGERCM/IERR,IERCT
+ DATA JJJ/0/
+ INTPTF(Q)=Q+Q+SIGN(.10,Q)
+ IPARF(I)=4*(I/4)-I+1
+C*IA Q
+ DATA Q/0/
+ IERR= 0
+ KEY= 2
+ CALL NOARG(NARG)
+ IF (NARG.EQ.3) KEY=4
+ GO TO 1
+C
+#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
+ ENTRY WIGN3J
+#endif
+#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
+ ENTRY WIGN3J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
+#endif
+#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
+ ENTRY WIGN3J(A,B,C,XX,YY,ZZ,GG,HH,PP)
+#endif
+ IERR=0
+ CALL NOARG(NARG)
+ IF(NARG.EQ.3) GOTO 2
+ KEY=1
+ GOTO 1
+ 2 KEY=3
+ GOTO 1
+C
+#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
+ ENTRY RACAHC
+#endif
+#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
+ ENTRY RACAHC(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
+#endif
+#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
+ ENTRY RACAHC(A,B,C,XX,YY,ZZ,GG,HH,PP)
+#endif
+ KEY=12
+ IERR=0
+ GOTO 100
+C
+#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
+ ENTRY WIGN6J
+#endif
+#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
+ ENTRY WIGN6J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
+#endif
+#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
+ ENTRY WIGN6J(A,B,C,XX,YY,ZZ,GG,HH,PP)
+#endif
+ KEY=11
+ IERR=0
+ GOTO 100
+C
+#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
+ ENTRY JAHNUF
+#endif
+#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
+ ENTRY JAHNUF(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
+#endif
+#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
+ ENTRY JAHNUF(A,B,C,XX,YY,ZZ,GG,HH,PP)
+#endif
+ KEY=13
+ IERR=0
+ GOTO 100
+C
+ 1 K1=INTPTF(A)
+ K2=INTPTF(B)
+ K3=INTPTF(C)
+ IF(KEY.GE.3) GOTO 100
+ K4=INTPTF(XX)
+ K5=INTPTF(YY)
+ K6= INTPTF(ZZ)
+ IF (KEY.EQ.1) K6= -K6
+C
+ 100 IF(JJJ.NE.0) GOTO 500
+ JJJ=1
+ IERCT=0
+ H(1)=1.0
+ J(1)=0
+ X=0.
+ DO 400 I=2,101
+ X=X+1.0
+ H(I)=H(I-1)*X
+ J(I)=J(I-1)
+ 200 IF(H(I).LT.10.0) GOTO 400
+ H(I)=0.01*H(I)
+ J(I)=J(I)+2
+ GOTO 200
+ 400 CONTINUE
+C
+ 500 IF(KEY.LT.-5) GOTO 750
+ IF(KEY.GE.3) GOTO 320
+ IF((K4+K5-K6).NE.0) GOTO 710
+ M1=K1+K2-K3
+ M2=K2+K3-K1
+ M3=K3+K1-K2
+ M4=K1+K4
+ M5=K1-K4
+ M6=K2+K5
+ M7=K2-K5
+ M8=K3+K6
+ M9=K3-K6
+ M10=K1+K2+K3+2
+C
+ IF(M1.LT.0) GOTO 710
+ IF(M2.LT.0) GOTO 710
+ IF(M3.LT.0) GOTO 710
+ IF(M4.LT.0) GOTO 710
+ IF(M5.LT.0) GOTO 710
+ IF(M6.LT.0) GOTO 710
+ IF(M7.LT.0) GOTO 710
+ IF(M8.LT.0) GOTO 710
+ IF(M9.LT.0) GOTO 710
+ IF((M4-(M4/2)-(M4/2)).NE.0) GOTO 710
+ IF((M6-(M6/2)-(M6/2)).NE.0) GOTO 710
+ IF((M8-(M8/2)-(M8/2)).NE.0) GOTO 710
+ IF((M10-(M10/2)-(M10/2)).NE.0) GOTO 710
+C
+ Y=K3+1
+ M1=M1/2+1
+ M2=M2/2+1
+ M3=M3/2+1
+ M4=M4/2+1
+ M5=M5/2+1
+ M6=M6/2+1
+ M7=M7/2+1
+ M8=M8/2+1
+ M9=M9/2+1
+ M10=M10/2+1
+C
+ Y= SQRT(Y*H(M1)*H(M2)*H(M3)*H(M4)*H(M5)*
+ X H(M6)*H(M7)*H(M8)*H(M9)/H(M10))
+ IY=(J(M1)+J(M2)+J(M3)+J(M4)+J(M5)+
+ X J(M6)+J(M7)+J(M8)+J(M9)-J(M10))/2
+C
+ N4=M1
+ IF(N4.GT.M5)N4=M5
+ IF(N4.GT.M6)N4=M6
+ N4=N4-1
+ M2=K2-K3-K4
+ M3=K1+K5-K3
+ N5=0
+ IF(N5.LT.M2) N5=M2
+ IF(N5.LT.M3) N5=M3
+ N5PAR=IPARF(N5)
+ N5=N5/2
+ Z=0.0
+ GOTO 610
+C
+ 700 MM1=M1-N5
+ MM2=M5-N5
+ MM3=M6-N5
+ MM4=N5-(M2/2)+1
+ MM5=N5-(M3/2)+1
+C
+ X=1./(H(MM1)*H(MM2)*H(MM3)*H(MM4)*H(MM5)*H(N5+1))
+ IX=-J(MM1)-J(MM2)-J(MM3)-J(MM4)-J(MM5)-J(N5+1)
+C
+ 800 IF(IX+IY)900,210,110
+ 900 X=0.1*X
+ IX=IX+1
+ GOTO 800
+ 110 X=10.0 *X
+ IX=IX-1
+ GOTO 800
+C
+ 210 IF(N5PAR.LT.0) X=-X
+ Z=Z+X
+C*UL 510 N5PAR=-N5PAR
+ N5PAR=-N5PAR
+ N5=N5+1
+C
+ 610 IF(N5-N4)700,700,810
+C
+ 710 CLEBSH=0.0
+ IERR=1
+ IERCT=IERCT+1
+ GOTO 220
+C
+ 810 CLEBSH=Z*Y
+C*UL 910 GOTO(120,220),KEY
+ GOTO(120,220),KEY
+C
+ 220 CLEBSG=CLEBSH
+ RETURN
+C
+ 120 JS=K1-K2+K6
+ IF(JS.LT.0) JS=-JS
+ JSPAR=IPARF(JS)
+ CLEBSG=JSPAR*CLEBSH/ SQRT(K3+1.0 )
+ RETURN
+C
+ 320 IF(KEY.GE.10) GOTO 130
+ KEY=KEY-2
+ IF((K1-(K1/2)-(K1/2)).NE.0) GOTO 420
+ IF((K2-(K2/2)-(K2/2)).NE.0) GOTO 420
+ IF((K3-(K3/2)-(K3/2)).NE.0) GOTO 420
+ IJ=K1+K2+K3
+ IJPAR=IPARF(IJ)
+ IF(IJPAR.LE.0) GOTO 420
+ M1=IJ-K1-K1
+ M2=IJ-K2-K2
+ M3=IJ-K3-K3
+ M4=IJ+2
+ IF(M1.LT.0) GOTO 420
+ IF(M2.LT.0) GOTO 420
+ IF(M3.LT.0) GOTO 420
+ M1=M1/2+1
+ M2=M2/2+1
+ M3=M3/2+1
+ M4=IJ/2+2
+ Y= SQRT(H(M1)*H(M2)*H(M3)/H(M4))
+ IY=(J(M1)+J(M2)+J(M3)-J(M4))/2
+ IJ=IJ/2
+ IJPAR=IPARF(IJ)
+ IJ=IJ/2+1
+ M1=M1/2+1
+ M2=M2/2+1
+ M3=M3/2+1
+ Z=H(IJ)/(H(M1)*H(M2)*H(M3))
+ IZ=J(IJ)-J(M1)-J(M2)-J(M3)
+ IZ=IZ+IY
+ CLEBSH=IJPAR*Y*Z*10.0 **IZ
+ GOTO(220,720),KEY
+C
+ 720 JQ=K2-K1
+ IF(JQ.LT.0) JQ=-JQ
+ IJPAR=IPARF(JQ)
+ CLEBSG=CLEBSH*IJPAR* SQRT(K3+1.0 )
+ RETURN
+C
+ 420 CLEBSH=0.0
+ IERR=1
+ IERCT=IERCT+1
+ GOTO(220,720),KEY
+C
+ 130 IF(KEY.EQ.11) GOTO 450
+ IF(KEY.GT.19) GOTO 750
+C*UL 550 K1=INTPTF(A)
+ K1=INTPTF(A)
+ K2=INTPTF(B)
+ K3=INTPTF(YY)
+ K4=INTPTF(XX)
+ K5=INTPTF(C)
+ K6=INTPTF(ZZ)
+C
+ 750 KA=K1
+ KB=K2
+ KC=K3
+ KEYTRI=1
+ GOTO 630
+C
+ 230 KA=K4
+ KB=K5
+ KEYTRI=2
+ GOTO 630
+C
+ 330 KB=K2
+ KC=K6
+ KEYTRI=3
+ GOTO 630
+C
+ 430 KA=K1
+ KB=K5
+ KEYTRI=4
+ GOTO 630
+C
+ 530 Y=AY(1)*AY(2)*AY(3)*AY(4)
+ IYY=IAY(1)+IAY(2)+IAY(3)+IAY(4)
+ M1=(K1+K2+K4+K5)/2+2
+ M2=(K1+K2-K3)/2+1
+ M3=(K4+K5-K3)/2+1
+ M4=(K1+K5-K6)/2+1
+ M5=(K2+K4-K6)/2+1
+ M6=K1+K4-K3-K6
+ M7=K2+K5-K3-K6
+C
+ N4=M1
+ IF(N4.GT.M2) N4=M2
+ IF(N4.GT.M3) N4=M3
+ IF(N4.GT.M4) N4=M4
+ IF(N4.GT.M5) N4=M5
+ N4=N4-1
+ N5=0
+ IF(N5.LT.M6) N5=M6
+ IF(N5.LT.M7) N5=M7
+ N5PAR=IPARF(N5)
+ N5=N5/2
+ M6=M6/2-1
+ M7=M7/2-1
+ Z=0.0
+ GOTO 730
+C
+ 140 X=H(M1-N5)/(H(N5+1)*H(M2-N5)*H(M3-N5)*H(M4-N5)
+ X *H(M5-N5)*H(N5-M6)*H(N5-M7))
+ IX=J(M1-N5)-J(N5+1)-J(M2-N5)-J(M3-N5)-J(M4-N5)
+ X -J(M5-N5)-J(N5-M6)-J(N5-M7)
+ 240 IF(IX+IYY)340,440,540
+ 340 X=0.1*X
+ IX=IX+1
+ GOTO 240
+ 540 X=10.0 *X
+ IX=IX-1
+ GOTO 240
+ 440 IF(N5PAR.LT.0) X=-X
+ Z=Z+X
+ N5PAR=-N5PAR
+ N5=N5+1
+C
+ 730 IF(N5.LE.N4) GOTO 140
+C
+ RACAH=Z*Y
+ 840 IF(KEY.LT.-5) GOTO 160
+ KEY=KEY-10
+ GOTO(150,250,350),KEY
+C
+ 830 RACAH=0.0
+ IERR=1
+ IERCT=IERCT+1
+ GOTO 840
+C
+ 150 IJPAR=IPARF(K1+K2+K4+K5)
+ IF(IJPAR.LT.0) RACAH=-RACAH
+ 250 CLEBSG=RACAH
+ RETURN
+C
+ 350 FACTOR= SQRT((K3+1.0 )*(K6+1))
+ CLEBSG=FACTOR*RACAH
+ RETURN
+ 450 K1=INTPTF(A)
+ K2=INTPTF(B)
+ K3=INTPTF(C)
+ K4=INTPTF(XX)
+ K5=INTPTF(YY)
+ K6=INTPTF(ZZ)
+ GOTO 750
+C
+C TRIANGLE FUNCTION
+C
+ 630 MA=KA+KB-KC
+ MB=KA-KB+KC
+ MC=-KA+KB+KC
+ MD=KA+KB+KC+2
+ IF(MA.LT.0) GOTO 830
+ IF(MB.LT.0) GOTO 830
+ IF(MC.LT.0) GOTO 830
+ IF((MD-(MD/2)-(MD/2)).NE.0) GOTO 830
+ MA=MA/2+1
+ MB=MB/2+1
+ MC=MC/2+1
+ MD=MD/2+1
+ AY(KEYTRI)= SQRT(H(MA)*H(MB)*H(MC)/H(MD))
+ IAY(KEYTRI)=(J(MA)+J(MB)+J(MC)-J(MD))/2
+ GOTO(230,330,430,530),KEYTRI
+C
+#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
+ ENTRY WIGN9J
+#endif
+#if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
+ ENTRY WIGN9J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
+#endif
+#if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
+ ENTRY WIGN9J(A,B,C,XX,YY,ZZ,GG,HH,PP)
+#endif
+C
+ KEY=-10
+ IERR=0
+C
+ KK1=INTPTF(A)
+ KK2=INTPTF(B)
+ KK3=INTPTF(C)
+ KK4=INTPTF(XX)
+ KK5=INTPTF(YY)
+ KK6=INTPTF(ZZ)
+ KK7=INTPTF(GG)
+ KK8=INTPTF(HH)
+ KK9=INTPTF(PP)
+C
+ KUP=KK1+KK9
+ M1=KK4+KK8
+ M2=KK2+KK6
+ IF(KUP.GT.M1) KUP=M1
+ IF(KUP.GT.M2) KUP=M2
+C
+ K=KK1-KK9
+ IF(K.LT.0) K=-K
+ M1=KK4-KK8
+ IF(M1.LT.0) M1=-M1
+ M2=KK2-KK6
+ IF(M2.LT.0) M2=-M2
+ IF(K.LT.M1) K=M1
+ IF(K.LT.M2) K=M2
+C
+ ANINE=0.0
+C
+ 660 IF(K.GT.KUP) GOTO 260
+ K1=KK1
+ K2=KK4
+ K3=KK7
+ K4=KK8
+ K5=KK9
+ K6=K
+ KEYRAC=1
+ GOTO 100
+C
+ 160 GOTO(360,460,560),KEYRAC
+C
+ 360 RA=RACAH
+ K1=KK2
+ K2=KK8
+ K3=KK5
+ K4=KK4
+ K5=KK6
+ KEYRAC=2
+ GOTO 750
+C
+ 460 RB=RACAH
+ K1=KK9
+ K2=KK6
+ K3=KK3
+ K4=KK2
+ K5=KK1
+ KEYRAC=3
+ GOTO 750
+C
+ 560 ANINE=ANINE+RA*RB*RACAH*(K+1)
+ K=K+2
+ GOTO 660
+C
+ 260 CLEBSG=ANINE
+ RETURN
+ END
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff