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           44 :                                      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           22 :       ALLOCATE(ch(nsp*atoms%jmtd,4))
      91           22 :       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