Commit d16d3702 authored by Matthias Redies's avatar Matthias Redies

merge fix

parents 4b65d160 3615dabb
...@@ -4,7 +4,7 @@ MODULE m_cdntot ...@@ -4,7 +4,7 @@ MODULE m_cdntot
! vacuum, and mt regions c.l.fu ! vacuum, and mt regions c.l.fu
! ******************************************************** ! ********************************************************
CONTAINS CONTAINS
SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,& SUBROUTINE cdntot(mpi,stars,atoms,sym,vacuum,input,cell,oneD,&
den,l_printData,qtot,qistot) den,l_printData,qtot,qistot)
USE m_intgr, ONLY : intgr3 USE m_intgr, ONLY : intgr3
...@@ -18,6 +18,7 @@ CONTAINS ...@@ -18,6 +18,7 @@ CONTAINS
IMPLICIT NONE IMPLICIT NONE
! .. Scalar Arguments .. ! .. Scalar Arguments ..
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
...@@ -88,7 +89,7 @@ CONTAINS ...@@ -88,7 +89,7 @@ CONTAINS
ELSE ELSE
qis = 0. qis = 0.
CALL pwint_all(stars,atoms,sym,oneD,cell,x) CALL pwint_all(stars,atoms,sym,oneD,cell,1,stars%ng3,x)
DO j = 1,stars%ng3 DO j = 1,stars%ng3
qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j) qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j)
ENDDO ENDDO
......
...@@ -122,7 +122,7 @@ ...@@ -122,7 +122,7 @@
END SUBROUTINE pwint END SUBROUTINE pwint
SUBROUTINE pwint_all(& SUBROUTINE pwint_all(&
& stars,atoms,sym,oneD,& & stars,atoms,sym,oneD,&
& cell,& & cell,x_start,x_end,&
& x) & x)
USE m_spgrot USE m_spgrot
...@@ -138,6 +138,7 @@ ...@@ -138,6 +138,7 @@
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
INTEGER, INTENT (IN) :: x_start,x_end
COMPLEX, INTENT (OUT):: x(:) COMPLEX, INTENT (OUT):: x(:)
! .. ! ..
!-odim !-odim
...@@ -159,7 +160,7 @@ ...@@ -159,7 +160,7 @@
!$OMP PARALLEL DO default(shared) & !$OMP PARALLEL DO default(shared) &
!$OMP PRIVATE(ng,ig3d,g,gr,fj,ig2d,s,na,kr,ph,n)& !$OMP PRIVATE(ng,ig3d,g,gr,fj,ig2d,s,na,kr,ph,n)&
!$OMP PRIVATE(srmt,nn,sfs,arg,s1,ii) !$OMP PRIVATE(srmt,nn,sfs,arg,s1,ii)
starloop:DO ng=1,size(x) starloop:DO ng=x_start,x_end
ig3d = stars%ig(stars%kv3(1,ng),stars%kv3(2,ng),stars%kv3(3,ng)) ig3d = stars%ig(stars%kv3(1,ng),stars%kv3(2,ng),stars%kv3(3,ng))
IF (ig3d.EQ.0) THEN IF (ig3d.EQ.0) THEN
x(ng) = (0.,0.) x(ng) = (0.,0.)
......
...@@ -9,7 +9,7 @@ if (XXD_PROG) ...@@ -9,7 +9,7 @@ if (XXD_PROG)
else() else()
ADD_CUSTOM_COMMAND( ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h OUTPUT ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMAND mv ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h.backup ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h COMMAND cp ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h.backup ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMENT "No xxd found using backup") COMMENT "No xxd found using backup")
message("No xxd command found! Using backup of inputSchema.h") message("No xxd command found! Using backup of inputSchema.h")
endif() endif()
...@@ -26,8 +26,8 @@ CONTAINS ...@@ -26,8 +26,8 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: na,ntyp INTEGER, INTENT (IN) :: na,ntyp
...@@ -48,20 +48,20 @@ CONTAINS ...@@ -48,20 +48,20 @@ CONTAINS
INTEGER locol,lorow,ii,ij,n,k,ab_size INTEGER locol,lorow,ii,ij,n,k,ab_size
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: ab(:,:),ax(:),bx(:),cx(:) COMPLEX, ALLOCATABLE :: ab(:,:,:),ax(:),bx(:),cx(:)
COMPLEX,ALLOCATABLE :: abclo(:,:,:,:,:) COMPLEX,ALLOCATABLE :: abclo(:,:,:,:,:)
! .. ! ..
!--> synthesize the complex conjugates of a and b !--> synthesize the complex conjugates of a and b
ALLOCATE(ab(MAXVAL(lapw%nv),0:2*atoms%lmaxd*(atoms%lmaxd+2)+1)) ALLOCATE(ab(MAXVAL(lapw%nv),0:2*atoms%lmaxd*(atoms%lmaxd+2)+1,MIN(jintsp,iintsp):MAX(jintsp,iintsp)))
ALLOCATE(ax(MAXVAL(lapw%nv)),bx(MAXVAL(lapw%nv)),cx(MAXVAL(lapw%nv))) ALLOCATE(ax(MAXVAL(lapw%nv)),bx(MAXVAL(lapw%nv)),cx(MAXVAL(lapw%nv)))
ALLOCATE(abclo(3,-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,2)) ALLOCATE(abclo(3,-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,2))
DO i=MIN(jintsp,iintsp),MAX(jintsp,iintsp) DO i=MIN(jintsp,iintsp),MAX(jintsp,iintsp)
CALL hsmt_ab(sym,atoms,noco,isp,i,ntyp,na,cell,lapw,fj,gj,ab(:,:),ab_size,.TRUE.,abclo(:,:,:,:,i),alo1,blo1,clo1) CALL hsmt_ab(sym,atoms,noco,isp,i,ntyp,na,cell,lapw,fj,gj,ab(:,:,i),ab_size,.TRUE.,abclo(:,:,:,:,i),alo1,blo1,clo1)
ENDDO ENDDO
mlo=0;mlolo=0 mlo=0;mlolo=0
DO m=1,ntyp-1 DO m=1,ntyp-1
mlo=mlo+atoms%nlo(m) mlo=mlo+atoms%nlo(m)
...@@ -80,7 +80,7 @@ CONTAINS ...@@ -80,7 +80,7 @@ CONTAINS
IF (atoms%invsat(na) == 0) invsfct = 1 IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na) == 1) invsfct = 2 IF (atoms%invsat(na) == 1) invsfct = 2
! !
DO lo = 1,atoms%nlo(ntyp) DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp) l = atoms%llo(lo,ntyp)
!---> calculate the hamiltonian matrix elements with the regular !---> calculate the hamiltonian matrix elements with the regular
...@@ -117,19 +117,18 @@ CONTAINS ...@@ -117,19 +117,18 @@ CONTAINS
!---> and that a,b,alo... are the complex !---> and that a,b,alo... are the complex
!---> conjugates of the a,b...-coefficients !---> conjugates of the a,b...-coefficients
DO kp = 1,lapw%nv(iintsp) DO kp = 1,lapw%nv(iintsp)
ax(kp) = ax(kp) + ab(kp,lmp)*utu + ab(kp,ab_size/2+lmp)*dtu ax(kp) = ax(kp) + ab(kp,lmp,iintsp)*utu + ab(kp,ab_size/2+lmp,iintsp)*dtu
bx(kp) = bx(kp) + ab(kp,lmp)*utd + ab(kp,ab_size/2+lmp)*dtd bx(kp) = bx(kp) + ab(kp,lmp,iintsp)*utd + ab(kp,ab_size/2+lmp,iintsp)*dtd
cx(kp) = cx(kp) + ab(kp,lmp)*utulo + ab(kp,ab_size/2+lmp)*dtulo cx(kp) = cx(kp) + ab(kp,lmp,iintsp)*utulo + ab(kp,ab_size/2+lmp,iintsp)*dtulo
END DO END DO
END IF END IF
END DO END DO
END DO END DO
!+t3e !+t3e
DO nkvec = 1,invsfct* (2*l+1) DO nkvec = 1,invsfct* (2*l+1)
locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN !only this MPI rank calculates this column
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
DO kp = 1,lapw%nv(iintsp) DO kp = 1,lapw%nv(iintsp)
hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + chi*invsfct * (& hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + chi*invsfct * (&
...@@ -142,8 +141,8 @@ CONTAINS ...@@ -142,8 +141,8 @@ CONTAINS
IF (input%l_useapw) THEN IF (input%l_useapw) THEN
!---> APWlo !---> APWlo
hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct * (& hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct * (&
(CONJG(ab(kp,lm))* ud%us(l,ntyp,isp)+& (CONJG(ab(kp,lm,iintsp))* ud%us(l,ntyp,isp)+&
CONJG(ab(kp,ab_size/2+lm))*ud%uds(l,ntyp,isp))*& CONJG(ab(kp,ab_size/2+lm,iintsp))*ud%uds(l,ntyp,isp))*&
(abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)& (abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)&
+abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)& +abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
+abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) )) +abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
...@@ -151,19 +150,19 @@ CONTAINS ...@@ -151,19 +150,19 @@ CONTAINS
ENDDO ENDDO
ELSE ELSE
DO kp = 1,lapw%nv(iintsp) DO kp = 1,lapw%nv(iintsp)
hmat%data_c(kp,locol) = hmat%data_c(kp,locol) + chi*invsfct * (& hmat%data_c(kp,locol) = hmat%data_c(kp,locol) + chi*invsfct * (&
abclo(1,m,nkvec,lo,jintsp) * CONJG( ax(kp) ) +& abclo(1,m,nkvec,lo,jintsp) * CONJG( ax(kp) ) +&
abclo(2,m,nkvec,lo,jintsp) * CONJG( bx(kp) ) +& abclo(2,m,nkvec,lo,jintsp) * CONJG( bx(kp) ) +&
abclo(3,m,nkvec,lo,jintsp) * CONJG( cx(kp) ) ) abclo(3,m,nkvec,lo,jintsp) * CONJG( cx(kp) ) )
IF (input%l_useapw) THEN IF (input%l_useapw) THEN
!---> APWlo !---> APWlo
hmat%data_c(kp,locol)=hmat%data_c(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct*(& hmat%data_c(kp,locol)=hmat%data_c(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct*(&
(CONJG(ab(kp,lm))* ud%us(l,ntyp,isp)+& (CONJG(ab(kp,lm,iintsp))* ud%us(l,ntyp,isp)+&
CONJG(ab(kp,ab_size/2+lm))*ud%uds(l,ntyp,isp))*& CONJG(ab(kp,ab_size/2+lm,iintsp))*ud%uds(l,ntyp,isp))*&
(abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)& (abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)&
+abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)& +abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
+abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) )) +abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
ENDIF ENDIF
ENDDO ENDDO
ENDIF ENDIF
!---> jump to the last matrixelement of the current row !---> jump to the last matrixelement of the current row
...@@ -173,13 +172,13 @@ CONTAINS ...@@ -173,13 +172,13 @@ CONTAINS
!---> calculate the hamiltonian matrix elements with other !---> calculate the hamiltonian matrix elements with other
!---> local orbitals at the same atom and with itself !---> local orbitals at the same atom and with itself
DO nkvec = 1,invsfct* (2*l+1) DO nkvec = 1,invsfct* (2*l+1)
locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN !only this MPI rank calculates this column
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e
!---> calculate the hamiltonian matrix elements with other !---> calculate the hamiltonian matrix elements with other
!---> local orbitals at the same atom, if they have the same l !---> local orbitals at the same atom, if they have the same l
DO lop = 1, (lo-1) DO lop = 1, MERGE(lo-1,atoms%nlo(ntyp),iintsp==jintsp)
IF (lop==lo) CYCLE
lp = atoms%llo(lop,ntyp) lp = atoms%llo(lop,ntyp)
DO nkvecp = 1,invsfct* (2*lp+1) DO nkvecp = 1,invsfct* (2*lp+1)
lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp
...@@ -207,8 +206,13 @@ CONTAINS ...@@ -207,8 +206,13 @@ CONTAINS
ulotu=CONJG(tlmplm%tuulo(lm,mp,lop+mlo,isp)) ulotu=CONJG(tlmplm%tuulo(lm,mp,lop+mlo,isp))
ulotd=CONJG(tlmplm%tdulo(lm,mp,lop+mlo,isp)) ulotd=CONJG(tlmplm%tdulo(lm,mp,lop+mlo,isp))
!---> note that lo > lop !---> note that lo > lop
lolop = ((lo-1)*lo)/2 + lop IF (lo>lop) THEN
ulotulo = CONJG(tlmplm%tuloulo (m,mp,lolop+mlolo,isp)) lolop = ((lo-1)*lo)/2 + lop
ulotulo = CONJG(tlmplm%tuloulo (m,mp,lolop+mlolo,isp))
ELSE
lolop = ((lop-1)*lop)/2 + lo
ulotulo = CONJG(tlmplm%tuloulo (mp,m,lolop+mlolo,isp))
ENDIF
axx=CONJG(abclo(1,m,nkvec,lo,jintsp))*utu +& axx=CONJG(abclo(1,m,nkvec,lo,jintsp))*utu +&
CONJG(abclo(2,m,nkvec,lo,jintsp))*utd +& CONJG(abclo(2,m,nkvec,lo,jintsp))*utd +&
CONJG(abclo(3,m,nkvec,lo,jintsp))*utulo CONJG(abclo(3,m,nkvec,lo,jintsp))*utulo
...@@ -240,7 +244,8 @@ CONTAINS ...@@ -240,7 +244,8 @@ CONTAINS
END DO END DO
!---> calculate the hamiltonian matrix elements of one local !---> calculate the hamiltonian matrix elements of one local
!---> orbital with itself !---> orbital with itself
DO nkvecp = 1,nkvec lop=lo
DO nkvecp = 1,MERGE(nkvec,invsfct* (2*l+1),iintsp==jintsp)
lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp
DO m = -l,l DO m = -l,l
lm = l* (l+1) + m lm = l* (l+1) + m
...@@ -294,13 +299,12 @@ CONTAINS ...@@ -294,13 +299,12 @@ CONTAINS
END DO END DO
END DO END DO
END DO END DO
ENDIF ENDIF !If this lo to be calculated by mpi rank
!-t3e
END DO END DO
END DO ! end of lo = 1,atoms%nlo loop END DO ! end of lo = 1,atoms%nlo loop
END IF END IF
!$OMP END MASTER !$OMP END MASTER
!$OMP barrier !$OMP barrier
END SUBROUTINE hlomat END SUBROUTINE hlomat
END MODULE m_hlomat END MODULE m_hlomat
...@@ -43,7 +43,7 @@ CONTAINS ...@@ -43,7 +43,7 @@ CONTAINS
REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:) REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:)
TYPE(t_usdus),INTENT(IN) :: ud TYPE(t_usdus),INTENT(IN) :: ud
CLASS(t_mat),INTENT(INOUT) :: smat CLASS(t_mat),INTENT(INOUT) :: smat
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL con,dotp,fact1,fact2,fact3,fl2p1 REAL con,dotp,fact1,fact2,fact3,fl2p1
...@@ -67,10 +67,11 @@ CONTAINS ...@@ -67,10 +67,11 @@ CONTAINS
!---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there). !---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there).
IF (atoms%invsat(na) == 0) invsfct = 1 IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na) == 1) invsfct = 2 IF (atoms%invsat(na) == 1) invsfct = 2
con = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(ntyp))**2)/2.0 con = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(ntyp))**2)/2.0
DO lo = 1,atoms%nlo(ntyp) !loop over all LOs for this atom DO lo = 1,atoms%nlo(ntyp) !loop over all LOs for this atom
l = atoms%llo(lo,ntyp) l = atoms%llo(lo,ntyp)
fl2p1 = (2*l+1)/fpi_const fl2p1 = (2*l+1)/fpi_const
fact1 = (con**2)* fl2p1 * (& fact1 = (con**2)* fl2p1 * (&
...@@ -80,11 +81,9 @@ CONTAINS ...@@ -80,11 +81,9 @@ CONTAINS
2*clo1(lo) * ud%dulon(lo,ntyp,isp) ) +& 2*clo1(lo) * ud%dulon(lo,ntyp,isp) ) +&
clo1(lo)* clo1(lo) ) clo1(lo)* clo1(lo) )
DO nkvec = 1,invsfct* (2*l+1) !Each LO can have several functions DO nkvec = 1,invsfct* (2*l+1) !Each LO can have several functions
!+t3e
locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage locol=(locol-1)/mpi%n_size+1 !this is the column in local storage!
!-t3e
k = lapw%kvec(nkvec,lo,na) k = lapw%kvec(nkvec,lo,na)
!---> calculate the overlap matrix elements with the regular !---> calculate the overlap matrix elements with the regular
!---> flapw basis-functions !---> flapw basis-functions
...@@ -105,7 +104,8 @@ CONTAINS ...@@ -105,7 +104,8 @@ CONTAINS
END DO END DO
!---> calculate the overlap matrix elements with other local !---> calculate the overlap matrix elements with other local
!---> orbitals at the same atom, if they have the same l !---> orbitals at the same atom, if they have the same l
DO lop = 1, (lo-1) DO lop = 1, MERGE(lo-1,atoms%nlo(ntyp),iintsp==jintsp)
IF (lop==lo) CYCLE !Do later
lp = atoms%llo(lop,ntyp) lp = atoms%llo(lop,ntyp)
IF (l == lp) THEN IF (l == lp) THEN
fact3 = con**2 * fl2p1 * (& fact3 = con**2 * fl2p1 * (&
...@@ -128,12 +128,12 @@ CONTAINS ...@@ -128,12 +128,12 @@ CONTAINS
cph(k,jintsp)*CONJG(cph(kp,iintsp)) cph(k,jintsp)*CONJG(cph(kp,iintsp))
ENDIF ENDIF
END DO END DO
ELSE ENDIF
END IF
END DO END DO
!---> calculate the overlap matrix elements of one local !---> calculate the overlap matrix elements of one local
!---> orbital with itself !---> orbital with itself
DO nkvecp = 1,nkvec lop=lo
DO nkvecp = 1,MERGE(nkvec,invsfct* (2*l+1),iintsp==jintsp)
kp = lapw%kvec(nkvecp,lo,na) kp = lapw%kvec(nkvecp,lo,na)
lorow=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvecp lorow=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvecp
dotp = dot_PRODUCT(lapw%gk(:,k,jintsp),lapw%gk(:,kp,iintsp)) dotp = dot_PRODUCT(lapw%gk(:,k,jintsp),lapw%gk(:,kp,iintsp))
...@@ -146,7 +146,6 @@ CONTAINS ...@@ -146,7 +146,6 @@ CONTAINS
ENDIF ENDIF
END DO END DO
ENDIF ! mod(locol-1,n_size) = nrank ENDIF ! mod(locol-1,n_size) = nrank
!-t3e
END DO END DO
END DO END DO
END IF END IF
......
...@@ -6,10 +6,8 @@ MODULE m_alineso ...@@ -6,10 +6,8 @@ MODULE m_alineso
! Eigenvalues and vectors (eig_so and zso) are returned ! Eigenvalues and vectors (eig_so and zso) are returned
!---------------------------------------------------------------------- !----------------------------------------------------------------------
CONTAINS CONTAINS
SUBROUTINE alineso(eig_id,lapw,& SUBROUTINE alineso(eig_id,lapw,mpi,DIMENSION,atoms,sym,kpts,input,noco,&
mpi,DIMENSION,atoms,sym,kpts,& cell,oneD, nk, usdus,rsoc,nsize,nmat, eig_so,zso)
input,noco,cell,oneD, nk, usdus,rsoc,&
nsize,nmat, eig_so,zso)
#include"cpp_double.h" #include"cpp_double.h"
USE m_types USE m_types
...@@ -99,16 +97,12 @@ CONTAINS ...@@ -99,16 +97,12 @@ CONTAINS
zso(:,:,:)= CMPLX(0.,0.) zso(:,:,:)= CMPLX(0.,0.)
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
CALL read_eig(& CALL read_eig(eig_id,nk,jsp, neig=ne,eig=eig(:,jsp))
eig_id,nk,jsp, neig=ne,eig=eig(:,jsp))
IF (judft_was_argument("-debugtime")) THEN IF (judft_was_argument("-debugtime")) THEN
WRITE(6,*) "Non-SOC ev for nk,jsp:",nk,jsp WRITE(6,*) "Non-SOC ev for nk,jsp:",nk,jsp
WRITE(6,"(6(f10.6,1x))") eig(:ne,jsp) WRITE(6,"(6(f10.6,1x))") eig(:ne,jsp)
ENDIF ENDIF
CALL read_eig(& CALL read_eig(eig_id,nk,jsp,n_start=1,n_end=ne,zmat=zmat(jsp))
eig_id,nk,jsp,&
n_start=1,n_end=ne,&
zmat=zmat(jsp))
! write(*,*) 'process',irank,' reads ',nk ! write(*,*) 'process',irank,' reads ',nk
...@@ -156,50 +150,36 @@ CONTAINS ...@@ -156,50 +150,36 @@ CONTAINS
nat_stop = atoms%nat nat_stop = atoms%nat
ENDIF ENDIF
nat_l = nat_stop - nat_start + 1 nat_l = nat_stop - nat_start + 1
!
! set up A and B coefficients ! set up A and B coefficients
! ALLOCATE (ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins))
ALLOCATE ( ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins) ) ALLOCATE (bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins))
ALLOCATE ( bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins) ) ALLOCATE (chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins))
ALLOCATE ( chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins) )
CALL timestart("alineso SOC: -help") CALL timestart("alineso SOC: -help")
write(*,*) nat_start,nat_stop,nat_l CALL hsohelp(DIMENSION,atoms,sym,input,lapw,nsz,cell,zmat,usdus,&
CALL hsohelp(& zso,noco,oneD,nat_start,nat_stop,nat_l,ahelp,bhelp,chelp)
& DIMENSION,atoms,sym,&
& input,lapw,nsz,&
& cell,&
& zmat,usdus,&
& zso,noco,oneD,&
& nat_start,nat_stop,nat_l,&
& ahelp,bhelp,chelp)
CALL timestop("alineso SOC: -help") CALL timestop("alineso SOC: -help")
!
! set up hamilton matrix ! set up hamilton matrix
!
CALL timestart("alineso SOC: -ham") CALL timestart("alineso SOC: -ham")
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_BARRIER(mpi%MPI_COMM,ierr) CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif #endif
ALLOCATE ( hsomtx(DIMENSION%neigd,DIMENSION%neigd,2,2) ) ALLOCATE (hsomtx(DIMENSION%neigd,DIMENSION%neigd,2,2))
CALL hsoham(atoms,noco,input,nsz,dimension%neigd,chelp,rsoc,ahelp,bhelp,& CALL hsoham(atoms,noco,input,nsz,dimension%neigd,chelp,rsoc,ahelp,bhelp,&
nat_start,nat_stop,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,& nat_start,nat_stop,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,hsomtx)
hsomtx) DEALLOCATE (ahelp,bhelp,chelp)
write(*,*) 'after hsoham'
DEALLOCATE ( ahelp,bhelp,chelp )
CALL timestop("alineso SOC: -ham") CALL timestop("alineso SOC: -ham")
IF (mpi%n_rank==0) THEN IF (mpi%n_rank==0) THEN
!
! add e.v. on diagonal ! add e.v. on diagonal
!
! write(*,*) '!!!!!!!!!!! remove SOC !!!!!!!!!!!!!!' ! write(*,*) '!!!!!!!!!!! remove SOC !!!!!!!!!!!!!!'
! hsomtx = 0 !!!!!!!!!!!! ! hsomtx = 0 !!!!!!!!!!!!
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
DO i = 1,nsz(jsp) DO i = 1,nsz(jsp)
hsomtx(i,i,jsp,jsp) = hsomtx(i,i,jsp,jsp) +& hsomtx(i,i,jsp,jsp) = hsomtx(i,i,jsp,jsp) + CMPLX(eig(i,jsp),0.)
& CMPLX(eig(i,jsp),0.)
IF (input%jspins.EQ.1) THEN IF (input%jspins.EQ.1) THEN
hsomtx(i,i,2,2) = hsomtx(i,i,2,2) +& hsomtx(i,i,2,2) = hsomtx(i,i,2,2) + CMPLX(eig(i,jsp),0.)
& CMPLX(eig(i,jsp),0.)
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
...@@ -207,34 +187,33 @@ CONTAINS ...@@ -207,34 +187,33 @@ CONTAINS
! !
! resort H-matrix ! resort H-matrix
! !
ALLOCATE ( hso(2*DIMENSION%neigd,2*DIMENSION%neigd) ) ALLOCATE (hso(2*DIMENSION%neigd,2*DIMENSION%neigd))
DO jsp = 1,2 DO jsp = 1,2
DO jsp1 = 1,2 DO jsp1 = 1,2
IF (jsp.EQ.1) nn = 0 IF (jsp.EQ.1) nn = 0
IF (jsp1.EQ.1) nn1 = 0 IF (jsp1.EQ.1) nn1 = 0
IF (jsp.EQ.2) nn = nsz(1) IF (jsp.EQ.2) nn = nsz(1)
IF (jsp1.EQ.2) nn1 = nsz(1) IF (jsp1.EQ.2) nn1 = nsz(1)
!
!write(3333,'(2i3,4e15.8)') jsp,jsp1,hsomtx(jsp,jsp1,8,8),hsomtx(jsp,jsp1,32,109) !write(3333,'(2i3,4e15.8)') jsp,jsp1,hsomtx(jsp,jsp1,8,8),hsomtx(jsp,jsp1,32,109)
DO i = 1,nsz(jsp) DO i = 1,nsz(jsp)
DO j = 1,nsz(jsp1) DO j = 1,nsz(jsp1)
hso(i+nn,j+nn1) = hsomtx(i,j,jsp,jsp1) hso(i+nn,j+nn1) = hsomtx(i,j,jsp,jsp1)
ENDDO ENDDO
ENDDO ENDDO
!
ENDDO ENDDO
ENDDO ENDDO
DEALLOCATE ( hsomtx ) DEALLOCATE (hsomtx)
! !
! add Sigma-vxc (QSGW) ! add Sigma-vxc (QSGW)
! !
IF( l_qsgw ) THEN IF(l_qsgw) THEN
nbas = lapw%nv(1) + atoms%nlotot nbas = lapw%nv(1) + atoms%nlotot
WRITE(*,'(A,I3,A,I5,A)') 'Read fleur.qsgw (',nk,',',nbas,')' WRITE(*,'(A,I3,A,I5,A)') 'Read fleur.qsgw (',nk,',',nbas,')'
IF( input%jspins .EQ. 2 ) STOP 'alineso: GW+noco not implemented.' IF( input%jspins .EQ. 2 ) STOP 'alineso: GW+noco not implemented.'
ALLOCATE ( sigma_xc(2*nsz(1),2*nsz(1)) ) ALLOCATE (sigma_xc(2*nsz(1),2*nsz(1)))
ALLOCATE ( sigma_xc_apw(nbas,nbas) ) ALLOCATE (sigma_xc_apw(nbas,nbas))
INQUIRE(667,opened=l_open) INQUIRE(667,opened=l_open)
IF( .NOT.l_open ) THEN IF( .NOT.l_open ) THEN
IF( nk.NE.1 ) STOP 'unit 667 not opened but not at 1st k' IF( nk.NE.1 ) STOP 'unit 667 not opened but not at 1st k'
...@@ -260,12 +239,12 @@ CONTAINS ...@@ -260,12 +239,12 @@ CONTAINS
j = nsz(1) * (jsp2-1) + 1 ; j1 = nsz(1) * jsp2 j = nsz(1) * (jsp2-1) + 1 ; j1 = nsz(1) * jsp2
if (l_real) THEN if (l_real) THEN
sigma_xc(i:i1,j:j1) = & sigma_xc(i:i1,j:j1) = &
& MATMUL ( TRANSPOSE(zmat(1)%data_r(:nbas,:)) ,& MATMUL ( TRANSPOSE(zmat(1)%data_r(:nbas,:)) ,&
& MATMUL ( sigma_xc_apw, zmat(1)%data_r(:nbas,:) ) ) MATMUL ( sigma_xc_apw, zmat(1)%data_r(:nbas,:) ) )
else else
sigma_xc(i:i1,j:j1) = & sigma_xc(i:i1,j:j1) = &
& MATMUL ( CONJG(TRANSPOSE(zmat(1)%data_c(:nbas,:))) ,& MATMUL ( CONJG(TRANSPOSE(zmat(1)%data_c(:nbas,:))) ,&
& MATMUL ( sigma_xc_apw, zmat(1)%data_c(:nbas,:) ) ) MATMUL ( sigma_xc_apw, zmat(1)%data_c(:nbas,:) ) )
endif endif
hso(i:i1,j:j1) = hso(i:i1,j:j1) + CONJG(sigma_xc(i:i1,j:j1)) hso(i:i1,j:j1) = hso(i:i1,j:j1) + CONJG(sigma_xc(i:i1,j:j1))
IF(jsp1.NE.jsp2) THEN IF(jsp1.NE.jsp2) THEN
...@@ -274,7 +253,7 @@ else ...@@ -274,7 +253,7 @@ else
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
DEALLOCATE ( sigma_xc_apw ) DEALLOCATE (sigma_xc_apw)
ENDIF ENDIF
! !
...@@ -285,29 +264,25 @@ else ...@@ -285,29 +264,25 @@ else
CALL timestart("alineso SOC: -diag") CALL timestart("alineso SOC: -diag")
ALLOCATE ( cwork(idim_c),rwork(idim_r) ) ALLOCATE (cwork(idim_c),rwork(idim_r))
IF (input%eonly) THEN IF (input%eonly) THEN
vectors= 'N' vectors= 'N'
ELSE ELSE