MINICERN/mathlib/gen/u/clebsg.F.ori

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:01:46  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
  11       FUNCTION CLEBSG(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
  12 #endif
  13 #if !defined(CERNLIB_IBM)||!defined(CERNLIB_F4)
  14       FUNCTION CLEBSG( A , B , C , XX , YY , ZZ , GG , HH , PP )
  15 #endif
  16 C
  17 C         ADAPTED FROM HARWELL LIBRARY BY T. LINDELOF AND F. JAMES
  18 C         08/01/74 LAST UPDATE OF HARWELL LIBRARY
  19 C
  20 C     WIGN3J- WIGNER 3-J SYMBOL
  21 C     CLEBSG- CLEBSCH-GORDAN COEFFICIENT
  22 C     WIGN6J- WIGNER 6-J SYMBOL
  23 C     RACAHC- RACAH COEFFICIENT
  24 C     JAHNUF- U-FUNCTION (JAHN)
  25 C     WIGN9J- WIGNER 9-J SYMBOL
  26 C
  27 #if !defined(CERNLIB_F4)
  28       REAL JAHNUF
  29 #endif
  30       DIMENSION H(101),J(101)
  31       DIMENSION AY(4),IAY(4)
  32       COMMON/FGERCM/IERR,IERCT
  33       DATA JJJ/0/
  34       INTPTF(Q)=Q+Q+SIGN(.10,Q)
  35       IPARF(I)=4*(I/4)-I+1
  36 C*IA  Q
  37       DATA Q/0/
  38       IERR= 0
  39       KEY= 2
  40       CALL NOARG(NARG)
  41       IF (NARG.EQ.3) KEY=4
  42       GO TO 1
  43 C
  44 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  45       ENTRY WIGN3J
  46 #endif
  47 #if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
  48       ENTRY WIGN3J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
  49 #endif
  50 #if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
  51       ENTRY WIGN3J(A,B,C,XX,YY,ZZ,GG,HH,PP)
  52 #endif
  53       IERR=0
  54       CALL NOARG(NARG)
  55       IF(NARG.EQ.3) GOTO 2
  56       KEY=1
  57       GOTO 1
  58     2 KEY=3
  59       GOTO 1
  60 C
  61 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  62       ENTRY RACAHC
  63 #endif
  64 #if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
  65       ENTRY RACAHC(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
  66 #endif
  67 #if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
  68       ENTRY RACAHC(A,B,C,XX,YY,ZZ,GG,HH,PP)
  69 #endif
  70       KEY=12
  71       IERR=0
  72       GOTO 100
  73 C
  74 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  75       ENTRY WIGN6J
  76 #endif
  77 #if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
  78       ENTRY WIGN6J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
  79 #endif
  80 #if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
  81       ENTRY WIGN6J(A,B,C,XX,YY,ZZ,GG,HH,PP)
  82 #endif
  83       KEY=11
  84       IERR=0
  85       GOTO 100
  86 C
  87 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  88       ENTRY JAHNUF
  89 #endif
  90 #if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
  91       ENTRY JAHNUF(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
  92 #endif
  93 #if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
  94       ENTRY JAHNUF(A,B,C,XX,YY,ZZ,GG,HH,PP)
  95 #endif
  96       KEY=13
  97       IERR=0
  98       GOTO 100
  99 C
 100     1 K1=INTPTF(A)
 101       K2=INTPTF(B)
 102       K3=INTPTF(C)
 103       IF(KEY.GE.3) GOTO 100
 104       K4=INTPTF(XX)
 105       K5=INTPTF(YY)
 106       K6= INTPTF(ZZ)
 107       IF (KEY.EQ.1) K6= -K6
 108 C
 109   100 IF(JJJ.NE.0) GOTO 500
 110       JJJ=1
 111       IERCT=0
 112       H(1)=1.0
 113       J(1)=0
 114       X=0.
 115       DO 400 I=2,101
 116       X=X+1.0
 117       H(I)=H(I-1)*X
 118       J(I)=J(I-1)
 119   200 IF(H(I).LT.10.0) GOTO 400
 120       H(I)=0.01*H(I)
 121       J(I)=J(I)+2
 122       GOTO 200
 123   400 CONTINUE
 124 C
 125   500 IF(KEY.LT.-5) GOTO 750
 126       IF(KEY.GE.3) GOTO 320
 127       IF((K4+K5-K6).NE.0) GOTO 710
 128       M1=K1+K2-K3
 129       M2=K2+K3-K1
 130       M3=K3+K1-K2
 131       M4=K1+K4
 132       M5=K1-K4
 133       M6=K2+K5
 134       M7=K2-K5
 135       M8=K3+K6
 136       M9=K3-K6
 137       M10=K1+K2+K3+2
 138 C
 139       IF(M1.LT.0) GOTO 710
 140       IF(M2.LT.0) GOTO 710
 141       IF(M3.LT.0) GOTO 710
 142       IF(M4.LT.0) GOTO 710
 143       IF(M5.LT.0) GOTO 710
 144       IF(M6.LT.0) GOTO 710
 145       IF(M7.LT.0) GOTO 710
 146       IF(M8.LT.0) GOTO 710
 147       IF(M9.LT.0) GOTO 710
 148       IF((M4-(M4/2)-(M4/2)).NE.0) GOTO 710
 149       IF((M6-(M6/2)-(M6/2)).NE.0) GOTO 710
 150       IF((M8-(M8/2)-(M8/2)).NE.0) GOTO 710
 151       IF((M10-(M10/2)-(M10/2)).NE.0) GOTO 710
 152 C
 153       Y=K3+1
 154       M1=M1/2+1
 155       M2=M2/2+1
 156       M3=M3/2+1
 157       M4=M4/2+1
 158       M5=M5/2+1
 159       M6=M6/2+1
 160       M7=M7/2+1
 161       M8=M8/2+1
 162       M9=M9/2+1
 163       M10=M10/2+1
 164 C
 165       Y= SQRT(Y*H(M1)*H(M2)*H(M3)*H(M4)*H(M5)*
 166      X H(M6)*H(M7)*H(M8)*H(M9)/H(M10))
 167       IY=(J(M1)+J(M2)+J(M3)+J(M4)+J(M5)+
 168      X J(M6)+J(M7)+J(M8)+J(M9)-J(M10))/2
 169 C
 170       N4=M1
 171       IF(N4.GT.M5)N4=M5
 172       IF(N4.GT.M6)N4=M6
 173       N4=N4-1
 174       M2=K2-K3-K4
 175       M3=K1+K5-K3
 176       N5=0
 177       IF(N5.LT.M2) N5=M2
 178       IF(N5.LT.M3) N5=M3
 179       N5PAR=IPARF(N5)
 180       N5=N5/2
 181       Z=0.0
 182       GOTO 610
 183 C
 184   700 MM1=M1-N5
 185       MM2=M5-N5
 186       MM3=M6-N5
 187       MM4=N5-(M2/2)+1
 188       MM5=N5-(M3/2)+1
 189 C
 190       X=1./(H(MM1)*H(MM2)*H(MM3)*H(MM4)*H(MM5)*H(N5+1))
 191       IX=-J(MM1)-J(MM2)-J(MM3)-J(MM4)-J(MM5)-J(N5+1)
 192 C
 193   800 IF(IX+IY)900,210,110
 194   900 X=0.1*X
 195       IX=IX+1
 196       GOTO 800
 197   110 X=10.0  *X
 198       IX=IX-1
 199       GOTO 800
 200 C
 201   210 IF(N5PAR.LT.0) X=-X
 202       Z=Z+X
 203 C*UL  510 N5PAR=-N5PAR
 204       N5PAR=-N5PAR
 205       N5=N5+1
 206 C
 207   610 IF(N5-N4)700,700,810
 208 C
 209  710  CLEBSH=0.0
 210       IERR=1
 211       IERCT=IERCT+1
 212       GOTO 220
 213 C
 214  810  CLEBSH=Z*Y
 215 C*UL  910 GOTO(120,220),KEY
 216       GOTO(120,220),KEY
 217 C
 218   220 CLEBSG=CLEBSH
 219       RETURN
 220 C
 221   120 JS=K1-K2+K6
 222       IF(JS.LT.0) JS=-JS
 223       JSPAR=IPARF(JS)
 224       CLEBSG=JSPAR*CLEBSH/ SQRT(K3+1.0  )
 225       RETURN
 226 C
 227   320 IF(KEY.GE.10) GOTO 130
 228       KEY=KEY-2
 229       IF((K1-(K1/2)-(K1/2)).NE.0) GOTO 420
 230       IF((K2-(K2/2)-(K2/2)).NE.0) GOTO 420
 231       IF((K3-(K3/2)-(K3/2)).NE.0) GOTO 420
 232       IJ=K1+K2+K3
 233       IJPAR=IPARF(IJ)
 234       IF(IJPAR.LE.0) GOTO 420
 235       M1=IJ-K1-K1
 236       M2=IJ-K2-K2
 237       M3=IJ-K3-K3
 238       M4=IJ+2
 239       IF(M1.LT.0) GOTO 420
 240       IF(M2.LT.0) GOTO 420
 241       IF(M3.LT.0) GOTO 420
 242       M1=M1/2+1
 243       M2=M2/2+1
 244       M3=M3/2+1
 245       M4=IJ/2+2
 246       Y= SQRT(H(M1)*H(M2)*H(M3)/H(M4))
 247       IY=(J(M1)+J(M2)+J(M3)-J(M4))/2
 248       IJ=IJ/2
 249       IJPAR=IPARF(IJ)
 250       IJ=IJ/2+1
 251       M1=M1/2+1
 252       M2=M2/2+1
 253       M3=M3/2+1
 254       Z=H(IJ)/(H(M1)*H(M2)*H(M3))
 255       IZ=J(IJ)-J(M1)-J(M2)-J(M3)
 256       IZ=IZ+IY
 257       CLEBSH=IJPAR*Y*Z*10.0  **IZ
 258       GOTO(220,720),KEY
 259 C
 260   720 JQ=K2-K1
 261       IF(JQ.LT.0) JQ=-JQ
 262       IJPAR=IPARF(JQ)
 263       CLEBSG=CLEBSH*IJPAR* SQRT(K3+1.0  )
 264       RETURN
 265 C
 266   420 CLEBSH=0.0
 267       IERR=1
 268       IERCT=IERCT+1
 269       GOTO(220,720),KEY
 270 C
 271   130 IF(KEY.EQ.11) GOTO 450
 272       IF(KEY.GT.19) GOTO 750
 273 C*UL  550 K1=INTPTF(A)
 274       K1=INTPTF(A)
 275       K2=INTPTF(B)
 276       K3=INTPTF(YY)
 277       K4=INTPTF(XX)
 278       K5=INTPTF(C)
 279       K6=INTPTF(ZZ)
 280 C
 281   750 KA=K1
 282       KB=K2
 283       KC=K3
 284       KEYTRI=1
 285       GOTO 630
 286 C
 287   230 KA=K4
 288       KB=K5
 289       KEYTRI=2
 290       GOTO 630
 291 C
 292   330 KB=K2
 293       KC=K6
 294       KEYTRI=3
 295       GOTO 630
 296 C
 297   430 KA=K1
 298       KB=K5
 299       KEYTRI=4
 300       GOTO 630
 301 C
 302   530 Y=AY(1)*AY(2)*AY(3)*AY(4)
 303       IYY=IAY(1)+IAY(2)+IAY(3)+IAY(4)
 304       M1=(K1+K2+K4+K5)/2+2
 305       M2=(K1+K2-K3)/2+1
 306       M3=(K4+K5-K3)/2+1
 307       M4=(K1+K5-K6)/2+1
 308       M5=(K2+K4-K6)/2+1
 309       M6=K1+K4-K3-K6
 310       M7=K2+K5-K3-K6
 311 C
 312       N4=M1
 313       IF(N4.GT.M2) N4=M2
 314       IF(N4.GT.M3) N4=M3
 315       IF(N4.GT.M4) N4=M4
 316       IF(N4.GT.M5) N4=M5
 317       N4=N4-1
 318       N5=0
 319       IF(N5.LT.M6) N5=M6
 320       IF(N5.LT.M7) N5=M7
 321       N5PAR=IPARF(N5)
 322       N5=N5/2
 323       M6=M6/2-1
 324       M7=M7/2-1
 325       Z=0.0
 326       GOTO 730
 327 C
 328   140 X=H(M1-N5)/(H(N5+1)*H(M2-N5)*H(M3-N5)*H(M4-N5)
 329      X *H(M5-N5)*H(N5-M6)*H(N5-M7))
 330       IX=J(M1-N5)-J(N5+1)-J(M2-N5)-J(M3-N5)-J(M4-N5)
 331      X -J(M5-N5)-J(N5-M6)-J(N5-M7)
 332   240 IF(IX+IYY)340,440,540
 333   340 X=0.1*X
 334       IX=IX+1
 335       GOTO 240
 336   540 X=10.0  *X
 337       IX=IX-1
 338       GOTO 240
 339   440 IF(N5PAR.LT.0) X=-X
 340       Z=Z+X
 341       N5PAR=-N5PAR
 342       N5=N5+1
 343 C
 344   730 IF(N5.LE.N4) GOTO 140
 345 C
 346       RACAH=Z*Y
 347   840 IF(KEY.LT.-5) GOTO 160
 348       KEY=KEY-10
 349       GOTO(150,250,350),KEY
 350 C
 351   830 RACAH=0.0
 352       IERR=1
 353       IERCT=IERCT+1
 354       GOTO 840
 355 C
 356   150 IJPAR=IPARF(K1+K2+K4+K5)
 357       IF(IJPAR.LT.0) RACAH=-RACAH
 358   250 CLEBSG=RACAH
 359       RETURN
 360 C
 361   350 FACTOR= SQRT((K3+1.0  )*(K6+1))
 362       CLEBSG=FACTOR*RACAH
 363       RETURN
 364   450 K1=INTPTF(A)
 365       K2=INTPTF(B)
 366       K3=INTPTF(C)
 367       K4=INTPTF(XX)
 368       K5=INTPTF(YY)
 369       K6=INTPTF(ZZ)
 370       GOTO 750
 371 C
 372 C     TRIANGLE FUNCTION
 373 C
 374   630 MA=KA+KB-KC
 375       MB=KA-KB+KC
 376       MC=-KA+KB+KC
 377       MD=KA+KB+KC+2
 378       IF(MA.LT.0) GOTO 830
 379       IF(MB.LT.0) GOTO 830
 380       IF(MC.LT.0) GOTO 830
 381       IF((MD-(MD/2)-(MD/2)).NE.0) GOTO 830
 382       MA=MA/2+1
 383       MB=MB/2+1
 384       MC=MC/2+1
 385       MD=MD/2+1
 386       AY(KEYTRI)= SQRT(H(MA)*H(MB)*H(MC)/H(MD))
 387       IAY(KEYTRI)=(J(MA)+J(MB)+J(MC)-J(MD))/2
 388       GOTO(230,330,430,530),KEYTRI
 389 C
 390 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
 391       ENTRY WIGN9J
 392 #endif
 393 #if (defined(CERNLIB_IBM))&&(defined(CERNLIB_F4))
 394       ENTRY WIGN9J(/A/,/B/,/C/,/XX/,/YY/,/ZZ/,/GG/,/HH/,/PP/)
 395 #endif
 396 #if (!defined(CERNLIB_CDC)||!defined(CERNLIB_F4))&&(!defined(CERNLIB_IBM)||!defined(CERNLIB_F4))
 397       ENTRY WIGN9J(A,B,C,XX,YY,ZZ,GG,HH,PP)
 398 #endif
 399 C
 400       KEY=-10
 401       IERR=0
 402 C
 403       KK1=INTPTF(A)
 404       KK2=INTPTF(B)
 405       KK3=INTPTF(C)
 406       KK4=INTPTF(XX)
 407       KK5=INTPTF(YY)
 408       KK6=INTPTF(ZZ)
 409       KK7=INTPTF(GG)
 410       KK8=INTPTF(HH)
 411       KK9=INTPTF(PP)
 412 C
 413       KUP=KK1+KK9
 414       M1=KK4+KK8
 415       M2=KK2+KK6
 416       IF(KUP.GT.M1) KUP=M1
 417       IF(KUP.GT.M2) KUP=M2
 418 C
 419       K=KK1-KK9
 420       IF(K.LT.0) K=-K
 421       M1=KK4-KK8
 422       IF(M1.LT.0) M1=-M1
 423       M2=KK2-KK6
 424       IF(M2.LT.0) M2=-M2
 425       IF(K.LT.M1) K=M1
 426       IF(K.LT.M2) K=M2
 427 C
 428       ANINE=0.0
 429 C
 430   660 IF(K.GT.KUP) GOTO 260
 431       K1=KK1
 432       K2=KK4
 433       K3=KK7
 434       K4=KK8
 435       K5=KK9
 436       K6=K
 437       KEYRAC=1
 438       GOTO 100
 439 C
 440   160 GOTO(360,460,560),KEYRAC
 441 C
 442   360 RA=RACAH
 443       K1=KK2
 444       K2=KK8
 445       K3=KK5
 446       K4=KK4
 447       K5=KK6
 448       KEYRAC=2
 449       GOTO 750
 450 C
 451   460 RB=RACAH
 452       K1=KK9
 453       K2=KK6
 454       K3=KK3
 455       K4=KK2
 456       K5=KK1
 457       KEYRAC=3
 458       GOTO 750
 459 C
 460   560 ANINE=ANINE+RA*RB*RACAH*(K+1)
 461       K=K+2
 462       GOTO 660
 463 C
 464   260 CLEBSG=ANINE
 465       RETURN
 466       END