Line data    Source code

       1             : ! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       2             : ! This file is part of FLEUR and available as free software under the conditions
       3             : ! of the MIT license as expressed in the LICENSE file in more detail.
       4             : !--------------------------------------------------------------------------------
       5             : 
       6             : MODULE m_resMoms
       7             : 
       8             : CONTAINS
       9             : 
      10             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      11             : !
      12             : ! This subroutine calculates and writes out intraatomic electric and magnetic dipole
      13             : ! moments resolved with respect to their orbital (angular momentum) origins.
      14             : !
      15             : !                                           GM'2018
      16             : !
      17             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      18             : 
      19           0 : SUBROUTINE resMoms(sym,input,atoms,sphhar,noco,nococonv,den,rhoLRes)
      20             : 
      21             :    USE m_constants
      22             :    USE m_types
      23             :    USE m_juDFT
      24             :    USE m_magDiMom
      25             : 
      26             :    IMPLICIT NONE
      27             :    TYPE(t_sym),           INTENT(IN)    :: sym
      28             :    TYPE(t_input),         INTENT(IN)    :: input
      29             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
      30             :    TYPE(t_sphhar),        INTENT(IN)    :: sphhar
      31             :    TYPE(t_noco),          INTENT(IN)    :: noco
      32             :    TYPE(t_nococonv),      INTENT(IN)    :: nococonv
      33             :    TYPE(t_potden),        INTENT(IN)    :: den
      34             :    REAL,                  INTENT(IN)    :: rhoLRes(:,0:,0:,:,:)
      35             : 
      36           0 :    REAL,    ALLOCATABLE :: rhoTemp(:,:,:,:)
      37             : 
      38           0 :    REAL    :: t_op(3,atoms%ntype), elecDip(3,atoms%ntype)
      39           0 :    REAL    :: res_T_op(3,atoms%ntype,0:(atoms%lmaxd*(atoms%lmaxd+1))/2+atoms%lmaxd)
      40           0 :    REAL    :: resElecDip(3,atoms%ntype,0:(atoms%lmaxd*(atoms%lmaxd+1))/2+atoms%lmaxd)
      41             : 
      42             :    INTEGER :: iType, l, lp, llp
      43             : 
      44           0 :    IF(input%jspins.EQ.1) RETURN
      45           0 :    IF(.NOT.noco%l_noco) RETURN
      46             : 
      47           0 :    t_op = 0.0
      48           0 :    res_T_op = 0.0
      49           0 :    elecDip = 0.0
      50           0 :    resElecDip = 0.0
      51           0 :    ALLOCATE(rhoTemp(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,4))
      52             : 
      53           0 :    rhoTemp = 0.0
      54             : 
      55           0 :    rhoTemp(:,:,:,1) = den%mt(:,:,:,1)
      56           0 :    rhoTemp(:,:,:,2) = den%mt(:,:,:,2)
      57             : 
      58           0 :    IF (noco%l_mperp) THEN
      59           0 :       rhoTemp(:,:,:,3) = den%mt(:,:,:,3)
      60           0 :       rhoTemp(:,:,:,4) = den%mt(:,:,:,4)
      61             : !      WRITE(5000,'(f15.8)') den%mt(:,:,:,3)
      62             : !      WRITE(5000,'(f15.8)') den%mt(:,:,:,4)
      63             :    END IF
      64             : 
      65           0 :    CALL magDiMom(sym,input,atoms,sphhar,noco,nococonv,noco%l_mperp,rhoTemp,t_op,elecDip)
      66             : 
      67           0 :    DO l = 0, input%lResMax
      68           0 :       DO lp = 0, l
      69           0 :          llp = (l* (l+1))/2 + lp
      70           0 :          rhoTemp = 0.0
      71           0 :          rhoTemp(:,:,:,1) = rhoLRes(:,:,llp,:,1)
      72           0 :          rhoTemp(:,:,:,2) = rhoLRes(:,:,llp,:,2)
      73           0 :          rhoTemp(:,:,:,3) = rhoLRes(:,:,llp,:,3)
      74           0 :          rhoTemp(:,:,:,4) = rhoLRes(:,:,llp,:,4)
      75           0 :          CALL magDiMom(sym,input,atoms,sphhar,noco,nococonv,noco%l_mperp,rhoTemp,res_T_op(:,:,llp),resElecDip(:,:,llp))
      76             :       END DO
      77             :    END DO
      78             : 
      79           0 :    DO iType = 1, atoms%ntype
      80           0 :       WRITE(oUnit,*) 'Intraatomic electric and magnetic dipole moments for atom type ', iType,':'
      81           0 :       WRITE(oUnit,'(a)')        '             lowL  largeL      p_x            p_y            p_z            t_x            t_y            t_z'
      82           0 :       WRITE(oUnit,'(a,6f15.8)') 'Overall:              ', elecDip(:,iType), t_op(:,iType)
      83           0 :       DO l = 0, atoms%lmax(iType)
      84           0 :          DO lp = 0, l
      85           0 :             llp = (l* (l+1))/2 + lp
      86           0 :             IF(ALL(ABS(res_T_op(:,iType,llp)).LT.1.0e-8).AND.&
      87             :                ALL(ABS(resElecDip(:,iType,llp)).LT.1.0e-8)) CYCLE
      88           0 :             WRITE(oUnit,'(a,2i6,6f15.8)') '          ', lp, l, resElecDip(:,iType,llp),res_T_op(:,iType,llp)
      89             :          END DO
      90             :       END DO
      91             :    END DO
      92             : 
      93           0 : END SUBROUTINE resMoms
      94             : 
      95             : END MODULE m_resMoms