LCOV - code coverage report
Current view: top level - cdn_mt - setabc1locdn.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 47 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.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_setabc1locdn
       8             :       use m_juDFT
       9             : !***********************************************************************
      10             : ! calculates the (lower case) a, b and c coefficients for the local
      11             : ! orbitals. The radial function of the local orbital is a linear
      12             : ! combination of the apw radial function and its derivative and the
      13             : ! extra radial funtion (a*u + b*udot + c*ulo). This function is zero
      14             : ! and has zero derivative at the muffin tin boundary.
      15             : ! In addition the the total number of basisfuntions (apw + lo) nbasf and
      16             : ! the number of the first basisfunction of each local orbital nbasf0 is
      17             : ! determined.
      18             : ! Philipp Kurz 99/04
      19             : !***********************************************************************
      20             :       CONTAINS
      21           0 :       SUBROUTINE setabc1locdn(&
      22             :                              jspin,atoms,lapw, ne,noco,iintsp, sym,usdus,&
      23           0 :                              enough,nbasf0,ccof, alo1,blo1,clo1)
      24             : !
      25             : !*************** ABBREVIATIONS *****************************************
      26             : ! nbasf   : total number of basisfunctions (apw + lo)
      27             : ! nbasf0  : number of the first basisfunction of each local orbital
      28             : ! nkvec   : stores the number of G-vectors that have been found and
      29             : !           accepted during the construction of the local orbitals.
      30             : !***********************************************************************
      31             :     USE m_types
      32             :       IMPLICIT NONE
      33             :       TYPE(t_noco),INTENT(IN)   :: noco
      34             :       TYPE(t_sym),INTENT(IN)    :: sym
      35             :       TYPE(t_atoms),INTENT(IN)  :: atoms
      36             :       TYPE(t_usdus),INTENT(IN)  :: usdus
      37             :       TYPE(t_lapw),INTENT(IN)   :: lapw
      38             : !     ..
      39             : !     .. Scalar Arguments ..
      40             :       INTEGER, INTENT (IN) :: ne,iintsp,jspin
      41             : !     ..
      42             : !     .. Array Arguments ..
      43             :       INTEGER, INTENT (OUT) :: nbasf0(atoms%nlod,atoms%nat)
      44             :       REAL,    INTENT (OUT) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
      45             :       REAL,    INTENT (OUT) :: clo1(atoms%nlod,atoms%ntype)
      46             :       COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
      47             : 
      48             :       LOGICAL, INTENT (OUT) :: enough(atoms%nat)
      49             : !     ..
      50             : !     .. Local Scalars ..
      51             :       REAL ka,kb,ws
      52             :       INTEGER i,l,lo ,natom,nbasf,nn,ntyp,lm,m
      53             :       LOGICAL apw_at
      54             : !     ..
      55             : !     ..
      56           0 :       enough = .true.
      57           0 :       DO ntyp = 1,atoms%ntype
      58             : !     ..
      59             : ! look, whether 'ntyp' is a APW atom; then set apw_at=.true.
      60             : !
      61           0 :          apw_at = .false.
      62           0 :          DO lo = 1,atoms%nlo(ntyp)
      63           0 :             IF (atoms%l_dulo(lo,ntyp)) apw_at = .true.
      64             :          ENDDO
      65             : 
      66           0 :          DO lo = 1,atoms%nlo(ntyp)
      67           0 :            l = atoms%llo(lo,ntyp)
      68           0 :            IF (apw_at) THEN
      69           0 :              IF (atoms%l_dulo(lo,ntyp)) THEN
      70             : ! udot lo
      71           0 :                ka = sqrt( 1+(usdus%us(l,ntyp,jspin)/usdus%uds(l,ntyp,jspin))**2 * usdus%ddn(l,ntyp,jspin))
      72           0 :                alo1(lo,ntyp)=1.00 / ka
      73           0 :                blo1(lo,ntyp)=-usdus%us(l,ntyp,jspin)/ (usdus%uds(l,ntyp,jspin) * ka)
      74           0 :                clo1(lo,ntyp)=0.00
      75             :              ELSE
      76             : ! u2 lo
      77           0 :                alo1(lo,ntyp)=1.00
      78           0 :                blo1(lo,ntyp)=0.00
      79           0 :                clo1(lo,ntyp)=-usdus%us(l,ntyp,jspin)/usdus%ulos(lo,ntyp,jspin)
      80             :              ENDIF
      81             :            ELSE
      82           0 :              ws = usdus%uds(l,ntyp,jspin)*usdus%dus(l,ntyp,jspin) - usdus%us(l,ntyp,jspin)*usdus%duds(l,ntyp,jspin)
      83           0 :              ka = 1.0/ws* (usdus%duds(l,ntyp,jspin)*usdus%ulos(lo,ntyp,jspin)- usdus%uds(l,ntyp,jspin)*usdus%dulos(lo,ntyp,jspin))
      84           0 :              kb = 1.0/ws* (usdus%us(l,ntyp,jspin)*usdus%dulos(lo,ntyp,jspin)- usdus%dus(l,ntyp,jspin)*usdus%ulos(lo,ntyp,jspin))
      85             :              clo1(lo,ntyp) = 1.0/sqrt(ka**2+ (kb**2)*usdus%ddn(l,ntyp,jspin)+1.0+&
      86           0 :                   2.0*ka*usdus%uulon(lo,ntyp,jspin)+2.0*kb*usdus%dulon(lo,ntyp,jspin))
      87           0 :              alo1(lo,ntyp) = ka*clo1(lo,ntyp)
      88           0 :              blo1(lo,ntyp) = kb*clo1(lo,ntyp)
      89             :            ENDIF
      90             :          END DO
      91             :       END DO
      92             : !---> set up enough, nbasf0 and initialize nkvec
      93           0 :       natom = 0
      94           0 :       nbasf = lapw%nv(jspin)
      95             :       !--->          initialize ccof
      96           0 :       IF (iintsp.NE.2) THEN
      97           0 :          ccof(:,:,:,:)=cmplx(0.,0.)
      98             :       ENDIF
      99           0 :       if (noco%l_ss) nbasf=lapw%nv(iintsp)
     100           0 :       DO ntyp = 1,atoms%ntype
     101           0 :          DO nn = 1,atoms%neq(ntyp)
     102           0 :             natom = natom + 1
     103           0 :             DO lo = 1,atoms%nlo(ntyp)
     104           0 :                enough(natom) = .false.
     105           0 :                l = atoms%llo(lo,ntyp)
     106           0 :                IF (atoms%invsat(natom).EQ.0) THEN
     107           0 :                   nbasf0(lo,natom) = nbasf
     108           0 :                   nbasf = nbasf + 2*l + 1
     109             :                END IF
     110           0 :                IF (atoms%invsat(natom).EQ.1) THEN
     111           0 :                   nbasf0(lo,natom) = nbasf
     112           0 :                   nbasf0(lo,sym%invsatnr(natom)) = nbasf
     113           0 :                   nbasf = nbasf + 2* (2*l+1)
     114             :                END IF
     115             :             END DO
     116             :          END DO
     117             :       END DO
     118             : !      write (*,*) 'in setabc1locdn: nmat = ',nmat,' nbasf = ',nbasf
     119             : !      write (*,*) 'array nbasf0 :'
     120             : !      do natom = 1,natd
     121             : !         write (*,fmt='(15i4)') (nbasf0(lo,natom),lo=1,nlod)
     122             : !      enddo
     123             : !      write (*,*)
     124           0 :       IF ( .NOT. noco%l_noco ) THEN
     125           0 :         IF ((lapw%nmat).NE.nbasf) THEN
     126           0 :           write (*,*) 'in setabc1locdn: lapw%nmat = ',lapw%nmat,' nbasf = ',nbasf
     127           0 :            CALL juDFT_error("number of bas.-fcn.","setabc1locdn")
     128             :         ENDIF
     129             :       ENDIF
     130             : 
     131             : 
     132           0 :       END SUBROUTINE setabc1locdn
     133             :       END MODULE m_setabc1locdn

Generated by: LCOV version 1.13