Commit 59e03acc authored by Daniel Wortmann's avatar Daniel Wortmann

Further refactoring of Wannier code. Should compile and run simple example~

parent 13992254
...@@ -4,9 +4,7 @@ wannier/eulerrot.f ...@@ -4,9 +4,7 @@ wannier/eulerrot.f
#wannier/w90kpunktgen.f #wannier/w90kpunktgen.f
wannier/wann_1dvacabcof.F wannier/wann_1dvacabcof.F
wannier/wann_2dvacabcof.F wannier/wann_2dvacabcof.F
wannier/wann_abinv.f
wannier/wann_amn.f wannier/wann_amn.f
wannier/wann_anglmom.f
wannier/wann_dipole2.f wannier/wann_dipole2.f
wannier/wann_dipole3.f wannier/wann_dipole3.f
wannier/wann_dipole_electronic.f wannier/wann_dipole_electronic.f
...@@ -27,7 +25,6 @@ wannier/wann_gwf_commat.f ...@@ -27,7 +25,6 @@ wannier/wann_gwf_commat.f
wannier/wann_gwf_tools.f wannier/wann_gwf_tools.f
wannier/wann_gwf_write_mmnk.F wannier/wann_gwf_write_mmnk.F
wannier/wann_hopping.F wannier/wann_hopping.F
wannier/wannier.F
wannier/wannier_to_lapw.F wannier/wannier_to_lapw.F
wannier/wann_ioncharge_gen.f wannier/wann_ioncharge_gen.f
wannier/wann_kpointgen.f wannier/wann_kpointgen.f
...@@ -52,7 +49,6 @@ wannier/wann_mmnk_symm.f ...@@ -52,7 +49,6 @@ wannier/wann_mmnk_symm.f
wannier/wann_nabla_pauli_rs.f wannier/wann_nabla_pauli_rs.f
wannier/wann_nabla_rs.f wannier/wann_nabla_rs.f
wannier/wann_nocoplot.F wannier/wann_nocoplot.F
wannier/wann_orbcomp.f
#wannier/wann_orbmag.F #wannier/wann_orbmag.F
wannier/wann_pauli_rs.F wannier/wann_pauli_rs.F
wannier/wann_perpmag_rs.f wannier/wann_perpmag_rs.f
...@@ -62,7 +58,6 @@ wannier/wann_plot_symm.f ...@@ -62,7 +58,6 @@ wannier/wann_plot_symm.f
wannier/wann_plot_um_dat.F wannier/wann_plot_um_dat.F
wannier/wann_plot_vac.F wannier/wann_plot_vac.F
#wannier/wann_plotw90.F #wannier/wann_plotw90.F
wannier/wann_postproc.F
wannier/wann_postproc_setup4.F wannier/wann_postproc_setup4.F
wannier/wann_postproc_setup5.F wannier/wann_postproc_setup5.F
wannier/wann_postproc_setup.F wannier/wann_postproc_setup.F
...@@ -99,6 +94,11 @@ set(fleur_F90 ${fleur_F90} ...@@ -99,6 +94,11 @@ set(fleur_F90 ${fleur_F90}
wannier/init_wannier_defaults.f90 wannier/init_wannier_defaults.f90
wannier/wann_read_inp.f90 wannier/wann_read_inp.f90
wannier/wann_optional.f90 wannier/wann_optional.f90
wannier/wann_abinv.f90
wannier/wann_anglmom.f90
wannier/wannier.F90
wannier/wann_orbcomp.f90
wannier/wann_postproc.F90
) )
if(FLEUR_USE_WANN) if(FLEUR_USE_WANN)
set(fleur_F90 ${fleur_F90} set(fleur_F90 ${fleur_F90}
......
...@@ -1100,9 +1100,7 @@ c*********************************************************** ...@@ -1100,9 +1100,7 @@ c***********************************************************
DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3) DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3)
call wann_abinv( call wann_abinv(atoms,
> ntypd,natd,noccbd_b,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b,lmax,nlo,llo,invsat,invsatnr,bkpt_b,taual,
X acof_b,bcof_b,ccof_b) X acof_b,bcof_b,ccof_b)
call cpu_time(t1) call cpu_time(t1)
t_abcof = t_abcof + t1 - t0 t_abcof = t_abcof + t1 - t0
...@@ -1222,9 +1220,7 @@ c*********************************************************** ...@@ -1222,9 +1220,7 @@ c***********************************************************
DEALLOCATE(lapw_b2%k1,lapw_b2%k2,lapw_b2%k3) DEALLOCATE(lapw_b2%k1,lapw_b2%k2,lapw_b2%k3)
call wann_abinv( call wann_abinv(atoms,
> ntypd,natd,noccbd_b2,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b2,lmax,nlo,llo,invsat,invsatnr,bkpt_b2,taual,
X acof_b2,bcof_b2,ccof_b2) X acof_b2,bcof_b2,ccof_b2)
call cpu_time(t1) call cpu_time(t1)
t_abcof = t_abcof + t1 - t0 t_abcof = t_abcof + t1 - t0
......
...@@ -1073,9 +1073,7 @@ c*********************************************************** ...@@ -1073,9 +1073,7 @@ c***********************************************************
DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3) DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3)
call wann_abinv( call wann_abinv(atoms,
> ntypd,natd,noccbd_b,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b,lmax,nlo,llo,invsat,invsatnr,bkpt_b,taual,
X acof_b,bcof_b,ccof_b) X acof_b,bcof_b,ccof_b)
call cpu_time(t1) call cpu_time(t1)
t_abcof = t_abcof + t1 - t0 t_abcof = t_abcof + t1 - t0
...@@ -1205,9 +1203,7 @@ c*********************************************************** ...@@ -1205,9 +1203,7 @@ c***********************************************************
DEALLOCATE(lapw_b2%k1,lapw_b2%k2,lapw_b2%k3) DEALLOCATE(lapw_b2%k1,lapw_b2%k2,lapw_b2%k3)
call wann_abinv( call wann_abinv(atoms,
> ntypd,natd,noccbd_b2,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b2,lmax,nlo,llo,invsat,invsatnr,bkpt_b2,taual,
X acof_b2,bcof_b2,ccof_b2) X acof_b2,bcof_b2,ccof_b2)
call cpu_time(t1) call cpu_time(t1)
t_abcof = t_abcof + t1 - t0 t_abcof = t_abcof + t1 - t0
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
module m_wann_abinv
contains
SUBROUTINE wann_abinv(
> ntypd,natd,neigd,lmaxd,lmd,llod,nlod,ntype,neq,
> neig,lmax,nlo,llo,invsat,invsatnr,bkpt,taual,
X acof,bcof,ccof)
C ***************************************************************
C Transform acof,bcof,ccof in case of atoms related by inversion
c symmetry to obtain the coefficients in the global frame.
c Based on abcrot.
c Frank Freimuth
C ***************************************************************
use m_constants, only:pimach
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ntypd,natd,neigd,lmd,llod,nlod,ntype
INTEGER, INTENT (IN) :: lmaxd,neig
C ..
C .. Array Arguments ..
INTEGER, INTENT (IN) :: neq(ntypd),lmax(ntypd),nlo(ntypd)
INTEGER, INTENT (IN) :: llo(nlod,ntypd)
INTEGER, INTENT (IN) :: invsat(natd),invsatnr(natd)
real,intent(in) :: bkpt(3)
REAL, INTENT (IN) :: taual(3,natd)
COMPLEX, INTENT (INOUT) :: acof(neigd,0:lmd,natd)
COMPLEX, INTENT (INOUT) :: bcof(neigd,0:lmd,natd)
COMPLEX, INTENT (INOUT) :: ccof(-llod:llod,neigd,nlod,natd)
C .. Local Scalars ..
INTEGER :: itype,ineq,iatom,iop,ilo,i,l,m,lm,lmp,ifac
integer :: n,nn,jatom,ie,ll1
real :: tpi,arg
complex :: fac
C ..
tpi=2.0*pimach()
iatom=0
DO itype=1,ntype
DO ineq=1,neq(itype)
iatom=iatom+1
IF(invsat(iatom).ne.2) cycle
DO l=1,lmax(itype),2
DO i=1,neig
acof(i,l**2:l*(l+2),iatom) = (-1)**l *
& acof(i,l**2:l*(l+2),iatom)
bcof(i,l**2:l*(l+2),iatom) = (-1)**l *
& bcof(i,l**2:l*(l+2),iatom)
ENDDO
ENDDO
DO ilo=1,nlo(itype)
l=llo(ilo,itype)
IF(l.gt.0) THEN
if(mod(l,2).eq.0)cycle
DO i=1,neig
ccof(-l:l,i,ilo,iatom) = (-1)**l *
& ccof(-l:l,i,ilo,iatom)
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
c$$$ iatom = 0
c$$$ DO n = 1,ntype
c$$$ DO nn = 1,neq(n)
c$$$ iatom = iatom + 1
c$$$ IF (invsat(iatom).EQ.1) THEN
c$$$ jatom = invsatnr(iatom)
c$$$ arg= (taual(1,jatom)+taual(1,iatom))*bkpt(1)
c$$$ arg=arg+(taual(2,jatom)+taual(2,iatom))*bkpt(2)
c$$$ arg=arg+(taual(3,jatom)+taual(3,iatom))*bkpt(3)
c$$$ arg=arg*tpi
c$$$ fac=cmplx(cos(arg),sin(arg))
c$$$ DO ilo = 1,nlo(n)
c$$$ l = llo(ilo,n)
c$$$ DO m = -l,l
c$$$ DO ie = 1,neig
c$$$ ccof(m,ie,ilo,jatom) = fac *
c$$$ + ccof(m,ie,ilo,jatom)
c$$$ ENDDO
c$$$ ENDDO
c$$$ ENDDO
c$$$ DO l = 0,lmax(n)
c$$$ ll1 = l* (l+1)
c$$$ DO m =-l,l
c$$$ lm = ll1 + m
c$$$ DO ie = 1,neig
c$$$ acof(ie,lm,jatom) = fac *
c$$$ * acof(ie,lm,jatom)
c$$$ ENDDO
c$$$ DO ie = 1,neig
c$$$ bcof(ie,lm,jatom) = fac *
c$$$ * bcof(ie,lm,jatom)
c$$$ ENDDO
c$$$ ENDDO
c$$$ ENDDO
c$$$ ENDIF
c$$$ ENDDO
c$$$ ENDDO
END subroutine
end module
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_wann_abinv
CONTAINS
SUBROUTINE wann_abinv(atoms,acof,bcof,ccof)
! ***************************************************************
! Transform acof,bcof,ccof in case of atoms related by inversion
! symmetry to obtain the coefficients in the global frame.
! Based on abcrot.
! Frank Freimuth
! ***************************************************************
USE m_types
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
TYPE(t_atoms),INTENT(IN) :: atoms
COMPLEX, INTENT (INOUT) :: acof(:,0:,:)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,neigd,nlod,natd)
! .. Local Scalars ..
INTEGER :: itype,ineq,iatom,ilo,l
iatom=0
DO itype=1,atoms%ntype
DO ineq=1,atoms%neq(itype)
iatom=iatom+1
IF(atoms%invsat(iatom).NE.2) CYCLE
DO l=1,atoms%lmax(itype),2
acof(:,l**2:l*(l+2),iatom) = (-1)**l *&
acof(:,l**2:l*(l+2),iatom)
bcof(:,l**2:l*(l+2),iatom) = (-1)**l * &
bcof(:,l**2:l*(l+2),iatom)
ENDDO
DO ilo=1,atoms%nlo(itype)
l=atoms%llo(ilo,itype)
IF(l.GT.0) THEN
IF(MOD(l,2).EQ.0)CYCLE
ccof(-l:l,:,ilo,iatom) = (-1)**l * &
ccof(-l:l,:,ilo,iatom)
ENDIF
ENDDO
ENDDO
ENDDO
END SUBROUTINE wann_abinv
END MODULE m_wann_abinv
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -615,9 +615,7 @@ c...for the lapws and local orbitals, summed by the basis functions ...@@ -615,9 +615,7 @@ c...for the lapws and local orbitals, summed by the basis functions
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus, CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,
> noco,jspin,oneD,acof,bcof,ccof,zMat) > noco,jspin,oneD,acof,bcof,ccof,zMat)
call wann_abinv( call wann_abinv(atoms,
> ntypd,natd,noccbd,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd,lmax,nlo,llo,invsat,invsatnr,bkpt,taual,
X acof,bcof,ccof) X acof,bcof,ccof)
......
This diff is collapsed.
This diff is collapsed.
...@@ -847,11 +847,9 @@ c...for the lapws and local orbitals, summed by the basis functions ...@@ -847,11 +847,9 @@ c...for the lapws and local orbitals, summed by the basis functions
+ bcof(1:,0:,1:,jspin),ccof(-llod:,1:,1:,1:,jspin), + bcof(1:,0:,1:,jspin),ccof(-llod:,1:,1:,1:,jspin),
+ zMat(jspin)) + zMat(jspin))
call wann_abinv( call wann_abinv(atoms,
> ntypd,natd,noccbd,lmaxd,lmd,llod,nlod,ntype,neq, X acof(:,0:,:,jspin),bcof(:,0:,:,jspin),
> noccbd,lmax,nlo,llo,invsat,invsatnr,bkpt,taual, < ccof(-llod:,:,:,:,jspin))
X acof(1,0,1,jspin),bcof(1,0,1,jspin),
< ccof(-llod,1,1,1,jspin))
enddo !jspin enddo !jspin
DEALLOCATE(lapw%k1,lapw%k2,lapw%k3) DEALLOCATE(lapw%k1,lapw%k2,lapw%k3)
......
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment