LCOV - code coverage report
Current view: top level - ldaX - doubleCounting.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 64 105 61.0 %
Date: 2024-05-14 04:27:50 Functions: 2 3 66.7 %

          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             : MODULE m_doubleCounting
       7             : 
       8             :    USE m_constants
       9             :    USE m_types
      10             :    USE m_coulombPotential
      11             : 
      12             :    IMPLICIT NONE
      13             : 
      14             :    CONTAINS
      15             : 
      16         160 :    FUNCTION doubleCountingPot(density, ldau, U,J, l_spinoffd, l_mix,l_spinAvg, alpha, l_write) RESULT(Vdc)
      17             : 
      18             :       !------------------------------------------------------
      19             :       ! Calculate the Double Counting Correction in either
      20             :       ! the FLL or AMF limit
      21             :       ! If l_spinAvg is True the Double counting will be
      22             :       ! averaged over the spins
      23             :       !------------------------------------------------------
      24             : 
      25             :       COMPLEX,             INTENT(IN)  :: density(-lmaxU_const:,-lmaxU_const:,:)
      26             :       TYPE(t_utype),       INTENT(IN)  :: ldau       !LDA+U information
      27             :       REAL,                INTENT(IN)  :: U, J
      28             :       LOGICAL,             INTENT(IN)  :: l_spinoffd
      29             :       LOGICAL,             INTENT(IN)  :: l_mix      !Mix between FLL and AMF
      30             :       LOGICAL,             INTENT(IN)  :: l_spinAvg  !Do we want a spin averaged double counting
      31             :       REAL,                INTENT(IN)  :: alpha
      32             :       LOGICAL, OPTIONAL,   INTENT(IN)  :: l_write
      33             : 
      34             :       COMPLEX :: Vdc(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,SIZE(density,3))
      35             : 
      36         160 :       COMPLEX, ALLOCATABLE :: modified_density(:,:,:)
      37             :       REAL :: charge, mag(3),mag_m(0:3), tmp, D, Vdcup,Vdcdn
      38             :       COMPLEX :: sigma(2,2,3), r21
      39             :       INTEGER :: spin_dim, ispin,m, spin1,spin2,mp
      40         640 :       type(t_nococonv) :: nococonv !Used only for the procedures on it
      41             : 
      42         160 :       sigma = cmplx_0
      43         160 :       sigma(1,2,1)=CMPLX(1.0,0.0)
      44         160 :       sigma(2,1,1)=CMPLX(1.0,0.0)
      45         160 :       sigma(1,2,2)=CMPLX(0.0,-1.0)
      46         160 :       sigma(2,1,2)=CMPLX(0.0,1.0)
      47         160 :       sigma(1,1,3)=CMPLX(1.0,0.0)
      48         160 :       sigma(2,2,3)=CMPLX(-1.0,0.0)
      49             : 
      50         160 :       spin_dim = SIZE(density,3)
      51         160 :       IF(.NOT.l_spinoffd) spin_dim = MIN(2,spin_dim)
      52             : 
      53         160 :       charge = 0.0
      54         160 :       mag = 0.0
      55             : 
      56         880 :       DO m = -ldau%l, ldau%l
      57         720 :          if (spin_dim==3) then
      58           0 :             r21 = density(m,m,3)
      59             :          else
      60         720 :             r21 = 0.0
      61             :          endif
      62             :          mag_m = nococonv%denmat_to_mag(real(density(m,m,1)),&
      63             :                                         real(density(m,m,min(2,spin_dim))),&
      64         720 :                                         r21)
      65             : 
      66         720 :          charge = charge + mag_m(0)
      67        3040 :          mag = mag + mag_m(1:)
      68             :       ENDDO
      69         160 :       IF(spin_dim == 1) then
      70         104 :          charge=charge/2.0
      71         104 :          mag = 0.0
      72             :       ENDIF
      73             : 
      74       12472 :       Vdc = cmplx_0
      75         160 :       IF(ldau%l_amf) THEN
      76           0 :          ALLOCATE(modified_density(-lmaxU_const:lmaxU_const, -lmaxU_const:lmaxU_const, SIZE(density,3)), source=cmplx_0)
      77           0 :          modified_density = cmplx_0
      78           0 :          D = real(2*(2*ldau%l+1))
      79             : 
      80           0 :          DO ispin = 1, spin_dim
      81             : 
      82           0 :             IF(ispin==3) THEN
      83             :                spin1 = 2
      84             :                spin2 = 1
      85             :             ELSE
      86           0 :                spin1 = ispin
      87           0 :                spin2 = ispin
      88             :             ENDIF
      89             :          
      90           0 :             DO m = -ldau%l, ldau%l
      91           0 :                IF(spin1==spin2) modified_density(m,m,ispin) = charge/D
      92           0 :                modified_density(m,m,ispin) = modified_density(m,m,ispin) + dot_product(mag,sigma(spin1,spin2,:))/D
      93             :             ENDDO
      94             : 
      95             :          ENDDO
      96           0 :          call coulombPotential(modified_density,ldau, MIN(2,SIZE(density,3)), l_spinoffd,Vdc,tmp)
      97             :       ELSE
      98         376 :          DO ispin = 1, spin_dim
      99             : 
     100         216 :             IF(ispin==3) THEN
     101             :                spin1 = 2
     102             :                spin2 = 1
     103             :             ELSE
     104         216 :                spin1 = ispin
     105         216 :                spin2 = ispin
     106             :             ENDIF
     107             : 
     108        1400 :             DO m = -ldau%l, ldau%l
     109        1024 :                IF(spin1 == spin2) Vdc(m,m,ispin) = Vdc(m,m,ispin) + U*(charge-0.5) - J*(charge/2.0-0.5)
     110        4312 :                Vdc(m,m,ispin) = Vdc(m,m,ispin) - J/2.0*dot_product(mag,sigma(spin1,spin2,:))
     111             :             ENDDO
     112             :          ENDDO
     113             :       ENDIF
     114             :       
     115             : 
     116         160 :       IF(PRESENT(l_write)) THEN
     117           0 :          IF(l_write) THEN
     118           0 :             WRITE(oUnit,"(/,A)") 'Double counting chemical potential:'
     119           0 :             IF(ldau%l_amf) THEN
     120           0 :                WRITE(oUnit,9040) 'AMF: ','spin-up','spin-dn','(up+dn)/2','up-dn'
     121             :             ELSE
     122           0 :                WRITE(oUnit,9040) 'FLL: ','spin-up','spin-dn','(up+dn)/2','up-dn'
     123             :             ENDIF
     124             : 9040        FORMAT(TR3,A4,TR1,A7,TR3,A7,TR3,A9,TR3,A5)
     125           0 :             Vdcup = 0.0
     126           0 :             Vdcdn = 0.0
     127           0 :             do m = -ldau%l, ldau%l
     128           0 :                Vdcup = Vdcup + Vdc(m,m,1)/real(2*ldau%l+1)
     129           0 :                Vdcdn = Vdcdn + Vdc(m,m,min(2,spin_dim))/real(2*ldau%l+1)
     130             :             enddo
     131           0 :             WRITE(oUnit,9050) Vdcup,Vdcdn,(Vdcup+Vdcdn)/2.0,Vdcup-Vdcdn
     132             : 9050        FORMAT(TR7,f8.4,TR2,f8.4,TR2,f8.4,TR4,f8.4)
     133             :          ENDIF
     134             :       ENDIF
     135             : 
     136         160 :       IF(l_spinAvg) THEN
     137           0 :          Vdc(:,:,1) = (Vdc(:,:,1)+Vdc(:,:,min(2,spin_dim)))/2.0
     138           0 :          if(spin_dim>1) Vdc(:,:,2) = Vdc(:,:,1)
     139           0 :          if(spin_dim==3) Vdc(:,:,3) = cmplx_0 !Is this right?
     140             :       ENDIF
     141             : 
     142         160 :    END FUNCTION doubleCountingPot
     143             : 
     144             : 
     145         160 :    REAL FUNCTION doubleCountingEnergy(density, ldau, U,J, l_spinoffd, l_mix,l_spinAvg, alpha, l_write)
     146             : 
     147             :       !------------------------------------------------------------
     148             :       ! Calculate the Double Counting Correction Energy in either
     149             :       ! the FLL or AMF limit
     150             :       !------------------------------------------------------------
     151             : 
     152             :       COMPLEX,             INTENT(IN)  :: density(-lmaxU_const:,-lmaxU_const:,:)
     153             :       TYPE(t_utype),       INTENT(IN)  :: ldau       !LDA+U information
     154             :       REAL,                INTENT(IN)  :: U, J
     155             :       LOGICAL,             INTENT(IN)  :: l_spinoffd
     156             :       LOGICAL,             INTENT(IN)  :: l_mix      !Mix between FLL and AMF
     157             :       LOGICAL,             INTENT(IN)  :: l_spinAvg  !Do we want a spin averaged double counting
     158             :       REAL,                INTENT(IN)  :: alpha
     159             :       LOGICAL, OPTIONAL,   INTENT(IN)  :: l_write
     160             : 
     161             :       REAL :: charge, mag(3), mag_m(0:3), D
     162             :       INTEGER :: spin_dim, ispin,m, spin1,spin2
     163         160 :       COMPLEX :: tmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,SIZE(density,3)), r21
     164         160 :       COMPLEX, ALLOCATABLE :: modified_density(:,:,:)
     165             :       COMPLEX :: sigma(2,2,3)
     166         640 :       type(t_nococonv) :: nococonv !Used only for the procedures on it
     167             : 
     168         160 :       sigma = cmplx_0
     169         160 :       sigma(1,2,1)=CMPLX(1.0,0.0)
     170         160 :       sigma(2,1,1)=CMPLX(1.0,0.0)
     171         160 :       sigma(1,2,2)=CMPLX(0.0,-1.0)
     172         160 :       sigma(2,1,2)=CMPLX(0.0,1.0)
     173         160 :       sigma(1,1,3)=CMPLX(1.0,0.0)
     174         160 :       sigma(2,2,3)=CMPLX(-1.0,0.0)
     175             : 
     176         160 :       spin_dim = SIZE(density,3)
     177         160 :       IF(.NOT.l_spinoffd) spin_dim = MIN(2,spin_dim)
     178             : 
     179         160 :       charge = 0.0
     180         160 :       mag = 0.0
     181         880 :       DO m = -ldau%l, ldau%l
     182         720 :          if (spin_dim==3) then
     183           0 :             r21 = density(m,m,3)
     184             :          else
     185         720 :             r21 = 0.0
     186             :          endif
     187             :          mag_m = nococonv%denmat_to_mag(real(density(m,m,1)),&
     188             :                                         real(density(m,m,min(2,spin_dim))),&
     189         720 :                                         r21)
     190             : 
     191         720 :          charge = charge + mag_m(0)
     192        3040 :          mag = mag + mag_m(1:)
     193             :       ENDDO
     194             : 
     195         160 :       IF(spin_dim == 1) then
     196         104 :          charge=charge/2.0
     197         104 :          mag = 0.
     198             :       endif
     199         160 :       if (l_spinAvg) mag = 0.
     200             : 
     201         160 :       doubleCountingEnergy = 0.0
     202         160 :       IF(ldau%l_amf) THEN
     203           0 :          ALLOCATE(modified_density(-lmaxU_const:lmaxU_const, -lmaxU_const:lmaxU_const, SIZE(density,3)), source=cmplx_0)
     204           0 :          modified_density = cmplx_0
     205           0 :          D = real(2*(2*ldau%l+1))
     206             : 
     207           0 :          DO ispin = 1, spin_dim
     208             : 
     209           0 :             IF(ispin==3) THEN
     210             :                spin1 = 2
     211             :                spin2 = 1
     212             :             ELSE
     213           0 :                spin1 = ispin
     214           0 :                spin2 = ispin
     215             :             ENDIF
     216             :          
     217           0 :             DO m = -ldau%l, ldau%l
     218           0 :                IF(spin1==spin2) modified_density(m,m,ispin) = charge/D
     219           0 :                modified_density(m,m,ispin) = modified_density(m,m,ispin) + dot_product(mag,sigma(spin1,spin2,:))/D
     220             :             ENDDO
     221             : 
     222             :          ENDDO
     223           0 :          call coulombPotential(density-modified_density,ldau, MIN(2,SIZE(density,3)), l_spinoffd,tmp,doubleCountingEnergy)
     224             :       ELSE
     225         640 :          doubleCountingEnergy = U/2*charge*(charge-1) -J/2*charge*(charge/2-1)-J*dot_product(mag,mag)/4
     226             :       ENDIF
     227             : 
     228         160 :    END FUNCTION doubleCountingEnergy
     229             : 
     230           0 :    FUNCTION doubleCountingMixFactor(mmpmat, l, charge) Result(alpha)
     231             : 
     232             :       !---------------------------------------------
     233             :       ! Calculate the mixing factor between FLL/AMF
     234             :       !---------------------------------------------
     235             : 
     236             :       COMPLEX,        INTENT(IN) :: mmpmat(-lmaxU_const:, -lmaxU_const:, :)
     237             :       INTEGER,        INTENT(IN) :: l
     238             :       REAL,           INTENT(IN) :: charge
     239             : 
     240             :       REAL :: alpha
     241             : 
     242           0 :       alpha = 0.0
     243             : 
     244           0 :    END FUNCTION
     245             : 
     246             : END MODULE m_doubleCounting

Generated by: LCOV version 1.14