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_setabc1lo
       8             : !*********************************************************************
       9             : ! calculates the (lower case) a, b and c coefficients for the local
      10             : ! orbitals. The radial function of the local orbital is a linear
      11             : ! combination of the apw radial function and its derivative and the
      12             : ! extra radial funtion (a*u + b*udot + c*ulo). This function is zero
      13             : ! and has zero derivative at the muffin tin boundary.
      14             : ! Philipp Kurz 99/04
      15             : !*********************************************************************
      16             :       CONTAINS
      17       31113 :       SUBROUTINE setabc1lo(atoms, ntyp,ud,usp, alo1,blo1,clo1)
      18             :       USE m_types
      19             :       IMPLICIT NONE
      20             : 
      21             :       TYPE(t_atoms),INTENT(IN)   :: atoms
      22             : !     ..
      23             : !     .. Scalar Arguments ..
      24             :       INTEGER, INTENT (IN)  :: ntyp,usp
      25             : !     ..
      26             : !     .. Array Arguments ..
      27             :       TYPE(t_usdus),INTENT(IN):: ud
      28             :       REAL,    INTENT (OUT) :: alo1(:,:),blo1(:,:),clo1(:,:)
      29             : !     ..
      30             : !     .. Local Scalars ..
      31             :       REAL ka,kb,ws
      32             :       INTEGER l,lo
      33             :       LOGICAL apw_at
      34             : !     ..
      35             : !     ..
      36             : ! look, whether 'ntyp' is a APW atom; then set apw_at=.true.
      37             :       !
      38       70534 :       apw_at=ANY(atoms%l_dulo(:atoms%nlo(ntyp),ntyp))
      39             : 
      40       70534 :       DO lo = 1,atoms%nlo(ntyp)
      41       39421 :          l = atoms%llo(lo,ntyp)
      42       70534 :          IF (apw_at) THEN
      43           0 :            IF (atoms%l_dulo(lo,ntyp)) THEN
      44             : ! udot lo
      45           0 :              ka=sqrt(1+(ud%us(l,ntyp,usp)/ud%uds(l,ntyp,usp))**2* ud%ddn(l,ntyp,usp))
      46           0 :              alo1(lo,usp)=1.00 / ka
      47           0 :              blo1(lo,usp)=-ud%us(l,ntyp,usp)/ (ud%uds(l,ntyp,usp) * ka )
      48           0 :              clo1(lo,usp)=0.00
      49             :            ELSE
      50             : ! u2 lo
      51           0 :              alo1(lo,usp)=1.00
      52           0 :              blo1(lo,usp)=0.00
      53           0 :              clo1(lo,usp)=-ud%us(l,ntyp,usp)/ud%ulos(lo,ntyp,usp)
      54             :            ENDIF
      55             :          ELSE
      56       39421 :            ws = ud%uds(l,ntyp,usp)*ud%dus(l,ntyp,usp) - ud%us(l,ntyp,usp)*ud%duds(l,ntyp,usp)
      57       39421 :            ka = 1.0/ws*(ud%duds(l,ntyp,usp)*ud%ulos(lo,ntyp,usp)- ud%uds(l,ntyp,usp)*ud%dulos(lo,ntyp,usp))
      58       39421 :            kb = 1.0/ws* (ud%us(l,ntyp,usp)*ud%dulos(lo,ntyp,usp)- ud%dus(l,ntyp,usp)*ud%ulos(lo,ntyp,usp))
      59             :            clo1(lo,usp) = 1.0/sqrt(ka**2+ (kb**2)*ud%ddn(l,ntyp,usp)+1.0+ 2.0*ka*ud%uulon(lo,ntyp,usp)+&
      60       39421 :                 2.0*kb*ud%dulon(lo,ntyp,usp))
      61       39421 :            alo1(lo,usp) = ka*clo1(lo,usp)
      62       39421 :            blo1(lo,usp) = kb*clo1(lo,usp)
      63             :          ENDIF
      64             :       END DO
      65             : 
      66       31113 :       END SUBROUTINE setabc1lo
      67             :       END MODULE m_setabc1lo
      68             : !
      69             : !         flo = alo1(lo,usp)*us(l,ntyp) + blo1(lo,usp)*uds(l,ntyp) +
      70             : !     +         clo1(lo,usp)*ulos(lo,ntyp)
      71             : !         dflo = alo1(lo,usp)*dus(l,ntyp) + blo1(lo,usp)*duds(l,ntyp) +
      72             : !     +          clo1(lo,usp)*dulos(lo,ntyp)
      73             : !         nflo = alo1(lo,usp)**2 + (blo1(lo,usp)**2)*ddn(l,ntyp) + clo1(lo,usp)**2 +
      74             : !     +          2*alo1(lo,usp)*clo1(lo,usp)*uulon(lo,ntyp) +
      75             : !     +          2*blo1(lo,usp)*clo1(lo,usp)*dulon(lo,ntyp)