LCOV - code coverage report
Current view: top level - wannier - wann_mmk0_updown_sph.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 95 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_wann_mmk0_updown_sph
       8             :       CONTAINS
       9           0 :       SUBROUTINE wann_mmk0_updown_sph(
      10           0 :      >               l_noco,alph,beta,
      11           0 :      >               llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
      12           0 :      >               ntype,neq,nlo,llo,
      13           0 :      >               radial1_ff,radial1_gg,
      14           0 :      >               radial1_fg,radial1_gf,
      15           0 :      >               radial1_flo,radial1_glo,
      16           0 :      >               radial1_lof,radial1_log, 
      17           0 :      >               radial1_lolo,
      18           0 :      >               acof,bcof,ccof,
      19             :      >               ddn,uulon,dulon,uloulopn,
      20           0 :      =               mmn)
      21             : c************************************************************
      22             : c     Overlaps of the spin-down parts of the Bloch functions
      23             : c     with the spin-up parts.
      24             : c                           Frank Freimuth
      25             : c************************************************************
      26             :       use m_constants
      27             :       implicit none
      28             :       logical, intent (in)  :: l_noco
      29             :       integer, intent (in)  :: llod,nlod,natd,ntypd,lmaxd,lmd
      30             :       integer, intent (in)  :: lmax(:) !(ntypd)
      31             :       integer, intent (in)  :: ntype,noccbd
      32             :       REAL,    INTENT (IN)  :: alph(ntypd),beta(ntypd)
      33             :       integer, intent (in)  :: neq(ntypd)
      34             :       integer, intent (in)  :: nlo(ntypd),llo(nlod,ntypd)
      35             :       real,    intent (in)  :: radial1_ff(:,:,0:,0:,:)
      36             :       real,    intent (in)  :: radial1_gg(:,:,0:,0:,:)      
      37             :       real,    intent (in)  :: radial1_fg(:,:,0:,0:,:)
      38             :       real,    intent (in)  :: radial1_gf(:,:,0:,0:,:)
      39             :       real,intent(in)       :: radial1_flo(:,:,0:,:,:)
      40             :       real,intent(in)       :: radial1_glo(:,:,0:,:,:)
      41             :       real,intent(in)       :: radial1_lof(:,:,:,0:,:)
      42             :       real,intent(in)       :: radial1_log(:,:,:,0:,:)
      43             :       real,intent(in)       :: radial1_lolo(:,:,:,:,:)
      44             :       real,    intent (in)  :: ddn(0:lmaxd,ntypd,2)
      45             :       real,    intent (in)  :: uloulopn(nlod,nlod,ntypd,2)
      46             :       real,    intent (in)  :: uulon(nlod,ntypd,2),dulon(nlod,ntypd,2)
      47             :       complex, intent (in)  :: ccof(-llod:llod,noccbd,nlod,natd,2)
      48             :       complex, intent (in)  :: acof(noccbd,0:lmd,natd,2)
      49             :       complex, intent (in)  :: bcof(noccbd,0:lmd,natd,2)
      50             :       complex, intent (inout) :: mmn(noccbd,noccbd)
      51             : 
      52             :       integer           :: i,j,l,lo,lop,m,natom,nn,ntyp
      53             :       integer           :: nt1,nt2,lm,n,ll1,i1spin,i2spin
      54             :       complex           :: suma,sumb,sumc,sumd
      55             :       complex           :: suma12(2,2),sumb12(2,2)
      56             :       complex           :: sumc12(2,2),sumd12(2,2)
      57           0 :       complex, allocatable :: qlo(:,:,:,:,:)
      58           0 :       complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
      59           0 :       complex, allocatable :: qcloa(:,:,:,:),qclob(:,:,:,:)
      60             :       COMPLEX           :: ccchi(2,2)
      61             : 
      62             :       allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd), 
      63             :      +          qaclo(noccbd,noccbd,nlod,ntypd),
      64             :      +          qbclo(noccbd,noccbd,nlod,ntypd),
      65             :      +          qcloa(noccbd,noccbd,nlod,ntypd),
      66           0 :      +          qclob(noccbd,noccbd,nlod,ntypd))
      67             :  
      68             : c---> performs summations of the overlaps of the wavefunctions
      69           0 :       do i = 1,noccbd            
      70           0 :        do j = 1,noccbd
      71           0 :          nt1 = 1
      72           0 :          do n = 1,ntype
      73           0 :           if(l_noco)then
      74           0 :             ccchi(1,1) = conjg( exp( ImagUnit*alph(n)/2)*cos(beta(n)/2))
      75           0 :             ccchi(1,2) = conjg(-exp( ImagUnit*alph(n)/2)*sin(beta(n)/2))
      76           0 :             ccchi(2,1) = conjg( exp(-ImagUnit*alph(n)/2)*sin(beta(n)/2))
      77           0 :             ccchi(2,2) = conjg( exp(-ImagUnit*alph(n)/2)*cos(beta(n)/2))
      78             :             endif
      79           0 :             nt2 = nt1 + neq(n) - 1
      80           0 :             do l = 0,lmax(n)
      81           0 :              if(.not.l_noco)then  
      82           0 :                suma = cmplx(0.,0.)
      83           0 :                sumb = cmplx(0.,0.)
      84           0 :                sumc = cmplx(0.,0.)
      85           0 :                sumd = cmplx(0.,0.)
      86           0 :                ll1 = l* (l+1)
      87           0 :                do m = -l,l
      88           0 :                   lm = ll1 + m
      89           0 :                   do natom = nt1,nt2
      90             :                     suma = suma + acof(i,lm,natom,1)*
      91           0 :      +                      conjg(acof(j,lm,natom,2))
      92             :                     sumb = sumb + bcof(i,lm,natom,1)*
      93           0 :      +                      conjg(bcof(j,lm,natom,2))
      94             :                     sumc = sumc + acof(i,lm,natom,1)*
      95           0 :      +                      conjg(bcof(j,lm,natom,2))
      96             :                     sumd = sumd + bcof(i,lm,natom,1)*
      97           0 :      +                      conjg(acof(j,lm,natom,2))
      98             :                   enddo !natom
      99             :                enddo !m      
     100             :                mmn(i,j) = mmn(i,j) + ( suma*radial1_ff(1,2,l,l,n)+
     101             :      +                                 sumb*radial1_gg(1,2,l,l,n)+
     102             :      +                                 sumc*radial1_fg(1,2,l,l,n)+
     103           0 :      +                                 sumd*radial1_gf(1,2,l,l,n)  )      
     104             :              else
     105           0 :                suma12 = cmplx(0.,0.)
     106           0 :                sumb12 = cmplx(0.,0.)
     107           0 :                sumc12 = cmplx(0.,0.)
     108           0 :                sumd12 = cmplx(0.,0.)
     109           0 :                ll1 = l* (l+1)
     110           0 :                do i1spin=1,2
     111           0 :                 do i2spin=1,2
     112           0 :                  do m = -l,l
     113           0 :                   lm = ll1 + m
     114           0 :                   do natom = nt1,nt2
     115             :                     suma12(i1spin,i2spin) = suma12(i1spin,i2spin) 
     116             :      +                      + acof(i,lm,natom,i1spin)*
     117           0 :      +                      conjg(acof(j,lm,natom,i2spin))
     118             :                     sumb12(i1spin,i2spin) = sumb12(i1spin,i2spin) 
     119             :      +                      + bcof(i,lm,natom,i1spin)*
     120           0 :      +                      conjg(bcof(j,lm,natom,i2spin))
     121             :                     sumc12(i1spin,i2spin) = sumc12(i1spin,i2spin) 
     122             :      +                      + acof(i,lm,natom,i1spin)*
     123           0 :      +                      conjg(bcof(j,lm,natom,i2spin))
     124             :                     sumd12(i1spin,i2spin) = sumd12(i1spin,i2spin) 
     125             :      +                      + bcof(i,lm,natom,i1spin)*
     126           0 :      +                      conjg(acof(j,lm,natom,i2spin))
     127             :                   enddo !natom
     128             :                  enddo !m
     129             :                  mmn(i,j) =    mmn(i,j)
     130             :      &                           +
     131             :      &             suma12(i1spin,i2spin)*radial1_ff(i1spin,i2spin,l,l,n)
     132             :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     133             : 
     134             :      &                           +
     135             :      &             sumb12(i1spin,i2spin)*radial1_gg(i1spin,i2spin,l,l,n)
     136             :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     137             : 
     138             :      &                           +
     139             :      &             sumc12(i1spin,i2spin)*radial1_fg(i1spin,i2spin,l,l,n)
     140             :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     141             : 
     142             :      &                           +
     143             :      &             sumd12(i1spin,i2spin)*radial1_gf(i1spin,i2spin,l,l,n)
     144           0 :      &                    *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
     145             :                 enddo !i2spin
     146             :                enddo !i1spin 
     147             :              endif   
     148             : 
     149             :             enddo !l
     150           0 :             nt1 = nt1 + neq(n)
     151             :          enddo !n   
     152             :        enddo   ! cycle by j-band
     153             :       enddo  !  cycle by i-band
     154             : 
     155             : c---> initialize qlo arrays
     156           0 :       qlo(:,:,:,:,:) = 0.0
     157           0 :       qaclo(:,:,:,:) = 0.0
     158           0 :       qbclo(:,:,:,:) = 0.0
     159           0 :       qcloa(:,:,:,:) = 0.0
     160           0 :       qclob(:,:,:,:) = 0.0
     161             : 
     162             : c---> prepare the coefficients
     163           0 :       natom = 0
     164           0 :       do ntyp = 1,ntype
     165           0 :          do nn = 1,neq(ntyp)
     166           0 :             natom = natom + 1
     167           0 :             do lo = 1,nlo(ntyp)
     168           0 :                l = llo(lo,ntyp)
     169           0 :                ll1 = l* (l+1)
     170           0 :                do m = -l,l
     171           0 :                   lm = ll1 + m
     172           0 :                   do j = 1,noccbd
     173           0 :                    do i = 1,noccbd
     174             :                      qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) +
     175           0 :      +                  bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) 
     176             : c     +                +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) 
     177             :                      qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) +
     178           0 :      +                  acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) 
     179             : c     +                 +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
     180             : 
     181             :                      qclob(i,j,lo,ntyp) = qclob(i,j,lo,ntyp)
     182             : c     +                bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) 
     183           0 :      +                +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) 
     184             :                      qcloa(i,j,lo,ntyp) = qcloa(i,j,lo,ntyp) 
     185             : c     +                acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))+ 
     186           0 :      +                +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
     187             :                    enddo
     188             :                   enddo
     189             :                enddo
     190           0 :                do lop = 1,nlo(ntyp)
     191           0 :                  if (llo(lop,ntyp).eq.l) then
     192           0 :                    do m = -l,l
     193           0 :                      do i = 1,noccbd
     194           0 :                       do j = 1,noccbd
     195             :                        qlo(i,j,lo,lop,ntyp) = qlo(i,j,lo,lop,ntyp) + 
     196             :      +                        conjg(ccof(m,j,lop,natom,2))
     197           0 :      *                                  *ccof(m,i,lo,natom,1)
     198             :                       enddo
     199             :                      enddo
     200             :                    enddo
     201             :                  endif
     202             :                enddo
     203             :             enddo
     204             :          enddo
     205             :       enddo
     206             : c---> perform summation of the coefficients with the integrals
     207             : c---> of the radial basis functions
     208           0 :       do ntyp = 1,ntype
     209           0 :          do lo = 1,nlo(ntyp)
     210           0 :             l = llo(lo,ntyp)
     211           0 :             do j = 1,noccbd
     212           0 :              do i = 1,noccbd
     213             :                mmn(i,j)= mmn(i,j)  + 
     214             :      +    qaclo(i,j,lo,ntyp)*radial1_flo(1,2,l,lo,ntyp)     
     215             :      +                      +
     216             :      +    qbclo(i,j,lo,ntyp)*radial1_glo(1,2,l,lo,ntyp)
     217             :      +                      +
     218             :      +    qcloa(i,j,lo,ntyp)*radial1_lof(1,2,lo,l,ntyp)     
     219             :      +                      +
     220           0 :      +    qclob(i,j,lo,ntyp)*radial1_log(1,2,lo,l,ntyp)  
     221             :              enddo
     222             :             enddo 
     223           0 :             do lop = 1,nlo(ntyp)
     224           0 :                if (llo(lop,ntyp).eq.l) then
     225           0 :                do j = 1,noccbd
     226           0 :                 do i = 1,noccbd
     227             :                  mmn(i,j) = mmn(i,j)  + 
     228           0 :      +   qlo(i,j,lop,lo,ntyp)*radial1_lolo(1,2,lop,lo,ntyp)
     229             :                 enddo
     230             :                enddo
     231             :                endif
     232             :             enddo
     233             :          enddo 
     234             :       enddo 
     235           0 :       deallocate ( qlo,qaclo,qbclo,qcloa,qclob )
     236             : 
     237           0 :       END SUBROUTINE wann_mmk0_updown_sph
     238             :       END MODULE m_wann_mmk0_updown_sph
     239             : 

Generated by: LCOV version 1.13