LCOV - code coverage report
Current view: top level - eigen - setabc1lo.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 12 20 60.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          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        5400 :       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(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
      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        5400 :       apw_at=ANY(atoms%l_dulo(:atoms%nlo(ntyp),ntyp))
      39             :       
      40        9292 :       DO lo = 1,atoms%nlo(ntyp)
      41        3892 :          l = atoms%llo(lo,ntyp)
      42        9292 :          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)=1.00 / ka
      47           0 :              blo1(lo)=-ud%us(l,ntyp,usp)/ (ud%uds(l,ntyp,usp) * ka )
      48           0 :              clo1(lo)=0.00
      49             :            ELSE
      50             : ! u2 lo
      51           0 :              alo1(lo)=1.00
      52           0 :              blo1(lo)=0.00
      53           0 :              clo1(lo)=-ud%us(l,ntyp,usp)/ud%ulos(lo,ntyp,usp)
      54             :            ENDIF
      55             :          ELSE
      56        3892 :            ws = ud%uds(l,ntyp,usp)*ud%dus(l,ntyp,usp) - ud%us(l,ntyp,usp)*ud%duds(l,ntyp,usp)
      57        3892 :            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        3892 :            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) = 1.0/sqrt(ka**2+ (kb**2)*ud%ddn(l,ntyp,usp)+1.0+ 2.0*ka*ud%uulon(lo,ntyp,usp)+&
      60        3892 :                 2.0*kb*ud%dulon(lo,ntyp,usp))
      61        3892 :            alo1(lo) = ka*clo1(lo)
      62        3892 :            blo1(lo) = kb*clo1(lo)
      63             :          ENDIF 
      64             :       END DO
      65             : 
      66        5400 :       END SUBROUTINE setabc1lo
      67             :       END MODULE m_setabc1lo
      68             : !
      69             : !         flo = alo1(lo)*us(l,ntyp) + blo1(lo)*uds(l,ntyp) +
      70             : !     +         clo1(lo)*ulos(lo,ntyp)
      71             : !         dflo = alo1(lo)*dus(l,ntyp) + blo1(lo)*duds(l,ntyp) +
      72             : !     +          clo1(lo)*dulos(lo,ntyp)
      73             : !         nflo = alo1(lo)**2 + (blo1(lo)**2)*ddn(l,ntyp) + clo1(lo)**2 +
      74             : !     +          2*alo1(lo)*clo1(lo)*uulon(lo,ntyp) +
      75             : !     +          2*blo1(lo)*clo1(lo)*dulon(lo,ntyp)

Generated by: LCOV version 1.13