LCOV - code coverage report
Current view: top level - math - clebsch.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 88 88 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_clebsch
       2             :       CONTAINS
       3       28560 :       REAL FUNCTION clebsch(aj,bj,am,bm,cj,cm)
       4             : ******************************************************************
       5             : *     Program calculates Clebsch-Gordan coefficients                 *
       6             : *     See: Landau and Lifshitz, Vol.3                                *
       7             : *     cj,cm                                                     *
       8             : *     C                                                          *
       9             : *     aj,am,bj,bm                                               *
      10             : *     Written by A.Soldatov (IAE)                                    *
      11             : ******************************************************************
      12             :       IMPLICIT NONE
      13             : 
      14             :       REAL, INTENT (IN) :: aj,bj,am,bm,cj,cm
      15             : 
      16             :       INTEGER n,k,i,i1,i2,i3,i4,i5,i6,i7,i8,i9,i10
      17             :       REAL    x,s,c,e
      18             :       REAL    f(100)
      19             :       INTRINSIC sqrt,exp,min0,max0
      20             : 
      21       28560 :       n = 100
      22       28560 :       k =   0
      23       28560 :       x = 2.0
      24       28560 :       f(1)=0.e0 ; f(2)=0.e0
      25             : 
      26             :       IF ( k <= 0 ) THEN
      27       28560 :          k=1
      28     2827440 :          DO i = 3,n
      29     2798880 :             f(i)=f(i-1)+log(x)
      30     2827440 :             x=x+1.e0
      31             :          ENDDO
      32             :       ENDIF
      33             : 
      34       28560 :       i = am + bm - cm + .1e0
      35       28560 :       IF (( i < 0 ).OR.( i > 0 )) THEN
      36             :          clebsch = 0.e0
      37             :          RETURN
      38             :       ENDIF
      39             : 
      40       28560 :       i1 = aj + bj - cj + 1.1e0
      41       28560 :       IF ( i1 <= 0 ) THEN
      42             :          clebsch = 0.e0
      43             :          RETURN
      44             :       ENDIF
      45             : 
      46       28560 :       i2 = aj - bj + cj + 1.1e0
      47       28560 :       IF ( i2 <= 0 ) THEN
      48             :          clebsch = 0.e0
      49             :          RETURN
      50             :       ENDIF
      51             : 
      52       28560 :       i3 = bj + cj - aj + 1.1e0
      53       28560 :       IF ( i3 <= 0 ) THEN
      54             :          clebsch = 0.e0
      55             :          RETURN
      56             :       ENDIF
      57             : 
      58       28560 :       x  = aj + bj + cj + 2.1e0
      59       28560 :       i4 = x
      60       28560 :       i  = x + .6e0
      61       28560 :       i  = i4 - i
      62       28560 :       IF (( i < 0 ).OR.( i > 0 )) THEN
      63             :          clebsch = 0.e0
      64             :          RETURN
      65             :       ENDIF
      66             : 
      67       28560 :       x = aj + am + 1.1e0
      68       28560 :       i5 = x
      69       28560 :       IF (i5 <= 0 ) THEN
      70             :          clebsch = 0.e0
      71             :          RETURN
      72             :       ENDIF
      73             : 
      74       28488 :       i = x + .6e0
      75       28488 :       i = i - I5
      76       28488 :       IF (( i < 0 ).OR.( i > 0 )) THEN
      77             :          clebsch = 0.e0
      78             :          RETURN
      79             :       ENDIF
      80             : 
      81       28488 :       i6 = aj - am + 1.1e0
      82       28488 :       IF (i6 <= 0 ) THEN
      83             :          clebsch = 0.e0
      84             :          RETURN
      85             :       ENDIF
      86             : 
      87       28416 :       x = bj + bm + 1.1e0
      88       28416 :       i7=X
      89       28416 :       IF (i7 <= 0 ) THEN
      90             :          clebsch = 0.e0
      91             :          RETURN
      92             :       ENDIF
      93             : 
      94       28416 :       i = x + .6e0
      95       28416 :       i = i - i7
      96       28416 :       IF (( i < 0 ).OR.( i > 0 )) THEN
      97             :          clebsch = 0.e0
      98             :          RETURN
      99             :       ENDIF
     100             : 
     101       28416 :       i8 = bj - bm + 1.1e0
     102       28416 :       IF (i8 <= 0 ) THEN
     103             :          clebsch = 0.e0
     104             :          RETURN
     105             :       ENDIF
     106             : 
     107       28416 :       x = cj + cm + 1.1e0
     108       28416 :       i9 = x
     109       28416 :       IF (i9 <= 0 ) THEN
     110             :          clebsch = 0.e0
     111             :          RETURN
     112             :       ENDIF
     113             : 
     114       28416 :       i = x + .6e0
     115       28416 :       i = i - i9
     116       28416 :       IF (( i < 0 ).OR.( i > 0 )) THEN
     117             :          clebsch = 0.e0
     118             :          RETURN
     119             :       ENDIF
     120             : 
     121       28416 :       i10 = cj - cm + 1.1e0
     122       28416 :       IF (i10 <= 0 ) THEN
     123             :          clebsch = 0.e0
     124             :          RETURN
     125             :       ENDIF
     126             : 
     127       28416 :       x = f(i1) + f(i2) + f(i3) - f(i4)
     128       28416 :       i = i5 - i6
     129       28416 :       IF ( i == 0 ) THEN
     130       17432 :          i = i7 - i8
     131       17432 :          IF ( i == 0 ) THEN
     132       14784 :             i  = i4/2
     133       14784 :             i5 = i4*0.5e0 + 0.6e0
     134       14784 :             i = i - i5
     135       14784 :             IF (( i < 0 ).OR.( i > 0 )) THEN
     136             :                clebsch = 0.e0
     137             :                RETURN
     138             :             ENDIF
     139             : 
     140       14784 :             i6 = i5 - i6 + 1
     141       14784 :             i7 = i5 - i8 + 1
     142       14784 :             i8 = i5 - i10 + 1
     143       14784 :             s = x*0.5e0 + f(i5) - f(i6) - f(i7) - f(i8)
     144       14784 :             s = exp(s)
     145       14784 :             i5 = i8/2
     146       14784 :             i6 = i8*0.5e0 + 0.6e0
     147       14784 :             i5 = i5 - I6
     148       14784 :             IF ( i5 == 0 ) THEN
     149        7672 :                s = 1.e0 - s - 1.e0
     150             :             ENDIF
     151             :             
     152       14784 :             clebsch = s*SQRT( cj + cj + 1.e0 )
     153       14784 :             return
     154             :          ENDIF
     155             :       ENDIF
     156             :       
     157       13632 :       x = x + f(i5) + f(i6) + f(i7) + f(i8) + f(i9) + f(i10)
     158       13632 :       x = x*0.5e0
     159       13632 :       i10 = MIN0(i1,i6,i7)
     160       13632 :       i2 = i1 - i5
     161       13632 :       i3 = i1 - i8
     162       13632 :       i9 = MAX0(0,i2,i3) + 1
     163       13632 :       i1 = i1 + 1
     164       13632 :       i6 = i6 + 1
     165       13632 :       i7 = i7 + 1
     166       13632 :       i8 = i9/2
     167       13632 :       e  = 1.e0
     168       13632 :       i5 = i9*0.5e0 + 0.6e0
     169       13632 :       i8 = i8 - i5
     170             : 
     171       13632 :       IF ( i8 == 0 ) THEN
     172        4044 :          e  = -1.e0
     173             :       ENDIF
     174             :       S = 0.e0
     175       45264 :       DO i = i9, i10
     176       15816 :          c = x-f(i)-f(i1-i)-f(i6-i)-f(i7-i)-f(i-i2)-f(i-i3)
     177       15816 :          s = s + e*exp(c)
     178       29448 :          e = 1.e0 - e - 1.e0
     179             :       ENDDO
     180       13632 :       clebsch = SQRT( cj + cj + 1.e0 )*s
     181       13632 :       RETURN
     182             : 
     183             :       
     184             : 
     185             :       END FUNCTION clebsch
     186             :       END MODULE m_clebsch

Generated by: LCOV version 1.13