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

Generated by: LCOV version 1.13