LCOV - code coverage report
Current view: top level - wannier - wann_tlmw.f (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 56.7 % 104 59
Test Date: 2025-06-14 04:34:23 Functions: 100.0 % 1 1

            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 2.0-1