LCOV - code coverage report
Current view: top level - global - nmat_rot.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 8 55 14.5 %
Date: 2019-09-08 04:53:50 Functions: 1 2 50.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_nmat_rot
       8             : 
       9             : ! Calculate the Wigner rotation matrices for complex spherical
      10             : ! harmonics for all space-group rotations and l=1,2,3. Needed 
      11             : ! for the calculation of the density matrix in nmat.
      12             : !
      13             : ! also allows to use rotated "n_mmp_mat" file by specifying a 
      14             : ! "n_mmp_rot" file (see its use in u_mix or u_setup) 
      15             : !                                                       gb10
      16             :       CONTAINS
      17          42 :       SUBROUTINE nmat_rot(
      18          42 :      >                    alpha,beta,gamma,l_in,n_u,jspins,lty,
      19          42 :      X                    n_mmp)
      20             : 
      21             :       use m_constants
      22             :       USE m_inv3
      23             : 
      24             :       IMPLICIT NONE
      25             : 
      26             : ! .. arguments:
      27             :       INTEGER, INTENT(IN)  :: l_in,n_u,jspins,lty(n_u)
      28             :       REAL,    INTENT(IN)  :: alpha(n_u),beta(n_u),gamma(n_u)
      29             :       COMPLEX, INTENT(INOUT) :: n_mmp(-3:3,-3:3,n_u,jspins)
      30             : 
      31             : ! .. local variables:
      32             :       INTEGER ns,signum,ispin,n
      33             :       INTEGER i,j,k,l,m,mp,x_lo,x_up,x,e_c,e_s
      34             :       REAL fac_l_m,fac_l_mp,fac_lmpx,fac_lmx,fac_x,fac_xmpm
      35             :       REAL co_bh,si_bh,zaehler,nenner,cp,sp
      36             :       REAL sina,sinb,sinc,cosa,cosb,cosc,determ,dt
      37          84 :       COMPLEX phase_g,phase_a,bas,d(-l_in:l_in,-l_in:l_in)
      38          84 :       COMPLEX d_wig(-l_in:l_in,-l_in:l_in,l_in,n_u)
      39          84 :       COMPLEX n_tmp(-l_in:l_in,-l_in:l_in)
      40          84 :       COMPLEX nr_tmp(-l_in:l_in,-l_in:l_in)
      41             :       LOGICAL, SAVE :: written = .false.
      42             : 
      43             :       REAL dmat(3,3),dmati(3,3)
      44             : 
      45             :       IF (ALL(ABS(alpha)<1E-10).AND.ALL(ABS(beta)<1E-10)
      46         210 :      +     .AND.ALL(ABS(gamma)<1E-10)) RETURN
      47             : 
      48             :       
      49           0 :       DO n = 1, n_u
      50             : 
      51           0 :       co_bh = cos(beta(n)*0.5)
      52           0 :       si_bh = sin(beta(n)*0.5)
      53             : 
      54           0 :       DO l = 1, lty(n)
      55           0 :         d = (0.0,0.0)
      56             : 
      57           0 :         DO m = -l,l
      58           0 :           fac_l_m = fac(l+m) * fac(l-m)
      59           0 :           phase_g = exp( - ImagUnit * gamma(n) * m )
      60             : 
      61           0 :           DO mp = -l,l
      62           0 :             fac_l_mp = fac(l+mp) * fac(l-mp)
      63             : 
      64           0 :             zaehler = sqrt( real(fac_l_m * fac_l_mp) )
      65           0 :             phase_a = exp( - ImagUnit * alpha(n) * mp ) 
      66           0 :             x_lo = max(0, m-mp)
      67           0 :             x_up = min(l-mp, l+m)
      68             : 
      69           0 :             bas = zaehler * phase_a * phase_g 
      70           0 :             d(m,mp) = cmplx(0.0,0.0)
      71           0 :             DO x = x_lo,x_up
      72           0 :               fac_lmpx = fac(l-mp-x)
      73           0 :               fac_lmx  = fac(l+m-x)
      74           0 :               fac_x    = fac(x)
      75           0 :               fac_xmpm = fac(x+mp-m)
      76           0 :               nenner = fac_lmpx * fac_lmx * fac_x * fac_xmpm
      77           0 :               e_c = 2*l + m - mp - 2*x 
      78           0 :               e_s = 2*x + mp - m
      79           0 :               IF (e_c.EQ.0) THEN
      80             :                 cp = 1.0
      81             :               ELSE
      82           0 :                 cp = co_bh ** e_c
      83             :               ENDIF
      84           0 :               IF (e_s.EQ.0) THEN
      85             :                 sp = 1.0
      86             :               ELSE
      87           0 :                 sp = si_bh ** e_s
      88             :               ENDIF
      89           0 :               d(m,mp) = d(m,mp) + bas * (-1)**x * cp * sp / nenner
      90             :             ENDDO
      91             : 
      92             :           ENDDO ! loop over mp
      93             :         ENDDO   ! loop over m
      94           0 :         DO m = -l,l
      95           0 :           DO mp = -l,l
      96           0 :             d( m,mp ) = d( m,mp ) * (-1)**(m-mp)
      97             :           ENDDO
      98             :         ENDDO
      99           0 :         d_wig(:,:,l,n) = d(:,:)
     100             : 
     101             :       ENDDO ! l
     102             :       ENDDO ! n 
     103             : 
     104           0 :       DO ispin = 1, jspins
     105           0 :         DO n = 1, n_u
     106           0 :            n_tmp(:,:) = n_mmp(-l_in:l_in,-l_in:l_in,n,ispin)
     107           0 :            d(:,:) = d_wig(:,:,lty(n),n)
     108             : 
     109           0 :            nr_tmp = matmul( transpose( conjg(d) ) , n_tmp)
     110           0 :            n_tmp =  matmul( nr_tmp, d )
     111             : 
     112           0 :            n_mmp(-l_in:l_in,-l_in:l_in,n,ispin) = n_tmp(:,:)
     113             :          ENDDO
     114             :       ENDDO
     115             :       !write(*,'(14f8.4)') n_mmp
     116             : 
     117             :       END SUBROUTINE nmat_rot
     118             : 
     119           0 :       ELEMENTAL REAL FUNCTION  fac(n)
     120             : 
     121             :       INTEGER, INTENT (IN) :: n
     122             :       INTEGER :: i
     123             :  
     124           0 :       fac = 0
     125           0 :       IF (n.LT.0) RETURN
     126           0 :       fac = 1
     127           0 :       IF (n.EQ.0) RETURN
     128           0 :       DO i = 2,n
     129           0 :         fac = fac * i
     130             :       ENDDO
     131             : 
     132             :       END FUNCTION  fac
     133             :       
     134             :       END MODULE m_nmat_rot

Generated by: LCOV version 1.13