LCOV - code coverage report
Current view: top level - wannier - wann_fft5.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 103 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.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, only:pimach
      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 :       tpi=2*pimach()
      99             : 
     100           0 :       write(6,*)"nkpts=",nkpts
     101             : c*****************************************************
     102             : c     get num_bands and num_wann from the proj file
     103             : c*****************************************************
     104           0 :       do j=jspin,0,-1
     105           0 :           inquire(file=trim('proj'//spinspin12(j)),exist=l_file)
     106           0 :           if(l_file)then
     107           0 :             filename2='proj'//spinspin12(j)
     108           0 :             exit
     109             :           endif
     110             :       enddo
     111           0 :       if(l_file)then
     112           0 :           open (203,file=trim(filename2),status='old')
     113           0 :           rewind (203)
     114             :       else
     115           0 :           stop 'no proj/proj.1/proj.2' 
     116             :       endif
     117           0 :       read (203,*) num_wann,num_bands
     118           0 :       close (203)
     119           0 :       write(6,*)'According to proj there are ',num_bands,' bands'
     120           0 :       write(6,*)"and ",num_wann," wannier functions."
     121             : 
     122             : c****************************************************************
     123             : c        read in chk
     124             : c****************************************************************
     125           0 :       num_kpts=nkpts
     126           0 :       allocate( u_matrix_opt(num_bands,num_wann,nkpts) )
     127           0 :       allocate( u_matrix(num_wann,num_wann,nkpts) )
     128           0 :       allocate( lwindow(num_bands,nkpts) )
     129           0 :       allocate( ndimwin(nkpts) )
     130             : 
     131             :       call wann_read_umatrix2(
     132             :      >       nkpts,num_wann,num_bands,
     133             :      >       um_format,jspin,wan90version,
     134             :      <       have_disentangled,
     135             :      <       lwindow(:,:),
     136             :      <       ndimwin(:),
     137             :      <       u_matrix_opt(:,:,:),
     138           0 :      <       u_matrix(:,:,:))
     139           0 :       num_bands2=num_bands
     140             : 
     141             : c****************************************************
     142             : c        Read the file "filename".
     143             : c**************************************************** 
     144           0 :       allocate( hsomtx(dim1,dim2,num_bands,num_bands,nkpts) )
     145           0 :       open(304,file=filename,form='formatted')
     146           0 :       read(304,*)
     147           0 :       read(304,*)
     148           0 :       if(l_conjugate)then
     149           0 :        do nkp=1,num_kpts
     150           0 :         do i=1,num_bands
     151           0 :          do j=1,num_bands
     152           0 :           do dir2=1,dim2  
     153           0 :            do dir=1,dim1  
     154           0 :             read(304,*)dummy1,dummy2,dummy3,dummy4,dummy5,a,b
     155           0 :             hsomtx(dir,dir2,j,i,nkp)=cmplx(a,-b)
     156             :            enddo !dir
     157             :           enddo !dir2
     158             :          enddo !j
     159             :         enddo !i
     160             :        enddo !nkp
     161             :       else
     162           0 :        do nkp=1,num_kpts
     163           0 :         do i=1,num_bands
     164           0 :          do j=1,num_bands
     165           0 :           do dir2=1,dim2  
     166           0 :            do dir=1,dim1  
     167           0 :             read(304,*)dummy1,dummy2,dummy3,dummy4,dummy5,a,b
     168           0 :             hsomtx(dir,dir2,j,i,nkp)=cmplx(a,b)
     169             :            enddo !dir
     170             :           enddo !dir2
     171             :          enddo !j
     172             :         enddo !i
     173             :        enddo !nkp
     174             :       endif
     175           0 :       close(304)
     176             : 
     177             : c****************************************************************
     178             : c     fft5: transformation to Bloch-like    
     179             : c****************************************************************
     180           0 :       allocate( hsomtx2(dim1,dim2,num_wann,num_wann,nkpts) )
     181           0 :       write(6,*)"fft5: transformation to Bloch-like"
     182             : 
     183           0 :       if(have_disentangled) then       
     184           0 :        hsomtx2=0.0  
     185           0 :        do nkp=1,num_kpts
     186           0 :         do j=1,num_wann
     187           0 :          do jp=1,num_wann  
     188           0 :           do m=1,ndimwin(nkp)
     189           0 :            do mp=1,ndimwin(nkp) 
     190           0 :             do dir2=1,dim2
     191           0 :              do dir=1,dim1
     192             :               hsomtx2(dir,dir2,jp,j,nkp)=hsomtx2(dir,dir2,jp,j,nkp)+ 
     193             :      &            conjg(u_matrix_opt(mp,jp,nkp))*
     194             :      &                  hsomtx(dir,dir2,mp,m,nkp)*
     195           0 :      &                  u_matrix_opt(m,j,nkp)
     196             :              enddo !dir
     197             :             enddo !dir2
     198             :            enddo !mp   
     199             :           enddo !m
     200             :          enddo !jp 
     201             :         enddo !j
     202             :        enddo !nkp
     203             :       else
     204           0 :        hsomtx2 = hsomtx
     205             :       end if !have_disentangled
     206             : 
     207           0 :       allocate(hwann(dim1,dim2,num_wann,num_wann,num_kpts))
     208           0 :       hwann=cmplx(0.0,0.0)
     209           0 :       wann_shift=0
     210           0 :       do k=1,num_kpts
     211           0 :        print*,"k=",k
     212           0 :        do m=1,num_wann
     213           0 :         do mp=1,num_wann
     214           0 :          do i=1,num_wann
     215           0 :           do j=1,num_wann
     216           0 :            do dir2=1,dim2
     217           0 :             do dir=1,dim1
     218             :              hwann(dir,dir2,mp,m,k)=hwann(dir,dir2,mp,m,k)+
     219             :      *        conjg(u_matrix(j,mp,k))*
     220             :      *                hsomtx2(dir,dir2,j,i,k)*
     221           0 :      *              u_matrix(i,m,k)
     222             :             enddo
     223             :            enddo
     224             :           enddo !j
     225             :          enddo !i     
     226             :         enddo !mp
     227             :        enddo !m
     228             :       enddo !k
     229             : 
     230             : c************************************************************
     231             : c        Calculate matrix elements in real space.
     232             : c***********************************************************      
     233           0 :       write(6,*)"transform to rs"
     234           0 :       allocate(hreal(dim1,dim2,num_wann,num_wann,rvecnum))
     235           0 :       hreal=cmplx(0.0,0.0)
     236           0 :       do rvecind=1,rvecnum
     237           0 :        do k=1,nkpts
     238             :         rdotk=tpi*(  kpoints(1,k)*rvec(1,rvecind)+
     239             :      +                 kpoints(2,k)*rvec(2,rvecind)+
     240           0 :      +                 kpoints(3,k)*rvec(3,rvecind)  )
     241           0 :         fac=cmplx(cos(rdotk),-sin(rdotk))
     242             : 
     243           0 :         do m2=1,num_wann
     244           0 :          do m1=1,num_wann
     245           0 :           do dir2=1,dim2
     246           0 :            do dir=1,dim1
     247             : 
     248             :                hreal(dir,dir2,m1,m2,rvecind)=
     249             :      &         hreal(dir,dir2,m1,m2,rvecind)+
     250           0 :      &            fac*hwann(dir,dir2,m1,m2,k)
     251             :            enddo !dir
     252             :           enddo !dir2
     253             :          enddo !m1
     254             :         enddo !m2
     255             : 
     256             :        enddo !k
     257             :       enddo !rvecind
     258           0 :       hreal=hreal/cmplx(real(nkpts),0.0)
     259             : 
     260           0 :       open(321,file=title,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 dir2=1,dim2
     269           0 :            do dir=1,dim1
     270             :             write(321,'(i3,1x,i3,1x,i3,1x,i3,1x,i3,
     271             :      &            1x,i3,1x,i3,1x,f20.8,1x,f20.8)')
     272           0 :      &          r1,r2,r3,i,j,dir,dir2,
     273           0 :      &          hreal(dir,dir2,i,j,rvecind) 
     274             :            enddo !dir
     275             :           enddo !dir2
     276             :          enddo!i
     277             :         enddo !j
     278             : 
     279             :       enddo !rvecnum 
     280           0 :       close(321)
     281             : 
     282             : c      deallocate(lwindow,u_matrix_opt,ndimwin)
     283             : c      deallocate(u_matrix,hwann,hreal)
     284             : 
     285           0 :       end subroutine wann_fft5
     286             :       end module m_wann_fft5

Generated by: LCOV version 1.13