LCOV - code coverage report
Current view: top level - wannier - wann_fft4.f (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 0.0 % 105 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_fft4
       8              :       contains 
       9            0 :       subroutine wann_fft4(
      10              :      >          inputfilename,outputfilename,l_conjugate,
      11            0 :      >          rvecnum,rvec,kpoints,
      12              :      >          jspins_in,nkpts,l_bzsym,film,
      13              :      >          l_soc,band_min,band_max,neigd,
      14              :      >          l_socmmn0,wan90version)
      15              : 
      16              : c*************************************************
      17              : c     Transform 4-dimensional matrices from 
      18              : c     Bloch representation to Wannier representation.
      19              : c     
      20              : c     Frank Freimuth, February 2011
      21              : c*************************************************
      22              : 
      23              :       use m_constants
      24              :       use m_wann_read_umatrix
      25              : 
      26              :       implicit none
      27              :       character,intent(in):: inputfilename*(*)
      28              :       character,intent(in):: outputfilename*(*) 
      29              :       logical,intent(in)  :: l_conjugate        
      30              :       integer, intent(in) :: rvecnum
      31              :       integer, intent(in) :: rvec(:,:)
      32              :       real,    intent(in) :: kpoints(:,:)
      33              :       integer, intent(in) :: jspins_in
      34              :       integer, intent(in) :: nkpts
      35              :       logical,intent (in) :: l_bzsym,l_soc
      36              :       logical,intent(in)  :: film
      37              :       integer,intent(in)  :: band_min(2),band_max(2),neigd
      38              :       logical, intent(in) :: l_socmmn0
      39              :       integer, intent(in) :: wan90version
      40              : 
      41              :       integer             :: ikpt,jspins
      42              :       integer             :: kpts
      43              :       logical             :: l_file
      44              : c      real                :: kpoints(3,nkpts)
      45              :       integer             :: num_wann,num_kpts,num_nnmax,jspin
      46              :       integer             :: kspin,kkspin
      47              :       integer             :: wann_shift,num_wann2
      48              :       integer             :: i,j,k,m,info,r1,r2,r3,dummy1
      49              :       integer             :: dummy2,dummy3,dummy4,dummy5,dummy6
      50              :       integer             :: hopmin,hopmax,counter,m1,m2
      51              :       integer             :: num_bands2
      52              :       integer,allocatable :: iwork(:)
      53              :       real,allocatable    :: energy(:,:),ei(:)
      54              :       real,allocatable    :: eigw(:,:),rwork(:)
      55              :       complex,allocatable :: work(:),vec(:,:)
      56            0 :       complex,allocatable :: u_matrix(:,:,:,:)
      57            0 :       complex,allocatable :: hwann(:,:,:,:)
      58            0 :       complex,allocatable :: hreal(:,:,:,:)
      59            0 :       complex,allocatable :: hsomtx(:,:,:,:)
      60            0 :       complex,allocatable :: hsomtx2(:,:,:,:)
      61              :       complex             :: fac,eulav,eulav1
      62              :       real                :: tmp_omi,rdotk,tpi,minenerg,maxenerg
      63              :       real, allocatable   :: minieni(:),maxieni(:)
      64              :       character           :: jobz,uplo
      65              :       integer             :: kpt,band,lee,lwork,lrwork,liwork,n,lda
      66              :       complex             :: value(4)
      67              :       logical             :: um_format
      68              :       logical             :: repro_eig
      69              :       logical             :: l_chk,l_proj
      70              :       logical             :: have_disentangled
      71            0 :       integer,allocatable :: ndimwin(:,:)
      72            0 :       logical,allocatable :: lwindow(:,:,:)
      73              :       integer             :: chk_unit,nkp,ntmp,ierr
      74              :       character(len=33)   :: header
      75              :       character(len=20)   :: checkpoint
      76              :       real                :: tmp_latt(3,3), tmp_kpt_latt(3,nkpts)
      77              :       real                :: omega_invariant
      78            0 :       complex,allocatable :: u_matrix_opt(:,:,:,:)
      79              :       integer             :: num_bands
      80              :       logical             :: l_umdat
      81              :       real,allocatable    :: eigval2(:,:)
      82              :       real,allocatable    :: eigval_opt(:,:)
      83              :       real                :: scale,a,b
      84              :       character(len=2)    :: spinspin12(0:2)
      85              :       character(len=3)    :: spin12(2)
      86              :       character(len=6)    :: filename
      87              :       integer             :: jp,mp,kk,ii,jj,dir,rvecind
      88              :       integer             :: spin1,spin2
      89              : 
      90              :       data spinspin12/'  ','.1' , '.2'/
      91              :       data spin12/'WF1','WF2'/
      92              : 
      93            0 :       call timestart("wann_fft4")
      94            0 :       tpi=2*pimach()
      95              : 
      96            0 :       jspins=jspins_in
      97            0 :       if(l_soc)jspins=1
      98              : 
      99            0 :       write(oUnit,*)"nkpts=",nkpts
     100              : c*****************************************************
     101              : c     get num_bands and num_wann from the proj file
     102              : c*****************************************************
     103            0 :       do j=1,0,-1
     104            0 :           inquire(file=trim('proj'//spinspin12(j)),exist=l_file)
     105            0 :           if(l_file)then
     106            0 :             filename='proj'//spinspin12(j)
     107            0 :             exit
     108              :           endif
     109              :       enddo
     110            0 :       if(l_file)then
     111            0 :           open (203,file=trim(filename),status='old')
     112            0 :           rewind (203)
     113              :       else
     114            0 :           stop 'no proj/proj.1/proj.2' 
     115              :       endif
     116            0 :       read (203,*) num_wann,num_bands
     117            0 :       close (203)
     118            0 :       write(oUnit,*)'According to proj there are ',num_bands,' bands'
     119            0 :       write(oUnit,*)"and ",num_wann," wannier functions."
     120              : 
     121              : c****************************************************************
     122              : c        read in chk
     123              : c****************************************************************
     124            0 :       num_kpts=nkpts
     125            0 :       allocate( u_matrix_opt(num_bands,num_wann,nkpts,2) )
     126            0 :       allocate( u_matrix(num_wann,num_wann,nkpts,2) )
     127            0 :       allocate( lwindow(num_bands,nkpts,2) )
     128            0 :       allocate( ndimwin(nkpts,2) )
     129              : 
     130              : !      do jspin=1,jspins  !spin loop
     131            0 :        jspin=1
     132              :          call wann_read_umatrix2(
     133              :      >       nkpts,num_wann,num_bands,
     134              :      >       um_format,jspins,  !jspin,
     135              :      >       wan90version,
     136              :      <       have_disentangled,
     137              :      <       lwindow(:,:,jspin),
     138              :      <       ndimwin(:,jspin),
     139              :      <       u_matrix_opt(:,:,:,jspin),
     140            0 :      <       u_matrix(:,:,:,jspin))
     141            0 :          num_bands2=num_bands
     142              : !      enddo !jspin   
     143              : !      if(jspins.eq.1)then
     144              : !         lwindow(:,:,2)        = lwindow(:,:,1)
     145              : !         ndimwin(:,2)          = ndimwin(:,1)
     146              : !         u_matrix_opt(:,:,:,2) = u_matrix_opt(:,:,:,1)
     147              : !         u_matrix(:,:,:,2)     = u_matrix(:,:,:,1)
     148              : !      endif
     149              : 
     150              : c****************************************************
     151              : c        Read the file "WF1.socspicom".
     152              : c**************************************************** 
     153            0 :       allocate( hsomtx(num_bands2,num_bands2,3,nkpts) )
     154            0 :       open(304,file=inputfilename,form='formatted')
     155            0 :       read(304,*)
     156            0 :       read(304,*)
     157            0 :       if(l_conjugate)then       
     158            0 :        do nkp=1,num_kpts
     159            0 :         do i=1,num_bands2
     160            0 :          do j=1,num_bands2
     161            0 :           do dir=1,3  
     162            0 :             read(304,*)dummy1,dummy2,dummy3,dummy4,a,b
     163            0 :             hsomtx(j,i,dir,nkp)=cmplx(a,-b)
     164              :           enddo !dir
     165              :          enddo !j
     166              :         enddo !i
     167              :        enddo !nkp
     168              :       else
     169            0 :        do nkp=1,num_kpts
     170            0 :         do i=1,num_bands2
     171            0 :          do j=1,num_bands2
     172            0 :           do dir=1,3
     173            0 :             read(304,*)dummy1,dummy2,dummy3,dummy4,a,b
     174            0 :                     hsomtx(j,i,dir,nkp)=cmplx(a,b)
     175              :           enddo !dir
     176              :          enddo !j
     177              :         enddo !i
     178              :        enddo !nkp
     179              :       endif             
     180            0 :       close(304)
     181              : 
     182              : c****************************************************************
     183              : c        Calculate matrix elements of SOC in the basis of
     184              : c        rotated Bloch functions.
     185              : c****************************************************************
     186            0 :       allocate( hsomtx2(num_wann,num_wann,3,nkpts) )
     187              :       write(oUnit,*)"calculate matrix elements of SOC commutator
     188            0 :      &between wannier orbitals"
     189              : 
     190            0 :       if(have_disentangled) then       
     191            0 :        hsomtx2=0.0  
     192            0 :        do nkp=1,num_kpts
     193            0 :         print*,"nkp=",nkp  
     194            0 :         do dir=1,3  
     195              :            
     196            0 :         do j=1,num_wann
     197            0 :          do jp=1,num_wann  
     198            0 :             do m=1,ndimwin(nkp,1)
     199            0 :              do mp=1,ndimwin(nkp,1)  
     200              :               hsomtx2(jp,j,dir,nkp)=hsomtx2(jp,j,dir,nkp)+ 
     201              :      &            conjg(u_matrix_opt(mp,jp,nkp,1))*
     202              :      &                  hsomtx(mp,m,dir,nkp)*
     203            0 :      &                  u_matrix_opt(m,j,nkp,1)
     204              :              enddo !mp   
     205              :             enddo !m
     206              :          enddo !jp 
     207              :         enddo !j
     208              :         enddo !dir
     209              :        enddo !nkp
     210              :       else
     211            0 :        hsomtx2 = hsomtx
     212              :       end if !have_disentangled
     213              : 
     214            0 :       allocate(hwann(num_wann,num_wann,3,num_kpts))
     215            0 :       hwann=cmplx(0.0,0.0)
     216            0 :       wann_shift=0
     217            0 :       do k=1,num_kpts
     218            0 :          print*,"k=",k
     219            0 :        do dir=1,3  
     220            0 :        do m=1,num_wann
     221            0 :         do mp=1,num_wann
     222            0 :            do i=1,num_wann
     223            0 :             do j=1,num_wann
     224              :              hwann(mp,m,dir,k)=hwann(mp,m,dir,k)+
     225              :      *        conjg(u_matrix(j,mp,k,1))*
     226              :      *                hsomtx2(j,i,dir,k)*
     227            0 :      *              u_matrix(i,m,k,1)
     228              :             enddo !j
     229              :            enddo !i     
     230              :         enddo !mp
     231              :        enddo !m
     232              :        enddo
     233              :       enddo !k
     234              : 
     235              : c************************************************************
     236              : c        Calculate matrix elements in real space.
     237              : c***********************************************************      
     238            0 :       write(oUnit,*)"calculate SOC-mat in rs"
     239            0 :       allocate(hreal(num_wann,num_wann,3,rvecnum))
     240            0 :       hreal=cmplx(0.0,0.0)
     241            0 :       do rvecind=1,rvecnum
     242            0 :        do k=1,nkpts
     243              :         rdotk=tpi*(  kpoints(1,k)*rvec(1,rvecind)+
     244              :      +                 kpoints(2,k)*rvec(2,rvecind)+
     245            0 :      +                 kpoints(3,k)*rvec(3,rvecind)  )
     246            0 :         fac=cmplx(cos(rdotk),-sin(rdotk))
     247            0 :         do dir=1,3
     248            0 :          do m2=1,num_wann
     249            0 :           do m1=1,num_wann
     250              :                hreal(m1,m2,dir,rvecind)=
     251              :      &         hreal(m1,m2,dir,rvecind)+
     252            0 :      &            fac*hwann(m1,m2,dir,k)
     253              :           enddo !m1
     254              :          enddo !m2
     255              :         enddo !dir
     256              :        enddo !k
     257              :       enddo !rvecind
     258            0 :       hreal=hreal/cmplx(real(nkpts),0.0)
     259              : 
     260            0 :       open(321,file=outputfilename,form='formatted')
     261            0 :       do rvecind=1,rvecnum
     262            0 :        r3=rvec(3,rvecind)
     263            0 :        r2=rvec(2,rvecind)
     264            0 :        r1=rvec(1,rvecind)
     265              : 
     266            0 :        do j=1,num_wann
     267            0 :         do i=1,num_wann
     268            0 :          do dir=1,3
     269              :             write(321,'(i3,1x,i3,1x,i3,1x,i3,
     270              :      &            1x,i3,1x,i3,1x,f20.8,1x,f20.8)')
     271            0 :      &          r1,r2,r3,i,j,dir,
     272            0 :      &          hreal(i,j,dir,rvecind) 
     273              :          enddo !dir
     274              :         enddo!i
     275              :        enddo !j
     276              : 
     277              :       enddo !rvecnum 
     278            0 :       close(321)
     279              : 
     280            0 :       deallocate(lwindow,u_matrix_opt,ndimwin)
     281            0 :       deallocate(u_matrix,hwann,hreal)
     282              : 
     283            0 :       call timestop("wann_fft4")
     284            0 :       end subroutine wann_fft4
     285              :       end module m_wann_fft4
        

Generated by: LCOV version 2.0-1