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

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_sgaunt
       8             : CONTAINS
       9          28 :   SUBROUTINE sgaunt(&
      10             :        lmaxw,lmmax,lmm,&
      11          28 :        c)
      12             :     !************************************************************
      13             :     !*   Calculation of the Gaunt coefficients C(L2M2,L1M1,LM)  *
      14             :     !*                                                          *
      15             :     !*    l2m2                    /         *                   *
      16             :     !*   C       =C(l2m2,l1m1,lm)=\dr*Y(r)*Y(r)*Y(r)            *
      17             :     !*    lm,l1m1                 /    lm   l1m1 l2m2           *
      18             :     !*                                                          *
      19             :     !*    and C.ne.0 when l2=/l1-l/,/l1-l/+2,...,l1+l,m2=m1-m   *
      20             :     !*    Y(lm) is a complex spherical garmonic with a phase    *
      21             :     !*    after Condon and Shortley                             *
      22             :     !* Written by S.Yu.Savrasov (P.N.Lebedev Physical Institute)*
      23             :     !************************************************************
      24             :     !*    called by umtx() ; part of the LDA+U package          *
      25             :     !*                                          G.B., Oct. 2000 *
      26             :     !************************************************************
      27             : 
      28             :     USE m_clebsch
      29             :     USE m_constants,ONLY:pi_const
      30             :     IMPLICIT NONE
      31             :     INTEGER, INTENT (IN)  :: lmaxw,lmmax,lmm
      32             : 
      33             :     REAL,    INTENT (OUT) :: c(0:2*lmaxw+1,lmmax,lmmax)
      34             :     INTEGER l1,m1,l ,l1m1,l2,lm,m2,ll2,m
      35             :     REAL    aj,bj,am,bm,cj,cm,dl1,dl2,dl3,a1,a2
      36             : 
      37         140 :     DO l1 = 0,lmm
      38         588 :        DO m1 = -l1,l1
      39        4144 :           DO l = 0,lmm
      40        9408 :              DO m = -l,l
      41        7168 :                 l1m1 = l1*(l1+1)+m1+1
      42        7168 :                 lm   = l*(l+1)+m+1
      43       27832 :                 DO l2 = ABS(l1-l),l1+l,2
      44       18872 :                    ll2 = l2/2
      45       18872 :                    m2  = m1-m
      46       26040 :                    IF (ABS(m2).LE.l2) THEN     !!! selection rule
      47       13944 :                       aj = REAL(l)
      48       13944 :                       bj = REAL(l2)
      49       13944 :                       am = REAL(m)
      50       13944 :                       bm = REAL(m2)
      51       13944 :                       cj = REAL(l1)
      52       13944 :                       cm = REAL(m1)
      53       13944 :                       a1 = clebsch(aj,bj,0.0,0.0,cj,0.0)  !!! Clebsch-Gordan coefficients
      54       13944 :                       a2 = clebsch(aj,bj,am,bm,cj,cm)     !!! Clebsch-Gordan coefficients
      55       13944 :                       dl1 = REAL(2*l +1)
      56       13944 :                       dl2 = REAL(2*l2+1)
      57       13944 :                       dl3 = REAL(2*l1+1)
      58       13944 :                       c(ll2,l1m1,lm)=a1*a2*SQRT(dl1*dl2/dl3/4.0/pi_const)
      59             :                    ELSEIF (ABS(m2).GT.l2)THEN
      60        4928 :                       c(ll2,l1m1,lm)=0.0
      61             :                    ENDIF
      62             :                 ENDDO
      63             : 
      64             :              ENDDO
      65             :           ENDDO
      66             :        ENDDO
      67             :     ENDDO
      68             : 
      69          28 :   END SUBROUTINE sgaunt
      70             : END MODULE m_sgaunt

Generated by: LCOV version 1.13