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_rotate_mt_den_tofrom_local
       8             :    USE m_juDFT
       9             :    USE m_polangle
      10             :    USE m_types
      11             :    USE m_constants
      12             :    USE m_mt_tofrom_grid
      13             :    
      14             :    IMPLICIT NONE
      15             : 
      16             : CONTAINS
      17             : 
      18          22 :    SUBROUTINE rotate_mt_den_to_local(atoms,sphhar,sym,noco,den)
      19             :       TYPE(t_atoms),  INTENT(IN)    :: atoms
      20             :       TYPE(t_sphhar), INTENT(IN)    :: sphhar
      21             :       TYPE(t_sym),    INTENT(IN)    :: sym
      22             :       TYPE(t_noco),   INTENT(IN)    :: noco
      23             :       TYPE(t_potden), INTENT(INOUT) :: den
      24             : 
      25          22 :       TYPE(t_gradients)             :: grad
      26             : 
      27             :       INTEGER                       :: n, nsp, imesh, i
      28             :       REAL                          :: rho_11, rho_22, rho_21r, rho_21i
      29             :       REAL                          :: mx, my, mz, magmom
      30             :       REAL                          :: rhotot, rho_up, rho_down, theta, phi
      31             :       REAL                          :: eps=1E-10
      32             :       REAL, ALLOCATABLE             :: ch(:,:)
      33             : 
      34          22 :       nsp=atoms%nsp()
      35           0 :       ALLOCATE(ch(nsp*atoms%jmtd,4), den%theta_mt(nsp*atoms%jmtd,atoms%ntype), &
      36         176 :                                      den%phi_mt(nsp*atoms%jmtd,atoms%ntype))
      37             : 
      38          22 :       CALL init_mt_grid(4,atoms,sphhar,.FALSE.,sym)
      39             : 
      40          56 :       DO n=1,atoms%ntype
      41             : 
      42          34 :          CALL mt_to_grid(.FALSE.,4,atoms,sym,sphhar,.FALSE.,den%mt(:,0:,n,:),n,noco,grad,ch)
      43             : 
      44     4494602 :          DO imesh = 1, nsp*atoms%jri(n)
      45     4494568 :             rho_11   = ch(imesh,1)
      46     4494568 :             rho_22   = ch(imesh,2)
      47     4494568 :             rho_21r  = ch(imesh,3)
      48     4494568 :             rho_21i  = ch(imesh,4)
      49     4494568 :             mx       =  2*rho_21r
      50     4494568 :             my       = -2*rho_21i
      51     4494568 :             mz       = rho_11 - rho_22
      52     4494568 :             magmom   = SQRT(mx**2 + my**2 + mz**2)
      53     4494568 :             rhotot   = rho_11 + rho_22
      54     4494568 :             rho_up   = (rhotot + magmom)/2
      55     4494568 :             rho_down = (rhotot - magmom)/2
      56             : 
      57     4494568 :             CALL pol_angle(mx,my,mz,theta,phi)
      58             : 
      59     4494568 :             ch(imesh,1) = rho_up
      60     4494568 :             ch(imesh,2) = rho_down
      61     4494568 :             den%theta_mt(imesh,n) = theta
      62     4494602 :             den%phi_mt(imesh,n) = phi
      63             :          END DO
      64     8254058 :          den%mt(:,0:,n,:)=0.0
      65          34 :          CALL mt_from_grid(atoms,sym,sphhar,n,2,ch,den%mt(:,0:,n,:))
      66       25774 :          DO i=1,atoms%jri(n)
      67     8371616 :             den%mt(i,:,n,:)=den%mt(i,:,n,:)*atoms%rmsh(i,n)**2
      68             :          END DO
      69             :       END DO
      70             : 
      71          22 :       CALL finish_mt_grid()
      72             : 
      73          22 :    END SUBROUTINE rotate_mt_den_to_local
      74             : 
      75          22 :    SUBROUTINE rotate_mt_den_from_local(atoms,sphhar,sym,den,noco,vtot)
      76             :       TYPE(t_atoms),  INTENT(IN)    :: atoms
      77             :       TYPE(t_sphhar), INTENT(IN)    :: sphhar
      78             :       TYPE(t_sym),    INTENT(IN)    :: sym
      79             :       TYPE(t_potden), INTENT(IN)    :: den
      80             :       TYPE(t_noco),   INTENT(IN)    :: noco
      81             :       TYPE(t_potden), INTENT(INOUT) :: vtot
      82             : 
      83          22 :       TYPE(t_gradients)             :: grad
      84             : 
      85             :       INTEGER                       :: n, nsp, imesh, i
      86             :       REAL                          :: vup, vdown, veff, beff, theta, phi
      87          22 :       REAL, ALLOCATABLE             :: ch(:,:), chtmp(:,:)
      88             : 
      89          22 :       nsp=atoms%nsp()
      90          66 :       ALLOCATE(ch(nsp*atoms%jmtd,4))
      91          66 :       ALLOCATE(chtmp(nsp*atoms%jmtd,2))
      92             : 
      93          22 :       CALL init_mt_grid(4,atoms,sphhar,.FALSE.,sym)
      94          56 :       DO n=1,atoms%ntype
      95             : 
      96       25752 :          DO i=1,atoms%jri(n)
      97     8371616 :             vtot%mt(i,:,n,:)=vtot%mt(i,:,n,:)*atoms%rmsh(i,n)**2
      98             :          END DO
      99             : 
     100          34 :          CALL mt_to_grid(.FALSE.,2,atoms,sym,sphhar,.FALSE.,vtot%mt(:,0:,n,:),n,noco,grad,chtmp(:,1:2))
     101             : 
     102     4494602 :          DO imesh = 1, nsp*atoms%jri(n)
     103     4494568 :             vup         = chtmp(imesh,1)
     104     4494568 :             vdown       = chtmp(imesh,2)
     105     4494568 :             theta       = den%theta_mt(imesh,n)
     106     4494568 :             phi         = den%phi_mt(imesh,n)
     107     4494568 :             veff        = (vup + vdown)/2.0
     108     4494568 :             beff        = (vup - vdown)/2.0
     109     4494568 :             ch(imesh,1) = veff + beff*COS(theta)
     110     4494568 :             ch(imesh,2) = veff - beff*COS(theta)
     111     4494568 :             ch(imesh,3) = beff*SIN(theta)*COS(phi)
     112     4494602 :             ch(imesh,4) = beff*SIN(theta)*SIN(phi)
     113             :          END DO
     114             : 
     115     8254058 :          vtot%mt(:,0:,n,:)=0.0
     116             : 
     117          56 :          CALL mt_from_grid(atoms,sym,sphhar,n,4,ch,vtot%mt(:,0:,n,:))
     118             : 
     119             :       END DO
     120             : 
     121          22 :       CALL finish_mt_grid()
     122             : 
     123          22 :    END SUBROUTINE rotate_mt_den_from_local
     124             : 
     125             : END MODULE m_rotate_mt_den_tofrom_local