This commit was generated by cvs2svn to compensate for changes in r2,

[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / u / djmnb64.F

diff --git a/MINICERN/mathlib/gen/u/djmnb64.F b/MINICERN/mathlib/gen/u/djmnb64.F
new file mode 100644 (file)
index 0000000..e015322
--- /dev/null
+++ b/MINICERN/mathlib/gen/u/djmnb64.F
@@ -0,0 +1,141 @@
+*
+* $Id$
+*
+* $Log$
+* Revision 1.1.1.1  1996/04/01 15:01:49  mclareni
+* Mathlib gen
+*
+*
+#include "gen/pilot.h"
+#if !defined(CERNLIB_DOUBLE)
+      FUNCTION RDJMNB(AJ,AM,AN,BETA)
+#endif
+#if defined(CERNLIB_DOUBLE)
+      FUNCTION DDJMNB(AJ,AM,AN,BETA)
+#include "gen/imp64.inc"
+#endif
+C     Calculates the beta-term
+C                         d j mn (beta)
+C     in the matrix element of the finite rotation operator
+C     (Wigner's D-function), according to formula 4.3.1(3) in
+C     D.A. Varshalovich, A.N. Moskalev, and V.K. Khersonskii,
+C     Quantum Theory of Angular Momentum, World Scientific,
+C     Singapore 1988
+
+
+      CHARACTER NAME*(*)
+      CHARACTER*80 ERRTXT
+#if !defined(CERNLIB_DOUBLE)
+      PARAMETER (NAME = 'DJMNB')
+#endif
+#if defined(CERNLIB_DOUBLE)
+      PARAMETER (NAME = 'DDJMNB')
+#endif
+      DIMENSION FCL(0:50)
+
+      PARAMETER (Z1 = 1, HF = Z1/2)
+      PARAMETER (F = 8.72664 62599 71647 88D-3)
+
+      DATA FCL( 0) /0/
+      DATA FCL( 1) /0/
+      DATA FCL( 2) /6.93147180559945309D-01/
+      DATA FCL( 3) /1.79175946922805500D+00/
+      DATA FCL( 4) /3.17805383034794562D+00/
+      DATA FCL( 5) /4.78749174278204599D+00/
+      DATA FCL( 6) /6.57925121201010100D+00/
+      DATA FCL( 7) /8.52516136106541430D+00/
+      DATA FCL( 8) /1.06046029027452502D+01/
+      DATA FCL( 9) /1.28018274800814696D+01/
+      DATA FCL(10) /1.51044125730755153D+01/
+      DATA FCL(11) /1.75023078458738858D+01/
+      DATA FCL(12) /1.99872144956618861D+01/
+      DATA FCL(13) /2.25521638531234229D+01/
+      DATA FCL(14) /2.51912211827386815D+01/
+      DATA FCL(15) /2.78992713838408916D+01/
+      DATA FCL(16) /3.06718601060806728D+01/
+      DATA FCL(17) /3.35050734501368889D+01/
+      DATA FCL(18) /3.63954452080330536D+01/
+      DATA FCL(19) /3.93398841871994940D+01/
+      DATA FCL(20) /4.23356164607534850D+01/
+      DATA FCL(21) /4.53801388984769080D+01/
+      DATA FCL(22) /4.84711813518352239D+01/
+      DATA FCL(23) /5.16066755677643736D+01/
+      DATA FCL(24) /5.47847293981123192D+01/
+      DATA FCL(25) /5.80036052229805199D+01/
+      DATA FCL(26) /6.12617017610020020D+01/
+      DATA FCL(27) /6.45575386270063311D+01/
+      DATA FCL(28) /6.78897431371815350D+01/
+      DATA FCL(29) /7.12570389671680090D+01/
+      DATA FCL(30) /7.46582363488301644D+01/
+      DATA FCL(31) /7.80922235533153106D+01/
+      DATA FCL(32) /8.15579594561150372D+01/
+      DATA FCL(33) /8.50544670175815174D+01/
+      DATA FCL(34) /8.85808275421976788D+01/
+      DATA FCL(35) /9.21361756036870925D+01/
+      DATA FCL(36) /9.57196945421432025D+01/
+      DATA FCL(37) /9.93306124547874269D+01/
+      DATA FCL(38) /1.02968198614513813D+02/
+      DATA FCL(39) /1.06631760260643459D+02/
+      DATA FCL(40) /1.10320639714757395D+02/
+      DATA FCL(41) /1.14034211781461703D+02/
+      DATA FCL(42) /1.17771881399745072D+02/
+      DATA FCL(43) /1.21533081515438634D+02/
+      DATA FCL(44) /1.25317271149356895D+02/
+      DATA FCL(45) /1.29123933639127215D+02/
+      DATA FCL(46) /1.32952575035616310D+02/
+      DATA FCL(47) /1.36802722637326368D+02/
+      DATA FCL(48) /1.40673923648234259D+02/
+      DATA FCL(49) /1.44565743946344886D+02/
+      DATA FCL(50) /1.48477766951773032D+02/
+
+      JPM=NINT(AJ+AM)
+      JPN=NINT(AJ+AN)
+      JMM=NINT(AJ-AM)
+      JMN=NINT(AJ-AN)
+      MPN=NINT(AM+AN)
+
+      IF(JPM .LT. 0 .OR. JPN .LT. 0 .OR. JMM .LT. 0 .OR. JMN .LT. 0
+     1 .OR. AJ .LT. 0 .OR. AJ .GT. 25
+     2 .OR. BETA .LT. 0 .OR. BETA .GT. 360) THEN
+       R=0
+       WRITE(ERRTXT,101) AJ,AM,AN,BETA
+       CALL MTLPRT(NAME,'U501.1',ERRTXT)
+      ELSEIF(BETA .EQ. 0) THEN
+       R=0
+       IF(JPM .EQ. JPN) R=1
+      ELSEIF(BETA .EQ. 180) THEN
+       R=0
+       IF(JPM .EQ. JMN) R=(-1)**MOD(ABS(JPM),2)
+      ELSEIF(BETA .EQ. 360) THEN
+       R=0
+       IF(JPM .EQ. JPN) R=(-1)**MOD(ABS(MPN),2)
+      ELSE
+       B=F*BETA
+       S=LOG(SIN(B))
+       C=LOG(ABS(COS(B)))
+       RT=HF*(FCL(JPM)+FCL(JMM)+FCL(JPN)+FCL(JMN))
+       K0=MAX(0,MPN)
+       KQ=K0+JPM
+       IF(BETA .GT. 180) KQ=KQ+MPN
+       Q=(-1)**KQ
+       KQ=K0+K0
+       CX=KQ-MPN
+       SX=JPM+JPN-KQ
+       R=0
+       DO 1 K = K0,MIN(JPM,JPN)
+       R=R+Q*EXP(RT-FCL(K)-FCL(JPM-K)-FCL(JPN-K)-FCL(K-MPN)+
+     1           CX*C+SX*S)
+       CX=CX+2
+       SX=SX-2
+    1  Q=-Q
+      ENDIF
+#if !defined(CERNLIB_DOUBLE)
+      RDJMNB=R
+#endif
+#if defined(CERNLIB_DOUBLE)
+      DDJMNB=R
+#endif
+      RETURN
+  101 FORMAT('ILLEGAL ARGUMENT(S) AJ = ',F6.1,' AM = ',F6.1,' AN = ',
+     1        F6.1,' BETA = ',F8.2)
+      END