LCOV - code coverage report
Current view: top level - cdn_mt - setabc1locdn1.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 53 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_setabc1locdn1
       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             :   ! In addition the the total number of basisfuntions (apw + lo) nbasf and
      15             :   ! the number of the first basisfunction of each local orbital nbasf0 is
      16             :   ! determined.
      17             :   ! Philipp Kurz 99/04
      18             :   !***********************************************************************
      19             : CONTAINS
      20           0 :   SUBROUTINE setabc1locdn1(jsp,atoms,lapw,sym,usdus,&
      21           0 :         enough,nkvec,kvec,nbasf0, alo1,blo1,clo1)
      22             :     !
      23             :     !*************** ABBREVIATIONS *****************************************
      24             :     ! nbasf   : total number of basisfunctions (apw + lo)
      25             :     ! nbasf0  : number of the first basisfunction of each local orbital
      26             :     ! nkvec   : stores the number of G-vectors that have been found and
      27             :     !           accepted during the construction of the local orbitals.
      28             :     !***********************************************************************
      29             :     USE m_types
      30             :     IMPLICIT NONE
      31             :     TYPE(t_sym),INTENT(IN)     :: sym
      32             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      33             :     TYPE(t_usdus),INTENT(IN)   :: usdus
      34             :     TYPE(t_lapw),INTENT(IN)    :: lapw
      35             :     !     ..
      36             :     !     .. Scalar Arguments ..
      37             :     !     ..
      38             :     INTEGER,INTENT(IN)         :: jsp
      39             :     !     .. Array Arguments ..
      40             :     INTEGER, INTENT (OUT) :: nbasf0(atoms%nlod,atoms%nat),nkvec(atoms%nlod,atoms%nat)
      41             :     INTEGER, INTENT (OUT) :: kvec(2*(2*atoms%llod+1),atoms%nlod,atoms%nat  )
      42             :     REAL,    INTENT (OUT) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
      43             :     REAL,    INTENT (OUT) :: clo1(atoms%nlod,atoms%ntype)
      44             :     LOGICAL, INTENT (OUT) :: enough(atoms%nat)
      45             :     !     ..
      46             :     !     .. Local Scalars ..
      47             :     REAL ka,kb,ws
      48             :     INTEGER i,l,lo ,natom,nbasf,nn,ntyp,lm,m
      49             :     LOGICAL apw_at
      50             :     !     ..
      51           0 :     enough(:) = .true.
      52           0 :     DO ntyp = 1,atoms%ntype
      53             :        !     ..
      54             :        ! look, whether 'ntyp' is a APW atom; then set apw_at=.true.
      55             :        !
      56           0 :        apw_at = .false.
      57           0 :        DO lo = 1,atoms%nlo(ntyp)
      58           0 :           IF (atoms%l_dulo(lo,ntyp)) apw_at = .true.
      59             :        ENDDO
      60             : 
      61           0 :        DO lo = 1,atoms%nlo(ntyp)
      62           0 :           l = atoms%llo(lo,ntyp)
      63           0 :           IF (apw_at) THEN
      64           0 :              IF (atoms%l_dulo(lo,ntyp)) THEN
      65             :                 ! udot lo
      66           0 :                 ka = sqrt( 1+(usdus%us(l,ntyp,jsp)/usdus%uds(l,ntyp,jsp))**2 * usdus%ddn(l,ntyp,jsp))
      67           0 :                 alo1(lo,ntyp)=1.00 / ka
      68           0 :                 blo1(lo,ntyp)=-usdus%us(l,ntyp,jsp)/ (usdus%uds(l,ntyp,jsp) * ka)
      69           0 :                 clo1(lo,ntyp)=0.00
      70             :              ELSE
      71             :                 ! u2 lo
      72           0 :                 alo1(lo,ntyp)=1.00
      73           0 :                 blo1(lo,ntyp)=0.00
      74           0 :                 clo1(lo,ntyp)=-usdus%us(l,ntyp,jsp)/usdus%ulos(lo,ntyp,jsp)
      75             :              ENDIF
      76             :           ELSE
      77           0 :              ws = usdus%uds(l,ntyp,jsp)*usdus%dus(l,ntyp,jsp) - usdus%us(l,ntyp,jsp)*usdus%duds(l,ntyp,jsp)
      78           0 :              ka = 1.0/ws* (usdus%duds(l,ntyp,jsp)*usdus%ulos(lo,ntyp,jsp)- usdus%uds(l,ntyp,jsp)*usdus%dulos(lo,ntyp,jsp))
      79           0 :              kb = 1.0/ws* (usdus%us(l,ntyp,jsp)*usdus%dulos(lo,ntyp,jsp)- usdus%dus(l,ntyp,jsp)*usdus%ulos(lo,ntyp,jsp))
      80             :              clo1(lo,ntyp) = 1.0/sqrt(ka**2+ (kb**2)*usdus%ddn(l,ntyp,jsp)+1.0+&
      81           0 :                   2.0*ka*usdus%uulon(lo,ntyp,jsp)+2.0*kb*usdus%dulon(lo,ntyp,jsp))
      82           0 :              alo1(lo,ntyp) = ka*clo1(lo,ntyp)
      83           0 :              blo1(lo,ntyp) = kb*clo1(lo,ntyp)
      84             :           ENDIF
      85             :        END DO
      86             :     END DO
      87             :     !---> set up enough, nbasf0 and initialize nkvec
      88           0 :     natom = 0
      89           0 :     nbasf = lapw%nv(jsp)
      90           0 :     DO ntyp = 1,atoms%ntype
      91           0 :        DO nn = 1,atoms%neq(ntyp)
      92           0 :           natom = natom + 1
      93           0 :           DO lo = 1,atoms%nlo(ntyp)
      94           0 :              enough(natom) = .false.
      95           0 :              nkvec(lo,natom) = 0
      96           0 :              l = atoms%llo(lo,ntyp)
      97           0 :              IF (atoms%invsat(natom).EQ.0) THEN
      98           0 :                 nbasf0(lo,natom) = nbasf
      99           0 :                 nbasf = nbasf + 2*l + 1
     100             :              END IF
     101           0 :              IF (atoms%invsat(natom).EQ.1) THEN
     102           0 :                 nbasf0(lo,natom) = nbasf
     103           0 :                 nbasf0(lo,sym%invsatnr(natom)) = nbasf
     104           0 :                 nbasf = nbasf + 2* (2*l+1)
     105             :              END IF
     106             :           END DO
     107             :        END DO
     108             :     END DO
     109             : 
     110             : 
     111             :     !      write (*,*) 'in setabc1locdn: nmat = ',nmat,' nbasf = ',nbasf
     112             :     !      write (*,*) 'array nbasf0 :'
     113             :     !      do natom = 1,natd
     114             :     !         write (*,fmt='(15i4)') (nbasf0(lo,natom),lo=1,nlod)
     115             :     !      enddo
     116             :     !      write (*,*)
     117           0 :     IF ((lapw%nmat).NE.nbasf) THEN
     118           0 :        write (*,*) 'in setabc1locdn: lapw%nmat = ',lapw%nmat,' nbasf = ',nbasf
     119           0 :        STOP 'setabc1locdn: number of bas.-fcn.'
     120             :     ENDIF
     121             :     !
     122             :     !--> sort the k-vectors used for the LO's according to atom & lo:
     123             :     !
     124             :     natom = 0
     125             :     lm = 0
     126           0 :     DO ntyp = 1, atoms%ntype
     127           0 :        DO nn = 1, atoms%neq(ntyp)
     128           0 :           natom = natom + 1
     129           0 :           IF ((atoms%invsat(natom).EQ.0) .OR. (atoms%invsat(natom).EQ.1)) THEN
     130           0 :              DO lo = 1,atoms%nlo(ntyp)
     131           0 :                 m = ( atoms%invsat(natom) +1 ) * ( 2 * atoms%llo(lo,ntyp) + 1 )
     132           0 :                 DO l = 1, m
     133           0 :                    lm = lm + 1
     134           0 :                    kvec(l,lo,natom) =  lapw%kvec(l,lo,natom)
     135             :                 ENDDO
     136             :              ENDDO
     137             :           ENDIF
     138             :        ENDDO
     139             :     ENDDO
     140             : 
     141           0 :   END SUBROUTINE setabc1locdn1
     142             : END MODULE m_setabc1locdn1

Generated by: LCOV version 1.13