LCOV - code coverage report
Current view: top level - cdn_mt - abcof3.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 93 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_abcof3
       2             : CONTAINS
       3           0 :   SUBROUTINE abcof3(input,atoms,sym,jspin, cell, bkpt,lapw,&
       4           0 :        usdus,oneD,a,b,bascof_lo)
       5             :     !     ************************************************************
       6             :     !     subroutine constructs the a,b coefficients of the linearized
       7             :     !     m.t. wavefunctions for each band and atom.       c.l. fu
       8             :     !     ************************************************************
       9             : #include "cpp_double.h"
      10             : 
      11             :     USE m_constants, ONLY : tpi_const
      12             :     USE m_setabc1locdn1
      13             :     USE m_sphbes
      14             :     USE m_dsphbs
      15             :     USE m_abclocdn1
      16             :     USE m_ylm
      17             :     USE m_types
      18             :     IMPLICIT NONE
      19             :     TYPE(t_input),INTENT(IN)   :: input
      20             :     TYPE(t_usdus),INTENT(IN)   :: usdus
      21             :     TYPE(t_lapw),INTENT(IN)   :: lapw
      22             :     TYPE(t_oneD),INTENT(IN)   :: oneD
      23             :     TYPE(t_sym),INTENT(IN)    :: sym
      24             :     TYPE(t_cell),INTENT(IN)   :: cell
      25             :     TYPE(t_atoms),INTENT(IN)  :: atoms
      26             :     !     ..
      27             :     !     .. Scalar Arguments ..
      28             :     INTEGER, INTENT (IN) :: jspin 
      29             : 
      30             :     !     .. Array Arguments ..
      31             :     REAL,    INTENT (IN) :: bkpt(3)
      32             :     COMPLEX, INTENT (OUT):: a(:,0:,:)!(dimension%nvd,0:dimension%lmd,atoms%nat)
      33             :     COMPLEX, INTENT (OUT):: b(:,0:,:)!(dimension%nvd,0:dimension%lmd,atoms%nat)
      34             :     COMPLEX, INTENT (OUT):: bascof_lo(3,-atoms%llod:atoms%llod,4*atoms%llod+2,atoms%nlod,atoms%nat)
      35             :     !     .. Local Scalars ..
      36             :     COMPLEX phase,c_0,c_1,c_2
      37             :     REAL const,df,r1,s,tmk,wronk
      38             :     INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,mp
      39             :     INTEGER inv_f,ilo,nvmax,lo,n_ldau,inap,iintsp
      40             :     INTEGER nk_lo_sv,nk_lo,m
      41             :     !     ..
      42             :     !     .. Local Arrays ..
      43           0 :     INTEGER kvec(2*(2*atoms%llod+1),atoms%nlod,atoms%nat  )
      44           0 :     INTEGER nbasf0(atoms%nlod,atoms%nat),nkvec(atoms%nlod,atoms%nat)
      45           0 :     REAL dfj(0:atoms%lmaxd),fj(0:atoms%lmaxd),fk(3),fkp(3),fkr(3)
      46           0 :     REAL alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype),clo1(atoms%nlod,atoms%ntype)
      47           0 :     COMPLEX ylm( (atoms%lmaxd+1)**2 )
      48           0 :     LOGICAL enough(atoms%nat),apw(0:atoms%lmaxd,atoms%ntype)
      49             : 
      50             : 
      51             :     !     
      52           0 :     const = 2 * tpi_const/sqrt(cell%omtil)
      53             :     !
      54           0 :     a         = cmplx(0.0,0.0)
      55           0 :     b         = cmplx(0.0,0.0)
      56           0 :     bascof_lo = cmplx(0.0,0.0)
      57             :     !+APW_LO
      58           0 :     DO n = 1, atoms%ntype
      59           0 :        DO l = 0,atoms%lmax(n)
      60           0 :           apw(l,n) = .false.
      61           0 :           DO lo = 1,atoms%nlo(n)
      62           0 :              IF (atoms%l_dulo(lo,n)) apw(l,n) = .true.
      63             :           ENDDO
      64           0 :           IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l,n) = .false.
      65             : 
      66             :        ENDDO
      67           0 :        DO lo = 1,atoms%nlo(n)
      68           0 :           IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n),n) = .true.
      69             :        ENDDO
      70             :     ENDDO
      71             :     !+APW_LO
      72             :     !
      73           0 :     iintsp = 1
      74             :  
      75             :     CALL setabc1locdn1(jspin, atoms,lapw, sym,usdus,enough,nkvec,kvec,&
      76           0 :          nbasf0,alo1,blo1,clo1)
      77             : 
      78           0 :     nvmax=lapw%nv(jspin)
      79             :     !---> loop over lapws
      80           0 :     DO  k = 1,nvmax
      81             :        !calculate k+G
      82           0 :        fk(1) = bkpt(1) + lapw%k1(k,jspin)
      83           0 :        fk(2) = bkpt(2) + lapw%k2(k,jspin)
      84           0 :        fk(3) = bkpt(3) + lapw%k3(k,jspin)
      85             : 
      86             :        !dotirp(f,g,bbmat) calculates the scalar product of f,g in reciprocal space
      87           0 :        s=dot_product(fk,matmul(fk,cell%bbmat))
      88           0 :        s = sqrt(s) ! s=|k+G|
      89             : 
      90             :        !--->   loop over atom types
      91           0 :        natom = 0
      92           0 :        DO  n = 1,atoms%ntype
      93             :           !calculate R_mt(itype)*|k+G|
      94           0 :           r1 = atoms%rmt(n)*s
      95             : 
      96             :           !compute sph. bessel function at r1 up to order lmax(n) stored in fj(0:lmax(n))
      97           0 :           CALL sphbes(atoms%lmax(n),r1, fj)
      98             : 
      99             :           !compute derivative of sph. bessel function at r1 up to oder lmax(n) stored in dfj(0:lmax(n))
     100           0 :           CALL dsphbs(atoms%lmax(n),r1,fj, dfj)
     101             : 
     102             :           !   ----> construct a and b coefficients
     103           0 :           DO  l = 0,atoms%lmax(n)
     104             :              !calculate |k+G|*d/dx j_l(r1)
     105           0 :              df = s*dfj(l)
     106             : 
     107           0 :              wronk = usdus%uds(l,n,jspin)*usdus%dus(l,n,jspin)-usdus%us(l,n,jspin)*usdus%duds(l,n,jspin) !Wronski determinante
     108           0 :              IF (apw(l,n)) THEN
     109           0 :                 fj(l) = 1.0*const * fj(l)/usdus%us(l,n,jspin)
     110           0 :                 dfj(l) = 0.0
     111             :              ELSE
     112           0 :                 dfj(l) = const* (usdus%dus(l,n,jspin)*fj(l)-df*usdus%us(l,n,jspin))/wronk
     113           0 :                 fj(l) = const* (df*usdus%uds(l,n,jspin)-fj(l)*usdus%duds(l,n,jspin))/wronk
     114             :              ENDIF
     115             :           enddo
     116             :           !   ----> loop over equivalent atoms
     117           0 :           DO  nn = 1,atoms%neq(n)
     118           0 :              natom = natom + 1
     119             :              !invsat(natom) is 0 if atom natom can't be mapped via inversion symmetrie
     120             :              !              is 1 if atom natom can   be mapped via inversion symmetrie and is parent atom
     121             :              !              is 2 if atom natom can   be mapped via inversion symmetrie and is second atom
     122             : 
     123           0 :              IF ((atoms%invsat(natom).EQ.0) .OR. (atoms%invsat(natom).EQ.1)) THEN
     124           0 :                 tmk = tpi_const* dot_product(fk(:),atoms%taual(:,natom))
     125           0 :                 phase = cmplx(cos(tmk),sin(tmk))
     126           0 :                 IF (oneD%odi%d1) THEN
     127           0 :                    inap = oneD%ods%ngopr(natom)
     128             :                    !                nap = ods%ngopr(natom)
     129             :                    !               inap = ods%invtab(nap)
     130             :                 ELSE
     131           0 :                    nap = atoms%ngopr(natom)
     132           0 :                    inap = sym%invtab(nap)
     133             :                 END IF
     134           0 :                 DO  j = 1,3
     135           0 :                    fkr(j) = 0.
     136           0 :                    DO  i = 1,3
     137           0 :                       IF (oneD%odi%d1) THEN
     138           0 :                          fkr(j) = fkr(j) + fk(i)*oneD%ods%mrot(i,j,inap)
     139             :                       ELSE
     140           0 :                          fkr(j) = fkr(j) + fk(i)*sym%mrot(i,j,inap)
     141             :                       END IF
     142             :                    enddo
     143             :                 enddo
     144             :                 !transform fkr from reciprocal internal into reciprocal cartesian coordinates
     145           0 :                 fkp=matmul(fkr,cell%bmat)
     146             :                 !       ----> generate spherical harmonics at fkp up to order lmax(n) stored in ylm(1:(lmax+1)**2)
     147           0 :                 CALL ylm4(atoms%lmax(n),fkp,ylm)
     148             :                 !       ----> loop over l,m
     149           0 :                 DO  l = 0,atoms%lmax(n)
     150           0 :                    ll1 = l* (l+1)
     151           0 :                    DO  m = -l,l
     152           0 :                       lm = ll1 + m
     153           0 :                       c_0 = conjg(ylm(lm+1))*phase
     154           0 :                       c_1 = c_0 *  fj(l)
     155           0 :                       c_2 = c_0 * dfj(l)
     156             : 
     157           0 :                       a(k,lm,natom) = c_1
     158           0 :                       b(k,lm,natom) = c_2
     159             : 
     160             :                    enddo
     161             :                 enddo
     162           0 :                 IF (.NOT.enough(natom)) THEN
     163             :                    CALL abclocdn1(atoms,sym, const,phase,ylm,n,natom,k,s,nvmax,&
     164           0 :                         nbasf0,alo1,blo1,clo1,kvec(1,1,natom), nkvec,enough,bascof_lo )
     165             : 
     166             :                 ENDIF
     167             :              ENDIF    ! invsatom == ( 0 v 1 )
     168             :           enddo    ! loop over equivalent atoms
     169             :        enddo       ! loop over atom types
     170             :     enddo          ! loop over lapws
     171             : 
     172             : 
     173           0 :     iatom = 0
     174           0 :     DO n = 1,atoms%ntype
     175           0 :        DO nn = 1,atoms%neq(n)
     176           0 :           iatom = iatom + 1
     177           0 :           IF (atoms%invsat(iatom).EQ.1) THEN
     178           0 :              jatom = sym%invsatnr(iatom)
     179           0 :              DO ilo = 1,atoms%nlo(n)
     180           0 :                 l = atoms%llo(ilo,n)
     181           0 :                 DO m = -l,l
     182           0 :                    inv_f = (-1.0)**(m+l)
     183           0 :                    DO i = 1,3
     184           0 :                       bascof_lo(i,m,:,ilo,jatom) = inv_f * conjg(  bascof_lo(i,-m,:,ilo,iatom))
     185             :                    ENDDO
     186             :                 ENDDO
     187             :              ENDDO
     188           0 :              DO l = 0,atoms%lmax(n)
     189           0 :                 ll1 = l* (l+1)
     190           0 :                 DO m =-l,l
     191           0 :                    lm  = ll1 + m
     192           0 :                    lmp = ll1 - m
     193           0 :                    inv_f = (-1.0)**(m+l)
     194           0 :                    DO k = 1,nvmax
     195           0 :                       a(k,lm,jatom) = inv_f *conjg(a(k,lmp,iatom))
     196             :                    ENDDO
     197           0 :                    DO k = 1,nvmax
     198           0 :                       b(k,lm,jatom) = inv_f *conjg(b(k,lmp,iatom))
     199             :                    ENDDO
     200             :                 ENDDO
     201             :              ENDDO
     202             :           ENDIF
     203             :        ENDDO
     204             :     ENDDO
     205             : 
     206           0 :   END SUBROUTINE abcof3
     207             : END MODULE m_abcof3

Generated by: LCOV version 1.13