Commit 2edf7234 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into TranBlaha

parents 19f54526 a66013c6
......@@ -30,9 +30,9 @@ CONTAINS
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: solver
CLASS(t_mat), INTENT(INOUT) :: smat,hmat
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: ev
INTEGER, INTENT(INOUT) :: ne
REAL, INTENT(OUT) :: eig(:)
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: ev ! eigenvectors
INTEGER, INTENT(INOUT) :: ne ! number of eigenpairs to be found
REAL, INTENT(OUT) :: eig(:) ! eigenvalues
!Only for chase
INTEGER,OPTIONAL, INTENT(IN) :: ikpt
......@@ -64,7 +64,7 @@ CONTAINS
CASE (diag_scalapack)
CALL scalapack(hmat,smat,ne,eig,ev)
CASE (diag_magma)
!CALL magma_diag(hmat,smat,ne,eig,ev)
CALL magma_diag(hmat,smat,ne,eig,ev)
CASE (diag_cusolver)
CALL cusolver_diag(hmat,smat,ne,eig,ev)
CASE (diag_lapack)
......
......@@ -18,8 +18,8 @@ CONTAINS
! ne ....... number of ev's searched (and found) on this node
! On input, overall number of ev's searched,
! On output, local number of ev's found
! eig ...... eigenvalues, output
! ev ....... eigenvectors, output
! eig ...... all eigenvalues, output
! ev ....... local eigenvectors, output
!
!----------------------------------------------------
......@@ -453,21 +453,23 @@ CONTAINS
CALL MPI_COMM_FREE(mpi_comm_cols,err)
#endif
!
! Put those eigenvalues expected by chani to eig, i.e. for
! process i these are eigenvalues i+1, np+i+1, 2*np+i+1...
! Only num=num2/np eigenvalues per process
! Each process has all eigenvalues in output
eig(:num2) = eig2(:num2)
DEALLOCATE(eig2)
!
!
! Redistribute eigenvectors from ScaLAPACK distribution to each process, i.e. for
! process i these are eigenvectors i+1, np+i+1, 2*np+i+1...
! Only num=num2/np eigenvectors per process
!
num=FLOOR(REAL(num2)/np)
IF (myid.LT.num2-(num2/np)*np) num=num+1
ne=0
DO i=myid+1,num2,np
ne=ne+1
eig(ne)=eig2(i)
!eig(ne)=eig2(i)
ENDDO
DEALLOCATE(eig2)
!
! Redistribute eigvec from ScaLAPACK distribution to each process
! having all eigenvectors corresponding to his eigenvalues as above
!
ALLOCATE(t_mpimat::ev)
CALL ev%init(hmat%l_real,hmat%global_size1,hmat%global_size1,hmat%blacsdata%mpi_com,.FALSE.)
......
......@@ -87,19 +87,21 @@ CONTAINS
CALL elpa_uninit()
! END of ELPA stuff
!
! Put those eigenvalues expected by chani to eig, i.e. for
! process i these are eigenvalues i+1, np+i+1, 2*np+i+1...
! Each process has all eigenvalues in output
eig(:ne) = eig2(:ne)
DEALLOCATE(eig2)
!
!
! Redistribute eigenvectors from ScaLAPACK distribution to each process, i.e. for
! process i these are eigenvectors i+1, np+i+1, 2*np+i+1...
! Only num=num2/np eigenvectors per process
!
num=ne
ne=0
DO i=myid+1,num,np
ne=ne+1
eig(ne)=eig2(i)
ENDDO
DEALLOCATE(eig2)
!
! Redistribute eigvec from ScaLAPACK distribution to each process
! having all eigenvectors corresponding to his eigenvalues as above
!
ALLOCATE(t_mpimat::ev)
CALL ev%init(hmat%l_real,hmat%global_size1,hmat%global_size1,hmat%blacsdata%mpi_com,.FALSE.)
......
......@@ -17,8 +17,8 @@ CONTAINS
! ne ....... number of ev's searched (and found) on this node
! On input, overall number of ev's searched,
! On output, local number of ev's found
! eig ...... eigenvalues, output
! ev ....... eigenvectors, output
! eig ...... all eigenvalues, output
! ev ....... local eigenvectors, output
!
!----------------------------------------------------
!
......@@ -238,22 +238,22 @@ CONTAINS
!ENDIF
ENDIF
!
! Put those eigenvalues expected by chani to eig, i.e. for
! process i these are eigenvalues i+1, np+i+1, 2*np+i+1...
! Only num=num2/np eigenvalues per process
! Each process has all eigenvalues in output
eig(:num2) = eig2(:num2)
DEALLOCATE(eig2)
!
!
! Redistribute eigenvectors from ScaLAPACK distribution to each process, i.e. for
! process i these are eigenvectors i+1, np+i+1, 2*np+i+1...
! Only num=num2/np eigenvectors per process
!
num=FLOOR(REAL(num2)/np)
IF (myid.LT.num2-(num2/np)*np) num=num+1
ne=0
DO i=myid+1,num2,np
ne=ne+1
eig(ne)=eig2(i)
!eig(ne)=eig2(i)
ENDDO
DEALLOCATE(eig2)
!
! Redistribute eigvec from ScaLAPACK distribution to each process
! having all eigenvectors corresponding to his eigenvalues as above
!
ALLOCATE(t_mpimat::ev)
CALL ev%init(ev_dist%l_real,ev_dist%global_size1,ev_dist%global_size1,ev_dist%blacsdata%mpi_com,.FALSE.)
CALL ev%copy(ev_dist,1,1)
......
......@@ -199,6 +199,12 @@ CONTAINS
end select
END IF
! Solve generalized eigenvalue problem.
! ne_all ... number of eigenpairs searched (and found) on this node
! on input, overall number of eigenpairs searched,
! on output, local number of eigenpairs found
! eig ...... all eigenvalues, output
! zMat ..... local eigenvectors, output
CALL eigen_diag(solver,hmat,smat,ne_all,eig,zMat,nk,jsp,iter)
CALL smat%free()
......@@ -220,8 +226,18 @@ CONTAINS
IF (.NOT.zMat%l_real) THEN
zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found))
END IF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,&
eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zMat=zMat)
IF (mpi%n_rank == 0) THEN
! Only process 0 writes out the value of ne_all and the
! eigenvalues.
! Trying to use MPI_PUT for the very same slot by all processes
! causes problems with IntelMPI/2019
! Mai 2019 U. Alekseeva
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,&
eig(:ne_all),n_start=mpi%n_size,n_end=mpi%n_rank,zMat=zMat)
ELSE
CALL write_eig(eig_id, nk,jsp,ne_found,&
n_start=mpi%n_size,n_end=mpi%n_rank,zMat=zMat)
ENDIF
neigBuffer(nk,jsp) = ne_found
#if defined(CPP_MPI)
! RMA synchronization
......
......@@ -265,7 +265,8 @@ CONTAINS
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
!write the number of eigenvalues values
!write the number of eigenvalues
!only one process needs to do it
IF (PRESENT(neig_total)) THEN
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,d%neig_handle,e)
ALLOCATE(tmp_int(1))
......@@ -275,25 +276,15 @@ CONTAINS
DEALLOCATE(tmp_int)
ENDIF
!write the eigenvalues
!only one process needs to do it
IF (PRESENT(eig).OR.PRESENT(w_iks)) THEN
ALLOCATE(tmp_real(d%size_eig))
tmp_real=1E99
if (PRESENT(EIG)) THEN
n1=1;n3=1
IF (PRESENT(n_rank)) n1=n_rank+1
IF (PRESENT(n_size)) n3=n_size
n2=SIZE(eig)*n3+n1-1
nn=1
DO n=n1,min(n2,d%size_eig),n3
tmp_real(n)=eig(nn)
nn=nn+1
ENDDO
tmp_real(:d%size_eig) = eig(:d%size_eig)
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,d%eig_handle,e)
IF (n3.ne.1) THEN
CALL MPI_ACCUMULATE(tmp_real,d%size_eig,MPI_DOUBLE_PRECISION,pe,slot,d%size_eig,MPI_DOUBLE_PRECISION,MPI_MIN,d%eig_handle,e)
ELSE
CALL MPI_PUT(tmp_real,d%size_eig,MPI_DOUBLE_PRECISION,pe,slot,d%size_eig,MPI_DOUBLE_PRECISION,d%eig_handle,e)
ENDIF
CALL MPI_PUT(tmp_real,d%size_eig,MPI_DOUBLE_PRECISION,pe,slot,d%size_eig,MPI_DOUBLE_PRECISION,d%eig_handle,e)
CALL MPI_WIN_UNLOCK(pe,d%eig_handle,e)
END if
IF (PRESENT(w_iks)) THEN
......@@ -304,6 +295,9 @@ CONTAINS
END IF
DEALLOCATE(tmp_real)
ENDIF
!write the eigenvectors
!all procceses participate
IF (PRESENT(zmat)) THEN
tmp_size=zmat%matsize1
ALLOCATE(tmp_real(tmp_size))
......
......@@ -4,9 +4,7 @@ wannier/eulerrot.f
#wannier/w90kpunktgen.f
wannier/wann_1dvacabcof.F
wannier/wann_2dvacabcof.F
wannier/wann_abinv.f
wannier/wann_amn.f
wannier/wann_anglmom.f
wannier/wann_dipole2.f
wannier/wann_dipole3.f
wannier/wann_dipole_electronic.f
......@@ -27,7 +25,6 @@ wannier/wann_gwf_commat.f
wannier/wann_gwf_tools.f
wannier/wann_gwf_write_mmnk.F
wannier/wann_hopping.F
wannier/wannier.F
wannier/wannier_to_lapw.F
wannier/wann_ioncharge_gen.f
wannier/wann_kpointgen.f
......@@ -52,7 +49,6 @@ wannier/wann_mmnk_symm.f
wannier/wann_nabla_pauli_rs.f
wannier/wann_nabla_rs.f
wannier/wann_nocoplot.F
wannier/wann_orbcomp.f
#wannier/wann_orbmag.F
wannier/wann_pauli_rs.F
wannier/wann_perpmag_rs.f
......@@ -62,7 +58,6 @@ wannier/wann_plot_symm.f
wannier/wann_plot_um_dat.F
wannier/wann_plot_vac.F
#wannier/wann_plotw90.F
wannier/wann_postproc.F
wannier/wann_postproc_setup4.F
wannier/wann_postproc_setup5.F
wannier/wann_postproc_setup.F
......@@ -99,6 +94,11 @@ set(fleur_F90 ${fleur_F90}
wannier/init_wannier_defaults.f90
wannier/wann_read_inp.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)
set(fleur_F90 ${fleur_F90}
......
......@@ -1100,9 +1100,7 @@ c***********************************************************
DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3)
call wann_abinv(
> ntypd,natd,noccbd_b,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b,lmax,nlo,llo,invsat,invsatnr,bkpt_b,taual,
call wann_abinv(atoms,
X acof_b,bcof_b,ccof_b)
call cpu_time(t1)
t_abcof = t_abcof + t1 - t0
......@@ -1222,9 +1220,7 @@ c***********************************************************
DEALLOCATE(lapw_b2%k1,lapw_b2%k2,lapw_b2%k3)
call wann_abinv(
> ntypd,natd,noccbd_b2,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b2,lmax,nlo,llo,invsat,invsatnr,bkpt_b2,taual,
call wann_abinv(atoms,
X acof_b2,bcof_b2,ccof_b2)
call cpu_time(t1)
t_abcof = t_abcof + t1 - t0
......
......@@ -1073,9 +1073,7 @@ c***********************************************************
DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3)
call wann_abinv(
> ntypd,natd,noccbd_b,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b,lmax,nlo,llo,invsat,invsatnr,bkpt_b,taual,
call wann_abinv(atoms,
X acof_b,bcof_b,ccof_b)
call cpu_time(t1)
t_abcof = t_abcof + t1 - t0
......@@ -1205,9 +1203,7 @@ c***********************************************************
DEALLOCATE(lapw_b2%k1,lapw_b2%k2,lapw_b2%k3)
call wann_abinv(
> ntypd,natd,noccbd_b2,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd_b2,lmax,nlo,llo,invsat,invsatnr,bkpt_b2,taual,
call wann_abinv(atoms,
X acof_b2,bcof_b2,ccof_b2)
call cpu_time(t1)
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
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,
> noco,jspin,oneD,acof,bcof,ccof,zMat)
call wann_abinv(
> ntypd,natd,noccbd,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd,lmax,nlo,llo,invsat,invsatnr,bkpt,taual,
call wann_abinv(atoms,
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
+ bcof(1:,0:,1:,jspin),ccof(-llod:,1:,1:,1:,jspin),
+ zMat(jspin))
call wann_abinv(
> ntypd,natd,noccbd,lmaxd,lmd,llod,nlod,ntype,neq,
> noccbd,lmax,nlo,llo,invsat,invsatnr,bkpt,taual,
X acof(1,0,1,jspin),bcof(1,0,1,jspin),
< ccof(-llod,1,1,1,jspin))
call wann_abinv(atoms,
X acof(:,0:,:,jspin),bcof(:,0:,:,jspin),
< ccof(-llod:,:,:,:,jspin))
enddo !jspin
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