writew90mmn.f90

Go to the documentation of this file.

! Copyright (C) 2015 Manh Duc Le, 2017-18 Arsenii Gerasimov, Yaroslav Kvashnin
! and Lars Nordstrom. This file is distributed under the terms of the GNU
! General Public License. See the file COPYING for license details.

subroutine writew90mmn
use modmain
use modw90
use modomp
implicit none
! local variables
integer ik,jk,ist,jst,i,nthd
integer ngp(nspnfv),ngpq(nspnfv)
real(8) vl(3),vc(3),q,vkql(3)
character(256) fname
! automatic arrays
integer igpig(ngkmax,nspnfv),igpqig(ngkmax,nspnfv)
real(8) jlqr(njcmax,nspecies)
complex(8) ylmq(lmmaxo),sfacq(natmtot)
! allocatable arrays
complex(8), allocatable :: wfmt(:,:,:,:),wfir(:,:,:)
complex(8), allocatable :: wfmtq(:,:,:,:),wfgpq(:,:,:)
complex(8), allocatable :: expqmt(:,:),oq(:,:,:,:)
allocate(oq(num_bands,num_bands,nntot,nkptnr))
! begin parallel loop over k-points
call holdthd(nkptnr,nthd)
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(igpig,igpqig,jlqr,ylmq,sfacq) &
!$OMP PRIVATE(wfmt,wfir,wfmtq,wfgpq,expqmt) &
!$OMP PRIVATE(ngp,ngpq,i,jk,vl,vc,q,vkql) &
!$OMP NUM_THREADS(nthd)
allocate(wfmt(npcmtmax,natmtot,nspinor,num_bands))
allocate(wfir(ngtc,nspinor,num_bands))
allocate(wfmtq(npcmtmax,natmtot,nspinor,num_bands))
allocate(wfgpq(ngkmax,nspinor,num_bands))
allocate(expqmt(npcmtmax,natmtot))
!$OMP DO SCHEDULE(DYNAMIC)
do ik=1,nkptnr
! generate the wavefunctions at k
  call genwfsvp(.false.,.false.,num_bands,idxw90,ngdgc,igfc,vkl(:,ik),ngp, &
   igpig,wfmt,ngtc,wfir)
  do i=1,nntot
    jk=nnlist(ik,i)
! q-vector in lattice coordinates
    vl(1:3)=dble(nncell(1:3,ik,i))+vkl(1:3,jk)-vkl(1:3,ik)
! q-vector in Cartesian coordinates
    call r3mv(bvec,vl,vc)
! q-vector length
    q=sqrt(vc(1)**2+vc(2)**2+vc(3)**2)
! generate phase factor function exp(iq⋅r) in the muffin-tins
    call genjlgpr(1,q,jlqr)
    call genylmv(.true.,lmaxo,vc,ylmq)
    call gensfacgp(1,vc,1,sfacq)
    call genexpmt(1,jlqr,ylmq,1,sfacq,expqmt)
! k+q-vector in lattice coordinates
    vkql(1:3)=vkl(1:3,ik)+vl(1:3)
! generate the wavefunctions at k+q
    call genwfsvp(.false.,.true.,num_bands,idxw90,ngdgc,igfc,vkql,ngpq,igpqig, &
     wfmtq,ngkmax,wfgpq)
! determine the overlap matrix
    call genolpq(num_bands,expqmt,ngpq,igpqig,wfmt,wfir,wfmtq,wfgpq, &
     oq(:,:,i,ik))
  end do
end do
!$OMP END DO
deallocate(wfmt,wfir,wfmtq,wfgpq,expqmt)
!$OMP END PARALLEL
call freethd(nthd)
! write overlap matrix to file
fname=trim(seedname)//'.mmn'
open(50,file=trim(fname),action='WRITE',form='FORMATTED')
write(50,'("Generated by Elk version ",I0,".",I0,".",I0)') version
write(50,'(3I8)') num_bands,nkptnr,nntot
do ik=1,nkptnr
  do i=1,nntot
    jk=nnlist(ik,i)
    write(50,'(5I8)') ik,jk,nncell(1:3,ik,i)
    do jst=1,num_bands
      do ist=1,num_bands
! lower half of matrix required
        write(50,'(2G18.10)') conjg(oq(jst,ist,i,ik))
      end do
    end do
  end do
end do
close(50)
write(*,*)
write(*,'("Info(writew90mmn): created file ",A)') trim(fname)
deallocate(oq)
end subroutine