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             : 
       9             :    USE m_clebsch
      10             :    USE m_constants,ONLY:pi_const
      11             : 
      12             :    IMPLICIT NONE
      13             : 
      14             :    CONTAINS
      15         160 :    SUBROUTINE sgaunt(lmax,c)
      16             : 
      17             :       !************************************************************
      18             :       !*   Calculation of the Gaunt coefficients C(L2M2,L1M1,LM)  *
      19             :       !*                                                          *
      20             :       !*    l2m2                    /         *                   *
      21             :       !*   C       =C(l2m2,l1m1,lm)=\dr*Y(r)*Y(r)*Y(r)            *
      22             :       !*    lm,l1m1                 /    lm   l1m1 l2m2           *
      23             :       !*                                                          *
      24             :       !*    and C.ne.0 when l2=/l1-l/,/l1-l/+2,...,l1+l,m2=m1-m   *
      25             :       !*    Y(lm) is a complex spherical garmonic with a phase    *
      26             :       !*    after Condon and Shortley                             *
      27             :       !* Written by S.Yu.Savrasov (P.N.Lebedev Physical Institute)*
      28             :       !************************************************************
      29             :       !*    called by umtx() ; part of the LDA+U package          *
      30             :       !*                                          G.B., Oct. 2000 *
      31             :       !************************************************************
      32             : 
      33             :       INTEGER, INTENT(IN)    :: lmax
      34             :       REAL,    INTENT(INOUT) :: c(0:,:,:)
      35             : 
      36             :       INTEGER :: l1,m1,l ,l1m1,l2,lm,m2,ll2,m
      37             :       REAL    :: aj,bj,am,bm,cj,cm,dl1,dl2,dl3,a1,a2
      38             : 
      39         800 :       DO l1 = 0,lmax
      40        3360 :          DO m1 = -l1,l1
      41       13440 :             DO l = 0,lmax
      42       53760 :                DO m = -l,l
      43       40960 :                   l1m1 = l1*(l1+1)+m1+1
      44       40960 :                   lm   = l *(l +1)+m +1
      45      159040 :                   DO l2 = ABS(l1-l),l1+l,2
      46      107840 :                      ll2 = l2/2
      47      107840 :                      m2  = m1-m
      48      148800 :                      IF (ABS(m2).LE.l2) THEN     !!! selection rule
      49       79680 :                         aj = REAL(l)
      50       79680 :                         bj = REAL(l2)
      51       79680 :                         am = REAL(m)
      52       79680 :                         bm = REAL(m2)
      53       79680 :                         cj = REAL(l1)
      54       79680 :                         cm = REAL(m1)
      55       79680 :                         a1 = clebsch(aj,bj,0.0,0.0,cj,0.0)  !!! Clebsch-Gordan coefficients
      56       79680 :                         a2 = clebsch(aj,bj,am,bm,cj,cm)     !!! Clebsch-Gordan coefficients
      57       79680 :                         dl1 = REAL(2*l +1)
      58       79680 :                         dl2 = REAL(2*l2+1)
      59       79680 :                         dl3 = REAL(2*l1+1)
      60       79680 :                         c(ll2,l1m1,lm)=a1*a2*SQRT(dl1*dl2/dl3/4.0/pi_const)
      61             :                      ELSEIF (ABS(m2).GT.l2)THEN
      62       28160 :                         c(ll2,l1m1,lm)=0.0
      63             :                      ENDIF
      64             :                   ENDDO
      65             :                ENDDO
      66             :             ENDDO
      67             :          ENDDO
      68             :       ENDDO
      69             : 
      70         160 :    END SUBROUTINE sgaunt
      71             : END MODULE m_sgaunt