LCOV - code coverage report
Current view: top level - wannier - wann_kptsrotate.F (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 0.0 % 63 0
Test Date: 2025-06-14 04:34:23 Functions: 0.0 % 1 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_kptsrotate
       8              :       use m_judft
       9              : c****************************************
      10              : c     Rotate the wave function.
      11              : c     Frank Freimuth
      12              : c****************************************
      13              :       contains
      14            0 :       subroutine wann_kptsrotate(
      15              :      >               atoms,
      16              :      >               invsat,
      17              :      >               l_noco,l_soc,
      18              :      >               jspin_in,
      19            0 :      >               oper,nop,mrot,nvd,
      20              :      >               shiftkpt,
      21            0 :      >               tau,
      22              :      >               lapw,
      23              : !     x               bkpt,k1,k2,k3,
      24              :      x               zMat,nsfactor)
      25              : 
      26              :       USE m_types
      27              :       use m_constants
      28              :       use m_inv3
      29              : 
      30              :       implicit none
      31              :       TYPE(t_atoms),INTENT(IN)             :: atoms
      32              :       INTEGER, INTENT (IN)  :: invsat(:)
      33              :       logical,intent(in)    :: l_noco
      34              :       logical,intent(in)    :: l_soc
      35              :       integer,intent(in)    :: jspin_in
      36              :       integer,intent(in)    :: oper
      37              :       integer,intent(in)    :: nop
      38              :       integer,intent(in)    :: mrot(3,3,nop)
      39              :       integer,intent(in)    :: nvd
      40              :       integer,intent(in)    :: shiftkpt(3)
      41              :       real,intent(in)       :: tau(3,nop)
      42              : !      real,intent(inout)    :: bkpt(3)
      43              : !      integer,intent(inout) :: k1(:,:),k2(:,:),k3(:,:) !nvd,jspd
      44              :       TYPE(t_lapw),intent(inout)  :: lapw
      45              : 
      46              :       
      47              :       TYPE(t_mat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex
      48              : 
      49              :       complex,intent(out)   :: nsfactor !phase of non-symmorphic ops
      50              : 
      51              :       real    :: bkrot(3),tpi,arg
      52              :       integer :: rotmat(3,3),determ,iatom,itype
      53              :       integer :: j1,j2,j3,k,j,at_ind,invoper,nkvec
      54              :       real    :: shiftnonsymm(3)
      55              :       real    :: phase
      56              :       integer :: natom,ntyp,lm,m,l,lo,nn,jspin
      57              :       integer :: absoper,jj,jsp_start,jsp_end
      58              :       integer :: testmat(3,3),nbasf
      59              : 
      60            0 :       call timestart("wann_kptsrotate")
      61            0 :       tpi=2.0*pimach()
      62              : 
      63            0 :       absoper=abs(oper)
      64              : 
      65            0 :       call inv3(mrot(:,:,absoper),rotmat,determ)
      66            0 :       shiftnonsymm(:)=matmul(rotmat,tau(:,absoper))
      67              : 
      68              : c      testmat=matmul(mrot(:,:,absoper),rotmat)
      69              : c      print*,testmat
      70              : c      testmat=matmul(rotmat,mrot(:,:,absoper))
      71              : c      print*,testmat
      72              : 
      73            0 :       IF(.NOT.zMat%l_real) THEN
      74            0 :          if(oper.lt.0)then
      75            0 :             zMat%data_c = CONJG(zMat%data_c)
      76            0 :             shiftnonsymm=-1.0*shiftnonsymm
      77              :          endif
      78              :       END IF
      79              : 
      80            0 :       if(l_noco) then
      81              :          jsp_start=1
      82              :          jsp_end=2
      83              :       else
      84            0 :          jsp_start=jspin_in
      85            0 :          jsp_end=jspin_in
      86              :       endif
      87              : 
      88              : 
      89              : 
      90            0 :       do jspin=jsp_start,jsp_end
      91            0 :           if(.not.(l_noco.and.(jspin.eq.2)))then
      92            0 :             bkrot(:)=0.0
      93            0 :             do k=1,3
      94            0 :               bkrot(:)=bkrot(:)+mrot(k,:,absoper)*lapw%bkpt(k)
      95              :             enddo
      96            0 :             lapw%bkpt(:)=bkrot(:)
      97              :           endif
      98            0 :           do j=1,lapw%nv(jspin)  !rotate reciprocal vector
      99              :                j1=mrot(1,1,absoper)*lapw%k1(j,jspin)+
     100              :      +            mrot(2,1,absoper)*lapw%k2(j,jspin)+
     101            0 :      +            mrot(3,1,absoper)*lapw%k3(j,jspin)
     102              :                j2=mrot(1,2,absoper)*lapw%k1(j,jspin)+
     103              :      +            mrot(2,2,absoper)*lapw%k2(j,jspin)+
     104            0 :      +            mrot(3,2,absoper)*lapw%k3(j,jspin)
     105              :                j3=mrot(1,3,absoper)*lapw%k1(j,jspin)+
     106              :      +            mrot(2,3,absoper)*lapw%k2(j,jspin)+
     107            0 :      +            mrot(3,3,absoper)*lapw%k3(j,jspin)
     108            0 :                lapw%k1(j,jspin)=j1
     109            0 :                lapw%k2(j,jspin)=j2
     110            0 :                lapw%k3(j,jspin)=j3
     111              :           enddo 
     112              :       enddo !jspin  
     113              : 
     114            0 :       if(oper.lt.0)then !time-inversion symmetry
     115            0 :          lapw%k1   = -lapw%k1
     116            0 :          lapw%k2   = -lapw%k2
     117            0 :          lapw%k3   = -lapw%k3
     118            0 :          lapw%bkpt = -lapw%bkpt
     119              :       endif
     120              : 
     121            0 :       do jspin=jsp_start,jsp_end
     122            0 :         jj=0 
     123            0 :         if(l_noco.and.(jspin.eq.2))then
     124            0 :            jj=lapw%nv(1)+atoms%nlotot
     125              :         endif
     126            0 :         do j=1,lapw%nv(jspin)
     127              :          phase = lapw%k1(j,jspin) * shiftnonsymm(1)
     128              :      +         + lapw%k2(j,jspin) * shiftnonsymm(2)
     129            0 :      +         + lapw%k3(j,jspin) * shiftnonsymm(3)
     130            0 :          phase = tpi*phase
     131            0 :          phase = cos(phase)
     132            0 :          IF(zMat%l_real) THEN
     133            0 :             zMat%data_r(j+jj,:)  = phase * zMat%data_r(j+jj,:) 
     134              :          ELSE
     135            0 :             zMat%data_c(j+jj,:)  = phase * zMat%data_c(j+jj,:) 
     136              :          END IF
     137              :         enddo    
     138            0 :         jj=jj+lapw%nv(jspin)
     139              : c$$$        do ilo=1,nlotot
     140              : c$$$           call judft_error("BUG in wann_kptsrotate:LOs missing")
     141              : c$$$         !j=kveclo(ilo)
     142              : c$$$         phase = lapw%k1(j,jspin) * shiftnonsymm(1)
     143              : c$$$     +         + lapw%k2(j,jspin) * shiftnonsymm(2)
     144              : c$$$     +         + lapw%k3(j,jspin) * shiftnonsymm(3)
     145              : c$$$         phase = tpi*phase
     146              : c$$$         phase = cos(phase)
     147              : c$$$         IF(zMat%l_real) THEN
     148              : c$$$            zMat%data_r(jj+ilo,:)  = phase * zMat%data_r(jj+ilo,:) 
     149              : c$$$         ELSE
     150              : c$$$            zMat%data_c(jj+ilo,:)  = phase * zMat%data_c(jj+ilo,:) 
     151              : c$$$         END IF
     152              : c$$$  enddo
     153            0 :         do iatom=1,atoms%nat
     154            0 :           iType = atoms%itype(iAtom)
     155            0 :           do lo=1,atoms%nlo(itype)
     156            0 :              DO nkvec = 1, lapw%nkvec(lo,iAtom)
     157              : !                   iLAPW = lapw%kvec(nkvec,lo,iAtom)
     158            0 :                    nbasf=lapw%nv(jspin)+lapw%index_lo(lo,iatom)+nkvec
     159            0 :                    IF(zMat%l_real) THEN
     160            0 :             zMat%data_r(nbasf,:)  = phase * zMat%data_r(nbasf,:) 
     161              :                    ELSE
     162            0 :             zMat%data_c(nbasf,:)  = phase * zMat%data_c(nbasf,:) 
     163              :                    END IF                   
     164              :              END DO
     165              :           enddo !lo   
     166              :         enddo !iatom
     167              :         
     168              :       enddo  
     169              : 
     170              : 
     171            0 :       lapw%bkpt(:)   = lapw%bkpt(:)   - shiftkpt(:)
     172            0 :       lapw%k1(:,:)   = lapw%k1(:,:)   + shiftkpt(1)
     173            0 :       lapw%k2(:,:)   = lapw%k2(:,:)   + shiftkpt(2)
     174            0 :       lapw%k3(:,:)   = lapw%k3(:,:)   + shiftkpt(3)
     175              : 
     176            0 :       write(oUnit,*)"in wann_kptsrotate:"
     177            0 :       write(oUnit,*) "bkpt=",lapw%bkpt
     178              : 
     179              :       arg = tpi*(
     180              :      +        lapw%bkpt(1)*shiftnonsymm(1)+
     181              :      +        lapw%bkpt(2)*shiftnonsymm(2)+
     182            0 :      +        lapw%bkpt(3)*shiftnonsymm(3)  )
     183              :       
     184            0 :       nsfactor = cmplx(cos(arg),sin(arg))
     185            0 :       call timestop("wann_kptsrotate")
     186              : 
     187            0 :       end subroutine wann_kptsrotate
     188              :       end module m_wann_kptsrotate
        

Generated by: LCOV version 2.0-1