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

Generated by: LCOV version 2.0-1