LCOV - code coverage report
Current view: top level - wannier - wann_tlmw.f (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 59 104 56.7 %
Date: 2024-04-26 04:44:34 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_wann_tlmw
       8             :       use m_juDFT
       9             :       contains
      10           8 :       subroutine wann_tlmw(
      11           8 :      >               nwfs,lwf,mrwf,
      12           8 :      >               l_nocosoc,spi,jspin,
      13           8 :      <               tlmwf)
      14             : c*********************************************************************
      15             : c     Express the angular part of the trial orbital
      16             : c     in terms of spherical harmonics.
      17             : c     Y. Mokrousov
      18             : c*********************************************************************
      19             : c     Modifications for soc and noco.
      20             : c     Tidied-up version. 
      21             : c     Frank Freimuth
      22             : c*********************************************************************
      23             : 
      24             :       implicit none
      25             : 
      26             :       integer, intent (in)  :: nwfs
      27             :       integer, intent (in)  :: lwf(nwfs),mrwf(nwfs)
      28             :       logical, intent (in)  :: l_nocosoc
      29             :       integer, intent (in)  :: spi(nwfs),jspin
      30             :       complex, intent (out) :: tlmwf(0:3,-3:3,nwfs)
      31             : 
      32             :       integer   :: nwf,l,lr,mr,m,i,ii,j,jj
      33             :       complex   :: tlm(0:3,-3:3,1:7)
      34             :       complex   :: ic
      35             :       intrinsic :: cmplx,sqrt,cos,sin
      36             : 
      37           8 :       call timestart("wann_tlmw")
      38           8 :       ic = cmplx(0.,1.)
      39             : 
      40             : c..in this part the 'primary' matrices for the basic non-hybridized
      41             : c..states are constructed, the coefficients are written to the tlm 
      42             : c..these coefficients arise due to the fact that the tws comprise the
      43             : c..real harmonics, while the wave functions operate in terms of normal 
      44             : c..ones
      45             : 
      46           8 :       tlm(:,:,:) = cmplx(0.,0.)
      47             : 
      48          40 :       do l = 0,3
      49             : 
      50          40 :          if (l.eq.0) then
      51             : c..s-state
      52           8 :            tlm(0,0,1) = cmplx(1.,0.)
      53             : 
      54          24 :          elseif (l.eq.1) then
      55             : c..pz-state
      56           8 :            tlm(1,0,1) = cmplx(1.,0.)
      57             : c..px-state
      58           8 :            tlm(1,-1,2) =  cmplx(1.,0.)/(sqrt(2.))
      59           8 :            tlm(1,1,2)  = -cmplx(1.,0.)/(sqrt(2.))
      60             : c..py-state
      61           8 :            tlm(1,-1,3) = ic/(sqrt(2.))              
      62           8 :            tlm(1,1,3)  = ic/(sqrt(2.))
      63             : 
      64          16 :          elseif (l.eq.2) then
      65             : c..dz2-state
      66           8 :            tlm(2,0,1) = cmplx(1.,0.)
      67             : c..dxz-state
      68           8 :            tlm(2,1,2)  = -cmplx(1.,0.)/(sqrt(2.))
      69           8 :            tlm(2,-1,2) = cmplx(1.,0.)/(sqrt(2.))
      70             : c..dyz-state
      71           8 :            tlm(2,1,3)  = ic/(sqrt(2.))
      72           8 :            tlm(2,-1,3) = ic/(sqrt(2.))
      73             : c..dx2-y2-state
      74           8 :            tlm(2,2,4)  =  cmplx(1.,0.)/(sqrt(2.))
      75           8 :            tlm(2,-2,4) =  cmplx(1.,0.)/(sqrt(2.))
      76             : c..dxy-state
      77           8 :            tlm(2,2,5)  = -ic/(sqrt(2.))
      78           8 :            tlm(2,-2,5) =  ic/(sqrt(2.))
      79             : 
      80             :          elseif (l.eq.3)then
      81             : c..
      82           8 :            tlm(3,0,1) = cmplx(1.,0.)
      83             : c..
      84           8 :            tlm(3,1,2)  = -cmplx(1.,0.)/(sqrt(2.))
      85           8 :            tlm(3,-1,2) = cmplx(1.,0.)/(sqrt(2.))
      86             : c..
      87           8 :            tlm(3,1,3)  = ic/(sqrt(2.))
      88           8 :            tlm(3,-1,3) = ic/(sqrt(2.))
      89             : c..
      90           8 :            tlm(3,2,4)  =  cmplx(1.,0.)/(sqrt(2.))
      91           8 :            tlm(3,-2,4) =  cmplx(1.,0.)/(sqrt(2.))
      92             : c..
      93           8 :            tlm(3,2,5)  = -ic/(sqrt(2.))
      94           8 :            tlm(3,-2,5) =  ic/(sqrt(2.))
      95             : c..
      96           8 :            tlm(3,3,6)  = -cmplx(1.,0.)/(sqrt(2.))
      97           8 :            tlm(3,-3,6) =  cmplx(1.,0.)/(sqrt(2.))
      98             : c..
      99           8 :            tlm(3,3,7)  =  ic/(sqrt(2.))
     100           8 :            tlm(3,-3,7) =  ic/(sqrt(2.))
     101             :          else
     102             :             CALL juDFT_error("no tlm for this l",calledby ="wann_tlmw")
     103             :          endif
     104             : 
     105             :       enddo
     106             : 
     107             : c..now we are ready for more complex hybridized states, which
     108             : c..correspond to the negative values of lwf
     109             : 
     110        2312 :       tlmwf(:,:,:) = cmplx(0.,0.)
     111             : 
     112          72 :       do nwf = 1,nwfs
     113             :          
     114          64 :          if( ((3-2*jspin).ne.spi(nwf)).and.l_nocosoc ) cycle
     115             : 
     116          64 :          lr = lwf(nwf)
     117          64 :          mr = mrwf(nwf)
     118             : 
     119          72 :          if (lr.ge.0) then
     120           0 :                tlmwf(lr,:,nwf) = tlm(lr,:,mr)  
     121             :          elseif (lr.eq.-1) then
     122             : 
     123           0 :             if (mr.eq.1) then
     124             : c..sp-1
     125           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(2.)))*tlm(0,:,1)
     126           0 :               tlmwf(1,:,nwf) =  (1./(sqrt(2.)))*tlm(1,:,2)
     127           0 :             elseif (mr.eq.2) then
     128             : c..sp-2
     129           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(2.)))*tlm(0,:,1)
     130           0 :               tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,2)
     131             :             endif 
     132             : 
     133             :          elseif (lr.eq.-2) then
     134             :               
     135           0 :             if (mr.eq.1) then
     136             : c..sp2-1
     137           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(3.)))*tlm(0,:,1)
     138             :               tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2) +
     139           0 :      +                          (1./(sqrt(2.)))*tlm(1,:,3)
     140           0 :             elseif (mr.eq.2) then
     141             : c..sp2-2
     142           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(3.)))*tlm(0,:,1)
     143             :               tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2)
     144           0 :      +                         -(1./(sqrt(2.)))*tlm(1,:,3)
     145           0 :             elseif (mr.eq.3) then
     146             : c..sp2-3
     147           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(3.)))*tlm(0,:,1)
     148           0 :               tlmwf(1,:,nwf) =  (2./(sqrt(6.)))*tlm(1,:,2)
     149             :             endif
     150             : 
     151             :          elseif (lr.eq.-3) then
     152             : 
     153          64 :             if (mr.eq.1) then
     154             : c..sp3-1
     155         128 :               tlmwf(0,:,nwf) = 0.5*tlm(0,:,1) 
     156         128 :               tlmwf(1,:,nwf) = 0.5*( tlm(1,:,2)+tlm(1,:,3)+tlm(1,:,1) ) 
     157          48 :             elseif (mr.eq.2) then
     158             : c..sp3-2
     159         128 :               tlmwf(0,:,nwf) = 0.5*tlm(0,:,1) 
     160         128 :               tlmwf(1,:,nwf) = 0.5*( tlm(1,:,2)-tlm(1,:,3)-tlm(1,:,1) ) 
     161          32 :             elseif (mr.eq.3) then
     162             : c..sp3-4
     163         128 :               tlmwf(0,:,nwf) = 0.5*tlm(0,:,1) 
     164         128 :               tlmwf(1,:,nwf) = 0.5*(-tlm(1,:,2)+tlm(1,:,3)-tlm(1,:,1) ) 
     165          16 :             elseif (mr.eq.4) then
     166             : c..sp3-4
     167         128 :               tlmwf(0,:,nwf) = 0.5*tlm(0,:,1) 
     168         128 :               tlmwf(1,:,nwf) = 0.5*(-tlm(1,:,2)-tlm(1,:,3)+tlm(1,:,1) ) 
     169             :             endif  
     170             : 
     171             :          elseif (lr.eq.-4) then
     172             : 
     173             :             if (mr.eq.1) then
     174             : c..sp3d-1
     175           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(3.)))*tlm(0,:,1)
     176             :               tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2) 
     177           0 :      &                         +(1./(sqrt(2.)))*tlm(1,:,3)
     178             :             elseif (mr.eq.2) then
     179             : c..sp3d-2
     180           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(3.)))*tlm(0,:,1)
     181             :               tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2)
     182           0 :      &                         -(1./(sqrt(2.)))*tlm(1,:,3)            
     183             :             elseif (mr.eq.3) then 
     184             : c..sp3d-3
     185           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(3.)))*tlm(0,:,1)
     186           0 :               tlmwf(1,:,nwf) =  (2./(sqrt(6.)))*tlm(1,:,2)
     187             :             elseif (mr.eq.4) then
     188             : c..sp3d-4
     189           0 :               tlmwf(1,:,nwf) =  (1./(sqrt(2.)))*tlm(1,:,1)
     190           0 :               tlmwf(2,:,nwf) =  (1./(sqrt(2.)))*tlm(2,:,1)
     191             :             elseif (mr.eq.5) then
     192             : c..sp3d-5
     193           0 :               tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,1)
     194           0 :               tlmwf(2,:,nwf) =  (1./(sqrt(2.)))*tlm(2,:,1)
     195             :             endif 
     196             : 
     197             :          elseif (lr.eq.-5) then
     198             : 
     199             :             if (mr.eq.1) then
     200             : c..sp3d2-1
     201           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(6.)))*tlm(0,:,1)
     202           0 :               tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,2)
     203             :               tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
     204           0 :      &                         +0.5*tlm(2,:,4) 
     205             :             elseif (mr.eq.2) then
     206             : c..sp3d2-2
     207           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(6.)))*tlm(0,:,1)
     208           0 :               tlmwf(1,:,nwf) =  (1./(sqrt(2.)))*tlm(1,:,2)
     209             :               tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
     210           0 :      &                         +0.5*tlm(2,:,4) 
     211             :             elseif (mr.eq.3) then
     212             : c..sp3d2-3
     213           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(6.)))*tlm(0,:,1)
     214           0 :               tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,3)
     215             :               tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
     216           0 :      &                         -0.5*tlm(2,:,4) 
     217             :             elseif (mr.eq.4) then
     218             : c..sp3d2-4
     219           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(6.)))*tlm(0,:,1)
     220           0 :               tlmwf(1,:,nwf) =  (1./(sqrt(2.)))*tlm(1,:,3)
     221             :               tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
     222           0 :      &                         -0.5*tlm(2,:,4) 
     223             :             elseif (mr.eq.5) then
     224             : c..sp3d2-5
     225           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(6.)))*tlm(0,:,1)
     226           0 :               tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,1)
     227           0 :               tlmwf(2,:,nwf) =  (1./(sqrt(3.)))*tlm(2,:,1)
     228             :             elseif (mr.eq.6) then
     229             : c..sp3d2-5
     230           0 :               tlmwf(0,:,nwf) =  (1./(sqrt(6.)))*tlm(0,:,1)
     231           0 :               tlmwf(1,:,nwf) =  (1./(sqrt(2.)))*tlm(1,:,1)
     232           0 :               tlmwf(2,:,nwf) =  (1./(sqrt(3.)))*tlm(2,:,1)
     233             :             endif
     234             : 
     235             :          else
     236           0 :             CALL juDFT_error("no tlmw for this lr",calledby="wann_tlmw")
     237             :          endif
     238             : 
     239             :       enddo
     240             : 
     241           8 :       call timestop("wann_tlmw")
     242           8 :       end subroutine wann_tlmw
     243             :       end module m_wann_tlmw

Generated by: LCOV version 1.14