Skip to content

GitLab

fleur
fleur
Commit f6a5ac87 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 913ced1e e99aaa5f
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 705 additions and 600 deletions
cdn/cdnval.F90
View file @ f6a5ac87
This diff is collapsed.
cdn/int_21.f90
View file @ f6a5ac87
......@@ -8,38 +8,52 @@ MODULE m_int21
!
!-----------------------------------------------------------
CONTAINS
SUBROUTINE int_21(f,g,atoms,ityp,l, uun21,udn21,dun21,ddn21)
SUBROUTINE int_21(f,g,atoms,ityp,l,denCoeffsOffdiag)
USE m_types
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
INTEGER, INTENT (IN) :: l,ityp
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
CALL int_21_arrays(f,g,atoms,ityp,l,denCoeffsOffdiag%uu21n,denCoeffsOffdiag%ud21n,&
denCoeffsOffdiag%du21n,denCoeffsOffdiag%dd21n)
END SUBROUTINE int_21
SUBROUTINE int_21_arrays(f,g,atoms,ityp,l,uu21n,ud21n,du21n,dd21n)
USE m_intgr, ONLY : intgr3
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT (IN) :: l,ityp
REAL, INTENT (OUT):: uun21,udn21,dun21,ddn21
! ... Array Arguments
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
! ...local arrays
REAL uu_tmp(atoms%jri(ityp))
REAL, INTENT (INOUT) :: uu21n(0:atoms%lmaxd,atoms%ntype),ud21n(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT (INOUT) :: du21n(0:atoms%lmaxd,atoms%ntype),dd21n(0:atoms%lmaxd,atoms%ntype)
REAL uu_tmp(atoms%jri(ityp))
uu_tmp(:atoms%jri(ityp)) = f(:atoms%jri(ityp),1,l,2)*f(:atoms%jri(ityp),1,l,1)&
+ f(:atoms%jri(ityp),2,l,2)*f(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),uun21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),uu21n(l,ityp))
uu_tmp(:atoms%jri(ityp)) = f(:atoms%jri(ityp),1,l,2)*g(:atoms%jri(ityp),1,l,1)&
+ f(:atoms%jri(ityp),2,l,2)*g(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),udn21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),ud21n(l,ityp))
uu_tmp(:atoms%jri(ityp)) = g(:atoms%jri(ityp),1,l,2)*f(:atoms%jri(ityp),1,l,1)&
+ g(:atoms%jri(ityp),2,l,2)*f(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),dun21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),du21n(l,ityp))
uu_tmp(:atoms%jri(ityp)) = g(:atoms%jri(ityp),1,l,2)*g(:atoms%jri(ityp),1,l,1)&
+ g(:atoms%jri(ityp),2,l,2)*g(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),ddn21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),dd21n(l,ityp))
END SUBROUTINE int_21
END SUBROUTINE int_21_arrays
END MODULE m_int21
cdn/int_21lo.f90
View file @ f6a5ac87
......@@ -6,17 +6,18 @@ MODULE m_int21lo
! spins (s).
! Output is ..n21(l,itype), where .. is a combination of (u,d) and
! ulo dependent on the (f,g) combination used. Also ..n12 and
! uloulopn21 are calculated.
! uloulop21n are calculated.
!
!-----------------------------------------------------------
CONTAINS
SUBROUTINE int_21lo(f,g,atoms,n, flo,ilo, uulon21,dulon21,uulon12,dulon12,uloulopn21)
SUBROUTINE int_21lo(f,g,atoms,n, flo,ilo,denCoeffsOffdiag)
USE m_intgr, ONLY : intgr3
USE m_types
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ilo,n
......@@ -24,9 +25,6 @@ CONTAINS
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: flo(:,:,:,:)!(atoms%jmtd,2,atoms%nlod,dimension%jspd)
REAL, INTENT (OUT):: uulon21,uulon12
REAL, INTENT (OUT):: dulon21,dulon12
REAL, INTENT (OUT):: uloulopn21(atoms%nlod,atoms%nlod)
! ...local scalars
INTEGER iri,l,lp,ilop
......@@ -40,22 +38,22 @@ CONTAINS
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = f(iri,1,l,2)*flo(iri,1,ilo,1)+ f(iri,2,l,2)*flo(iri,2,ilo,1)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),uulon21)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%uulo21n(ilo,n))
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = f(iri,1,l,1)*flo(iri,1,ilo,2)+ f(iri,2,l,1)*flo(iri,2,ilo,2)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),uulon12)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%ulou21n(ilo,n))
!
! --> norm of product of du and ulo:
!
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = g(iri,1,l,2)*flo(iri,1,ilo,1) + g(iri,2,l,2)*flo(iri,2,ilo,1)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),dulon21)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%dulo21n(ilo,n))
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = g(iri,1,l,1)*flo(iri,1,ilo,2) + g(iri,2,l,1)*flo(iri,2,ilo,2)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),dulon12)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%ulod21n(ilo,n))
!
! --> norm of product of ulo and ulo':
!
......@@ -65,10 +63,10 @@ CONTAINS
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = flo(iri,1,ilo,2)*flo(iri,1,ilop,1) + flo(iri,2,ilo,2)*flo(iri,2,ilop,1)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),uloulopn21(ilo,ilop))
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%uloulop21n(ilo,ilop,n))
ELSE
uloulopn21(ilo,ilop) = 0.0
denCoeffsOffdiag%uloulop21n(ilo,ilop,n) = 0.0
ENDIF
ENDDO
......
cdn/pwden.F90
View file @ f6a5ac87
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne,we,eig,den,qis,forces,f_b8,zMat)
ikpt,jspin,lapw,ne,we,eig,den,qis,results,f_b8,zMat)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -93,6 +93,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_results),INTENT(INOUT) :: results
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
......@@ -102,7 +103,6 @@ CONTAINS
INTEGER,INTENT(IN) :: ikpt,jspin
REAL,INTENT(OUT) :: qis(:,:,:) !(dimension%neigd,kpts%nkpt,dimension%jspd)
COMPLEX, INTENT (INOUT) :: f_b8(3,atoms%ntype)
REAL, INTENT (INOUT) :: forces(:,:,:) !(3,atoms%ntype,dimension%jspd)
!
!-----> LOCAL VARIABLES
!
......@@ -650,7 +650,7 @@ CONTAINS
DO istr = 1 , stars%ng3_fft
ecwk(istr) = scale * ecwk(istr) / REAL( stars%nstr(istr) )
ENDDO
CALL force_b8(atoms,ecwk,stars, sym,cell, jspin, forces,f_b8)
CALL force_b8(atoms,ecwk,stars, sym,cell, jspin, results%force,f_b8)
ENDIF
ENDIF
!
......
cdn/qal_21.f90
View file @ f6a5ac87
......@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(atoms, input,noccbd,we,ccof, noco,acof,bcof,mt21,lo21,uloulopn21, qal,qmat)
SUBROUTINE qal_21(atoms,input,noccbd,we,ccof,noco,acof,bcof,denCoeffsOffdiag,qal,qmat)
USE m_rotdenmat
USE m_types
......@@ -19,13 +19,11 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT (INout) :: we(noccbd),qal(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,input%jspins)
REAL, INTENT (IN) :: uloulopn21(atoms%nlod,atoms%nlod,atoms%ntype)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,input%jspins)
COMPLEX, INTENT (IN) :: acof(:,0:,:,:)!(noccbd,0:DIMENSION%lmd,atoms%nat,input%jspins)
COMPLEX, INTENT (IN) :: bcof(:,0:,:,:)!(noccbd,0:DIMENSION%lmd,atoms%nat,input%jspins)
REAL, INTENT (OUT) :: qmat(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,4)
TYPE (t_mt21), INTENT (IN) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (IN) :: lo21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_denCoeffsOffdiag), INTENT (IN) :: denCoeffsOffdiag
! ..
! .. Local Scalars ..
......@@ -67,8 +65,8 @@ CONTAINS
sumab = sumab + bcof(i,lm,natom,1) * CONJG(acof(i,lm,natom,input%jspins))
ENDDO atoms_loop
ENDDO ms
qal21(l,n,i) = sumaa * mt21(l,n)%uun + sumbb * mt21(l,n)%ddn +&
sumba * mt21(l,n)%dun + sumab * mt21(l,n)%udn
qal21(l,n,i) = sumaa * denCoeffsOffdiag%uu21n(l,n) + sumbb * denCoeffsOffdiag%dd21n(l,n) +&
sumba * denCoeffsOffdiag%du21n(l,n) + sumab * denCoeffsOffdiag%ud21n(l,n)
ENDDO ls
nt1 = nt1 + atoms%neq(n)
ENDDO types_loop
......@@ -126,16 +124,16 @@ CONTAINS
l = atoms%llo(lo,ntyp)
DO i = 1, noccbd
qal21(l,ntyp,i)= qal21(l,ntyp,i) + &
qaclo(i,lo,ntyp)*lo21(lo,ntyp)%uulon +&
qcloa(i,lo,ntyp)*lo21(lo,ntyp)%uloun +&
qclob(i,lo,ntyp)*lo21(lo,ntyp)%ulodn +&
qbclo(i,lo,ntyp)*lo21(lo,ntyp)%dulon
qaclo(i,lo,ntyp)*denCoeffsOffdiag%uulo21n(lo,ntyp) +&
qcloa(i,lo,ntyp)*denCoeffsOffdiag%ulou21n(lo,ntyp) +&
qclob(i,lo,ntyp)*denCoeffsOffdiag%ulod21n(lo,ntyp) +&
qbclo(i,lo,ntyp)*denCoeffsOffdiag%dulo21n(lo,ntyp)
END DO
DO lop = 1,atoms%nlo(ntyp)
IF (atoms%llo(lop,ntyp).EQ.l) THEN
DO i = 1, noccbd
qal21(l,ntyp,i)= qal21(l,ntyp,i) + &
qlo(i,lop,lo,ntyp)*uloulopn21(lop,lo,ntyp)
qlo(i,lop,lo,ntyp)*denCoeffsOffdiag%uloulop21n(lop,lo,ntyp)
ENDDO
ENDIF
ENDDO
......
cdn_mt/abcof.F90
View file @ f6a5ac87
......@@ -2,7 +2,7 @@ MODULE m_abcof
CONTAINS
SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD, acof,bcof,ccof,zMat,&
eig,acoflo,bcoflo,e1cof,e2cof,aveccof,bveccof,cveccof)
eig,force)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
......@@ -26,6 +26,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_force),OPTIONAL,INTENT(INOUT) :: force
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne
......@@ -36,13 +37,6 @@ CONTAINS
COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
COMPLEX, OPTIONAL, INTENT (OUT) :: acoflo(-atoms%llod:,:,:,:)
COMPLEX, OPTIONAL, INTENT (OUT) :: bcoflo(-atoms%llod:,:,:,:)
COMPLEX, OPTIONAL, INTENT (OUT) :: e1cof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: e2cof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: aveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: bveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX, OPTIONAL, INTENT (OUT) :: cveccof(:,-atoms%llod:,:,:,:)
! ..
! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci
......@@ -75,13 +69,13 @@ CONTAINS
bcof(:,:,:) = CMPLX(0.0,0.0)
ccof(:,:,:,:) = CMPLX(0.0,0.0)
IF(PRESENT(eig)) THEN
acoflo(:,:,:,:) = CMPLX(0.0,0.0)
bcoflo(:,:,:,:) = CMPLX(0.0,0.0)
e1cof(:,:,:) = CMPLX(0.0,0.0)
e2cof(:,:,:) = CMPLX(0.0,0.0)
aveccof(:,:,:,:) = CMPLX(0.0,0.0)
bveccof(:,:,:,:) = CMPLX(0.0,0.0)
cveccof(:,:,:,:,:) = CMPLX(0.0,0.0)
force%acoflo = CMPLX(0.0,0.0)
force%bcoflo = CMPLX(0.0,0.0)
force%e1cof = CMPLX(0.0,0.0)
force%e2cof = CMPLX(0.0,0.0)
force%aveccof = CMPLX(0.0,0.0)
force%bveccof = CMPLX(0.0,0.0)
force%cveccof = CMPLX(0.0,0.0)
END IF
! ..
!+APW_LO
......@@ -121,7 +115,7 @@ CONTAINS
!$OMP& jspin,qss,&
!$OMP& apw,const,&
!$OMP& nbasf0,enough,&
!$OMP& acof,bcof,ccof,e1cof,e2cof,acoflo,bcoflo,aveccof,bveccof,cveccof)
!$OMP& acof,bcof,ccof,force)
DO n = 1,atoms%ntype
CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1)
......@@ -246,18 +240,18 @@ CONTAINS
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
IF (zmat%l_real) THEN
e1cof(:ne,lm,natom) = e1cof(:ne,lm,natom) + c_1 * work_r(:ne) * s2h_e(:ne)
e2cof(:ne,lm,natom) = e2cof(:ne,lm,natom) + c_2 * work_r(:ne) * s2h_e(:ne)
force%e1cof(:ne,lm,natom) = force%e1cof(:ne,lm,natom) + c_1 * work_r(:ne) * s2h_e(:ne)
force%e2cof(:ne,lm,natom) = force%e2cof(:ne,lm,natom) + c_2 * work_r(:ne) * s2h_e(:ne)
DO i = 1,3
aveccof(i,:ne,lm,natom) = aveccof(i,:ne,lm,natom) + c_1 * work_r(:ne) * fgp(i)
bveccof(i,:ne,lm,natom) = bveccof(i,:ne,lm,natom) + c_2 * work_r(:ne) * fgp(i)
force%aveccof(i,:ne,lm,natom) = force%aveccof(i,:ne,lm,natom) + c_1 * work_r(:ne) * fgp(i)
force%bveccof(i,:ne,lm,natom) = force%bveccof(i,:ne,lm,natom) + c_2 * work_r(:ne) * fgp(i)
END DO
ELSE
e1cof(:ne,lm,natom) = e1cof(:ne,lm,natom) + c_1 * work_c(:ne) * s2h_e(:ne)
e2cof(:ne,lm,natom) = e2cof(:ne,lm,natom) + c_2 * work_c(:ne) * s2h_e(:ne)
force%e1cof(:ne,lm,natom) = force%e1cof(:ne,lm,natom) + c_1 * work_c(:ne) * s2h_e(:ne)
force%e2cof(:ne,lm,natom) = force%e2cof(:ne,lm,natom) + c_2 * work_c(:ne) * s2h_e(:ne)
DO i = 1,3
aveccof(i,:ne,lm,natom) = aveccof(i,:ne,lm,natom) + c_1 * work_c(:ne) * fgp(i)
bveccof(i,:ne,lm,natom) = bveccof(i,:ne,lm,natom) + c_2 * work_c(:ne) * fgp(i)
force%aveccof(i,:ne,lm,natom) = force%aveccof(i,:ne,lm,natom) + c_1 * work_c(:ne) * fgp(i)
force%bveccof(i,:ne,lm,natom) = force%bveccof(i,:ne,lm,natom) + c_2 * work_c(:ne) * fgp(i)
END DO
END IF
ENDIF
......@@ -272,11 +266,11 @@ CONTAINS
CALL CPP_BLAS_caxpy(ne,c_1,work_c,1, acof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c,1, bcof(1,lmp,jatom),1)
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
CALL CPP_BLAS_caxpy(ne,c_1,work_c*s2h_e,1, e1cof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*s2h_e,1, e2cof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_1,work_c*s2h_e,1, force%e1cof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*s2h_e,1, force%e2cof(1,lmp,jatom),1)
DO i = 1,3
CALL CPP_BLAS_caxpy(ne,c_1,work_c*fgp(i),1, aveccof(i,1,lmp,jatom),3)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*fgp(i),1, bveccof(i,1,lmp,jatom),3)
CALL CPP_BLAS_caxpy(ne,c_1,work_c*fgp(i),1, force%aveccof(i,1,lmp,jatom),3)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*fgp(i),1, force%bveccof(i,1,lmp,jatom),3)
END DO
END IF
ENDIF
......@@ -288,7 +282,7 @@ CONTAINS
IF (k==lapw%kvec(nkvec,lo,natom)) THEN !check if this k-vector has LO attached
CALL abclocdn(atoms,sym,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,&
n,natom,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,&
fgp,acoflo,bcoflo,aveccof,bveccof,cveccof)
fgp,force%acoflo,force%bcoflo,force%aveccof,force%bveccof,force%cveccof)
ENDIF
ENDDO
END DO
......@@ -334,10 +328,10 @@ CONTAINS
DO ie = 1,ne
ccof(m,ie,ilo,jatom) = inv_f * cexp * CONJG( ccof(-m,ie,ilo,iatom))
IF(PRESENT(eig)) THEN
acoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(acoflo(-m,ie,ilo,iatom))
bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(bcoflo(-m,ie,ilo,iatom))
force%acoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%acoflo(-m,ie,ilo,iatom))
force%bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%bcoflo(-m,ie,ilo,iatom))
DO i = 1,3
cveccof(i,m,ie,ilo,jatom) = -inv_f * cexp * CONJG(cveccof(i,-m,ie,ilo,iatom))
force%cveccof(i,m,ie,ilo,jatom) = -inv_f * cexp * CONJG(force%cveccof(i,-m,ie,ilo,iatom))
END DO
END IF
ENDDO
......@@ -355,11 +349,11 @@ CONTAINS
END DO
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
DO ie = 1,ne
e1cof(ie,lm,jatom) = inv_f * cexp * CONJG(e1cof(ie,lmp,iatom))
e2cof(ie,lm,jatom) = inv_f * cexp * CONJG(e2cof(ie,lmp,iatom))
force%e1cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e1cof(ie,lmp,iatom))
force%e2cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e2cof(ie,lmp,iatom))
DO i = 1,3
aveccof(i,ie,lm,jatom) = -inv_f * cexp * CONJG(aveccof(i,ie,lmp,iatom))
bveccof(i,ie,lm,jatom) = -inv_f * cexp * CONJG(bveccof(i,ie,lmp,iatom))
force%aveccof(i,ie,lm,jatom) = -inv_f * cexp * CONJG(force%aveccof(i,ie,lmp,iatom))
force%bveccof(i,ie,lm,jatom) = -inv_f * cexp * CONJG(force%bveccof(i,ie,lmp,iatom))
END DO
END DO
END IF
......
cdn_mt/cdnmt.f90
View file @ f6a5ac87
......@@ -11,9 +11,9 @@ MODULE m_cdnmt
!***********************************************************************
CONTAINS
SUBROUTINE cdnmt(jspd,atoms,sphhar,llpd, noco,l_fmpl,jsp_start,jsp_end, epar,&
ello,vr,uu,du,dd,uunmt,udnmt,dunmt,ddnmt, usdus,aclo,bclo,cclo,&
acnmt,bcnmt,ccnmt,orb,mt21,lo21,uloulopn21,uloulop21, uunmt21,&
ddnmt21,udnmt21,dunmt21, chmom,clmom, qa21,rho)
ello,vr,denCoeffs,usdus,&
orb,denCoeffsOffdiag,&
chmom,clmom, qa21,rho)
use m_constants,only: sfp_const
USE m_rhosphnlo
USE m_radfun
......@@ -35,31 +35,12 @@ CONTAINS
REAL, INTENT (IN) :: epar(0:atoms%lmaxd,atoms%ntype,jspd)
REAL, INTENT (IN) :: vr(atoms%jmtd,atoms%ntype,jspd)
REAL, INTENT (IN) :: ello(atoms%nlod,atoms%ntype,jspd)
REAL, INTENT (IN) :: aclo(atoms%nlod,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: bclo(atoms%nlod,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: cclo(atoms%nlod,atoms%nlod,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: acnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: bcnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: ccnmt(atoms%nlod,atoms%nlod,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: uu(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: du(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: dd(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: uunmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: udnmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: dunmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: ddnmt(0:llpd,sphhar%nlhd,atoms%ntype,jsp_start:jsp_end)
REAL, INTENT (IN) :: uloulopn21(atoms%nlod,atoms%nlod,atoms%ntype)
COMPLEX, INTENT (IN) :: uloulop21(atoms%nlod,atoms%nlod,atoms%ntype)
COMPLEX, INTENT (IN) :: ddnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT (IN) :: dunmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT (IN) :: udnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT (IN) :: uunmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype)
REAL, INTENT (OUT) :: chmom(atoms%ntype,jspd),clmom(3,atoms%ntype,jspd)
REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd)
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype)
TYPE (t_orb), INTENT (IN) :: orb
TYPE (t_mt21), INTENT (IN) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (IN) :: lo21(atoms%nlod,atoms%ntype)
TYPE (t_orb), INTENT(IN) :: orb
TYPE (t_denCoeffs), INTENT(IN) :: denCoeffs
TYPE (t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
! ..
! .. Local Scalars ..
INTEGER itype,na,nd,l,lp,llp ,lh,j,ispin,noded,nodeu
......@@ -89,9 +70,8 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,chmom,clmom,qa21,rho21,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,uu,dd,du,sphhar,ello,aclo,bclo,cclo) &
!$OMP SHARED(acnmt,bcnmt,ccnmt,orb,ddnmt,udnmt,dunmt,uunmt,mt21,lo21,uloulop21)&
!$OMP SHARED(uloulopn21,noco,l_fmpl,uunmt21,ddnmt21,dunmt21,udnmt21,jspd)&
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,denCoeffs,sphhar,ello)&
!$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
IF (noco%l_mperp) THEN
ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,jspd),g(atoms%jmtd,2,0:atoms%lmaxd,jspd) )
......@@ -114,9 +94,9 @@ CONTAINS
CALL radfun(l,itype,ispin,epar(l,itype,ispin),vr(1,itype,ispin),atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk)
DO j = 1,atoms%jri(itype)
s = uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )&
+ dd(l,itype,ispin)*( g(j,1,l,ispin)*g(j,1,l,ispin)+g(j,2,l,ispin)*g(j,2,l,ispin) )&
+ 2*du(l,itype,ispin)*( f(j,1,l,ispin)*g(j,1,l,ispin)+f(j,2,l,ispin)*g(j,2,l,ispin) )
s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )&
+ denCoeffs%dd(l,itype,ispin)*( g(j,1,l,ispin)*g(j,1,l,ispin)+g(j,2,l,ispin)*g(j,2,l,ispin) )&
+ 2*denCoeffs%du(l,itype,ispin)*( f(j,1,l,ispin)*g(j,1,l,ispin)+f(j,2,l,ispin)*g(j,2,l,ispin) )
rho(j,0,itype,ispin) = rho(j,0,itype,ispin)+ s/(atoms%neq(itype)*sfp_const)
ENDDO
ENDDO
......@@ -131,9 +111,9 @@ CONTAINS
CALL rhosphnlo(itype,atoms,sphhar,&
usdus%uloulopn(1,1,itype,ispin),usdus%dulon(1,itype,ispin),&
usdus%uulon(1,itype,ispin),ello(1,itype,ispin),&
vr(1,itype,ispin),aclo(1,itype,ispin),bclo(1,itype,ispin),&
cclo(1,1,itype,ispin),acnmt(0,1,1,itype,ispin),&
bcnmt(0,1,1,itype,ispin),ccnmt(1,1,1,itype,ispin),&
vr(1,itype,ispin),denCoeffs%aclo(1,itype,ispin),denCoeffs%bclo(1,itype,ispin),&
denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),&
denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),&
f(1,1,0,ispin),g(1,1,0,ispin),&
rho(:,0:,itype,ispin),qmtllo)
......@@ -141,7 +121,7 @@ CONTAINS
!---> l-decomposed density for each atom type
qmtt = 0.0
DO l = 0,atoms%lmax(itype)
qmtl(l,ispin,itype) = ( uu(l,itype,ispin)+dd(l,itype,ispin)&
qmtl(l,ispin,itype) = ( denCoeffs%uu(l,itype,ispin)+denCoeffs%dd(l,itype,ispin)&
& *usdus%ddn(l,itype,ispin) )/atoms%neq(itype) + qmtllo(l)
qmtt = qmtt + qmtl(l,ispin,itype)
END DO
......@@ -162,13 +142,13 @@ CONTAINS
DO lp = 0,l
llp = (l* (l+1))/2 + lp
DO j = 1,atoms%jri(itype)
s = uunmt(llp,lh,itype,ispin)*( &
s = denCoeffs%uunmt(llp,lh,itype,ispin)*( &
f(j,1,l,ispin)*f(j,1,lp,ispin)+ f(j,2,l,ispin)*f(j,2,lp,ispin) )&
+ ddnmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*g(j,1,lp,ispin)&
+ denCoeffs%ddnmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*g(j,1,lp,ispin)&
+ g(j,2,l,ispin)*g(j,2,lp,ispin) )&
+ udnmt(llp,lh,itype,ispin)*(f(j,1,l,ispin)*g(j,1,lp,ispin)&
+ denCoeffs%udnmt(llp,lh,itype,ispin)*(f(j,1,l,ispin)*g(j,1,lp,ispin)&
+ f(j,2,l,ispin)*g(j,2,lp,ispin) )&
+ dunmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*f(j,1,lp,ispin)&
+ denCoeffs%dunmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*f(j,1,lp,ispin)&
+ g(j,2,l,ispin)*f(j,2,lp,ispin) )
rho(j,lh,itype,ispin) = rho(j,lh,itype,ispin)+ s/atoms%neq(itype)
ENDDO
......@@ -182,22 +162,22 @@ CONTAINS
!---> calculate off-diagonal integrated density
DO l = 0,atoms%lmax(itype)
qa21(itype) = qa21(itype) + conjg(&
mt21(l,itype)%uu * mt21(l,itype)%uun +&
mt21(l,itype)%ud * mt21(l,itype)%udn +&
mt21(l,itype)%du * mt21(l,itype)%dun +&
mt21(l,itype)%dd * mt21(l,itype)%ddn )/atoms%neq(itype)
denCoeffsOffdiag%uu21(l,itype) * denCoeffsOffdiag%uu21n(l,itype) +&
denCoeffsOffdiag%ud21(l,itype) * denCoeffsOffdiag%ud21n(l,itype) +&
denCoeffsOffdiag%du21(l,itype) * denCoeffsOffdiag%du21n(l,itype) +&
denCoeffsOffdiag%dd21(l,itype) * denCoeffsOffdiag%dd21n(l,itype) )/atoms%neq(itype)
ENDDO
DO ilo = 1, atoms%nlo(itype)
qa21(itype) = qa21(itype) + conjg(&
lo21(ilo,itype)%ulou * lo21(ilo,itype)%uloun +&
lo21(ilo,itype)%ulod * lo21(ilo,itype)%ulodn +&
lo21(ilo,itype)%uulo * lo21(ilo,itype)%uulon +&
lo21(ilo,itype)%dulo * lo21(ilo,itype)%dulon )/&
denCoeffsOffdiag%ulou21(ilo,itype) * denCoeffsOffdiag%ulou21n(ilo,itype) +&
denCoeffsOffdiag%ulod21(ilo,itype) * denCoeffsOffdiag%ulod21n(ilo,itype) +&
denCoeffsOffdiag%uulo21(ilo,itype) * denCoeffsOffdiag%uulo21n(ilo,itype) +&
denCoeffsOffdiag%dulo21(ilo,itype) * denCoeffsOffdiag%dulo21n(ilo,itype) )/&
atoms%neq(itype)
DO ilop = 1, atoms%nlo(itype)
qa21(itype) = qa21(itype) + conjg(&
uloulop21(ilo,ilop,itype) *&
uloulopn21(ilo,ilop,itype) )/atoms%neq(itype)
denCoeffsOffdiag%uloulop21(ilo,ilop,itype) *&
denCoeffsOffdiag%uloulop21n(ilo,ilop,itype) )/atoms%neq(itype)
ENDDO
ENDDO
......@@ -209,10 +189,10 @@ CONTAINS
!---> spherical component
DO l = 0,atoms%lmax(itype)
DO j = 1,atoms%jri(itype)
cs = mt21(l,itype)%uu*( f(j,1,l,2)*f(j,1,l,1) +f(j,2,l,2)*f(j,2,l,1) )&
+ mt21(l,itype)%ud*( f(j,1,l,2)*g(j,1,l,1) +f(j,2,l,2)*g(j,2,l,1) )&
+ mt21(l,itype)%du*( g(j,1,l,2)*f(j,1,l,1) +g(j,2,l,2)*f(j,2,l,1) )&
+ mt21(l,itype)%dd*( g(j,1,l,2)*g(j,1,l,1) +g(j,2,l,2)*g(j,2,l,1) )
cs = denCoeffsOffdiag%uu21(l,itype)*( f(j,1,l,2)*f(j,1,l,1) +f(j,2,l,2)*f(j,2,l,1) )&
+ denCoeffsOffdiag%ud21