Commit 0b4393da authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce t_potden type to brysh1, brysh2

..also in this commit: slight cleanup in mix/metric.f90
parent 03e00312
...@@ -153,15 +153,11 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,& ...@@ -153,15 +153,11 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
!(in the spin polarized case the arrays sm and fsm consist of spin up and spin down densities) !(in the spin polarized case the arrays sm and fsm consist of spin up and spin down densities)
CALL brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,& CALL brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,&
intfac,vacfac,inDen%pw,inDen%mt,inDen%vacz,inDen%vacxy,inDen%cdom,& intfac,vacfac,inDen,nmap,nmaph,mapmt,mapvac,mapvac2,sm)
inDen%cdomvz,inDen%cdomvxy,inDen%mmpMat(-lmaxU_const,-lmaxU_const,1,1),&
nmap,nmaph,mapmt,mapvac,mapvac2,sm)
!put output charge density into array fsm !put output charge density into array fsm
CALL brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,& CALL brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,&
intfac,vacfac,outDen%pw,outDen%mt,outDen%vacz,outDen%vacxy,outDen%cdom,& intfac,vacfac,outDen,nmap,nmaph,mapmt,mapvac,mapvac2,fsm)
outDen%cdomvz,outDen%cdomvxy,outDen%mmpMat(-lmaxU_const,-lmaxU_const,1,1),&
nmap,nmaph,mapmt,mapvac,mapvac2,fsm)
!store fsm - sm the difference on fsm !store fsm - sm the difference on fsm
DO imap = 1,nmap DO imap = 1,nmap
...@@ -196,9 +192,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,& ...@@ -196,9 +192,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
inDen%cdomvxy = CMPLX(0.0,0.0) inDen%cdomvxy = CMPLX(0.0,0.0)
inDen%mmpMat = CMPLX(0.0,0.0) inDen%mmpMat = CMPLX(0.0,0.0)
CALL brysh2(input,stars,atoms,sphhar,noco,vacuum,sym,sm,inDen%mmpMat,oneD,& CALL brysh2(input,stars,atoms,sphhar,noco,vacuum,sym,sm,oneD,inDen)
inDen%pw,inDen%mt,inDen%vacz,inDen%vacxy,inDen%cdom,&
inDen%cdomvz,inDen%cdomvxy)
!calculate the distance of charge densities... !calculate the distance of charge densities...
......
...@@ -8,7 +8,7 @@ MODULE m_brysh1 ...@@ -8,7 +8,7 @@ MODULE m_brysh1
!****************************************************** !******************************************************
CONTAINS CONTAINS
SUBROUTINE brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,& SUBROUTINE brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,&
intfac,vacfac,qpw,rho,rht,rhtxy,cdom,cdomvz,cdomvxy,n_mmp, nmap,nmaph,mapmt,mapvac,mapvac2,sout) intfac,vacfac,den,nmap,nmaph,mapmt,mapvac,mapvac2,sout)
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
...@@ -20,25 +20,18 @@ CONTAINS ...@@ -20,25 +20,18 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
! .. TYPE(t_potden),INTENT(IN) :: den
! .. Scalar Arguments ..
REAL, INTENT (IN) :: intfac,vacfac ! Scalar Arguments
INTEGER, INTENT (OUT):: mapmt,mapvac,mapvac2,nmap,nmaph REAL, INTENT (IN) :: intfac,vacfac
! .. INTEGER, INTENT (OUT) :: mapmt,mapvac,mapvac2,nmap,nmaph
! .. Array Arguments ..
!-odim ! Array Arguments
!+odim REAL, INTENT (OUT) :: sout(:)
COMPLEX, INTENT (IN) :: qpw(stars%ng3,input%jspins)
COMPLEX, INTENT (IN) :: cdomvz(vacuum%nmz,2),cdomvxy(vacuum%nmzxy,oneD%odi%n2d-1,2) ! Local Scalars
COMPLEX, INTENT (IN) :: cdom(stars%ng3),rhtxy(vacuum%nmzxy,oneD%odi%n2d-1,2,input%jspins)
COMPLEX, INTENT (IN) :: n_mmp(-3:3,-3:3,atoms%n_u,input%jspins)
REAL, INTENT (IN) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (IN) :: rht(vacuum%nmz,2,input%jspins)
REAL, INTENT (OUT):: sout(:)
! ..
! .. Local Scalars ..
INTEGER i,iv,j,js,k,l,n,nall,na,nvaccoeff,nvaccoeff2,mapmtd INTEGER i,iv,j,js,k,l,n,nall,na,nvaccoeff,nvaccoeff2,mapmtd
!
!---> put input into arrays sout !---> put input into arrays sout
! in the spin polarized case the arrays consist of ! in the spin polarized case the arrays consist of
! spin up and spin down densities ! spin up and spin down densities
...@@ -47,12 +40,12 @@ CONTAINS ...@@ -47,12 +40,12 @@ CONTAINS
DO js = 1,input%jspins DO js = 1,input%jspins
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
sout(j) = REAL(qpw(i,js)) sout(j) = REAL(den%pw(i,js))
END DO END DO
IF (.NOT.sym%invs) THEN IF (.NOT.sym%invs) THEN
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
sout(j) = AIMAG(qpw(i,js)) sout(j) = AIMAG(den%pw(i,js))
END DO END DO
ENDIF ENDIF
mapmt=0 mapmt=0
...@@ -62,7 +55,7 @@ CONTAINS ...@@ -62,7 +55,7 @@ CONTAINS
DO i = 1,atoms%jri(n) DO i = 1,atoms%jri(n)
mapmt = mapmt +1 mapmt = mapmt +1
j = j + 1 j = j + 1
sout(j) = rho(i,l,n,js) sout(j) = den%mt(i,l,n,js)
END DO END DO
END DO END DO
na = na + atoms%neq(n) na = na + atoms%neq(n)
...@@ -73,13 +66,13 @@ CONTAINS ...@@ -73,13 +66,13 @@ CONTAINS
DO k = 1,vacuum%nmz DO k = 1,vacuum%nmz
mapvac = mapvac + 1 mapvac = mapvac + 1
j = j + 1 j = j + 1
sout(j) = rht(k,iv,js) sout(j) = den%vacz(k,iv,js)
END DO END DO
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
mapvac = mapvac + 1 mapvac = mapvac + 1
j = j + 1 j = j + 1
sout(j) = REAL(rhtxy(i,k,iv,js)) sout(j) = REAL(den%vacxy(i,k,iv,js))
END DO END DO
END DO END DO
IF (.NOT.sym%invs2) THEN IF (.NOT.sym%invs2) THEN
...@@ -87,7 +80,7 @@ CONTAINS ...@@ -87,7 +80,7 @@ CONTAINS
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
mapvac = mapvac + 1 mapvac = mapvac + 1
j = j + 1 j = j + 1
sout(j) = AIMAG(rhtxy(i,k,iv,js)) sout(j) = AIMAG(den%vacxy(i,k,iv,js))
END DO END DO
END DO END DO
END IF END IF
...@@ -101,24 +94,24 @@ CONTAINS ...@@ -101,24 +94,24 @@ CONTAINS
!---> off-diagonal part of the density matrix !---> off-diagonal part of the density matrix
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
sout(j) = REAL(cdom(i)) sout(j) = REAL(den%cdom(i))
END DO END DO
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
sout(j) = AIMAG(cdom(i)) sout(j) = AIMAG(den%cdom(i))
END DO END DO
IF (input%film) THEN IF (input%film) THEN
DO iv = 1,vacuum%nvac DO iv = 1,vacuum%nvac
DO k = 1,vacuum%nmz DO k = 1,vacuum%nmz
mapvac2 = mapvac2 + 1 mapvac2 = mapvac2 + 1
j = j + 1 j = j + 1
sout(j) = REAL(cdomvz(k,iv)) sout(j) = REAL(den%cdomvz(k,iv))
END DO END DO
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
mapvac2 = mapvac2 + 1 mapvac2 = mapvac2 + 1
j = j + 1 j = j + 1
sout(j) = REAL(cdomvxy(i,k,iv)) sout(j) = REAL(den%cdomvxy(i,k,iv))
END DO END DO
END DO END DO
END DO END DO
...@@ -126,13 +119,13 @@ CONTAINS ...@@ -126,13 +119,13 @@ CONTAINS
DO k = 1,vacuum%nmz DO k = 1,vacuum%nmz
mapvac2 = mapvac2 + 1 mapvac2 = mapvac2 + 1
j = j + 1 j = j + 1
sout(j) = AIMAG(cdomvz(k,iv)) sout(j) = AIMAG(den%cdomvz(k,iv))
END DO END DO
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
mapvac2 = mapvac2 + 1 mapvac2 = mapvac2 + 1
j = j + 1 j = j + 1
sout(j) = AIMAG(cdomvxy(i,k,iv)) sout(j) = AIMAG(den%cdomvxy(i,k,iv))
END DO END DO
END DO END DO
END DO END DO
...@@ -154,9 +147,9 @@ CONTAINS ...@@ -154,9 +147,9 @@ CONTAINS
DO k = -3, 3 DO k = -3, 3
DO i = -3, 3 DO i = -3, 3
j = j + 1 j = j + 1
sout(j) = REAL(n_mmp(i,k,n,js)) sout(j) = REAL(den%mmpMat(i,k,n,js))
j = j + 1 j = j + 1
sout(j) = AIMAG(n_mmp(i,k,n,js)) sout(j) = AIMAG(den%mmpMat(i,k,n,js))
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
......
...@@ -5,45 +5,37 @@ MODULE m_brysh2 ...@@ -5,45 +5,37 @@ MODULE m_brysh2
! proper component of interstitial, m.t. and vacuum density ! proper component of interstitial, m.t. and vacuum density
!****************************************************** !******************************************************
CONTAINS CONTAINS
SUBROUTINE brysh2(& SUBROUTINE brysh2(input,stars,atoms,sphhar,noco,vacuum,&
& input,stars,atoms,sphhar,& sym,s_in,oneD,den)
& noco,vacuum,&
& sym,s_in,&
& n_mmp,oneD,qpw,rho,rht,rhtxy,cdom,cdomvz,cdomvxy)
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
! .. TYPE(t_potden),INTENT(INOUT) :: den
REAL, INTENT (IN) :: s_in(:) REAL, INTENT (IN) :: s_in(:)
REAL, INTENT (OUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: rht(vacuum%nmz,2,input%jspins) ! Local Scalars
COMPLEX, INTENT (OUT) :: qpw(stars%ng3,input%jspins),cdom(stars%ng3),cdomvz(vacuum%nmz,2)
COMPLEX, INTENT (OUT) :: rhtxy(vacuum%nmzxy,oneD%odi%n2d-1,2,input%jspins)
COMPLEX, INTENT (OUT) :: cdomvxy(vacuum%nmzxy,oneD%odi%n2d-1,2)
COMPLEX, INTENT (OUT) :: n_mmp(-3:3,-3:3,atoms%n_u,input%jspins)
! ..
! .. Local Scalars ..
INTEGER i,iv,j,js,k,l,n,na INTEGER i,iv,j,js,k,l,n,na
!
j=0 j=0
DO js = 1,input%jspins DO js = 1,input%jspins
IF (sym%invs) THEN IF (sym%invs) THEN
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
qpw(i,js) = CMPLX(s_in(j),0.0) den%pw(i,js) = CMPLX(s_in(j),0.0)
END DO END DO
ELSE ELSE
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
qpw(i,js) = CMPLX(s_in(j),s_in(j+stars%ng3)) den%pw(i,js) = CMPLX(s_in(j),s_in(j+stars%ng3))
END DO END DO
j = j + stars%ng3 j = j + stars%ng3
ENDIF ENDIF
...@@ -52,7 +44,7 @@ CONTAINS ...@@ -52,7 +44,7 @@ CONTAINS
DO l = 0,sphhar%nlh(atoms%ntypsy(na)) DO l = 0,sphhar%nlh(atoms%ntypsy(na))
DO i = 1,atoms%jri(n) DO i = 1,atoms%jri(n)
j = j + 1 j = j + 1
rho(i,l,n,js) = s_in(j) den%mt(i,l,n,js) = s_in(j)
END DO END DO
END DO END DO
na = na + atoms%neq(n) na = na + atoms%neq(n)
...@@ -61,19 +53,19 @@ CONTAINS ...@@ -61,19 +53,19 @@ CONTAINS
DO iv = 1,vacuum%nvac DO iv = 1,vacuum%nvac
DO k = 1,vacuum%nmz DO k = 1,vacuum%nmz
j = j + 1 j = j + 1
rht(k,iv,js) = s_in(j) den%vacz(k,iv,js) = s_in(j)
END DO END DO
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
j = j + 1 j = j + 1
rhtxy(i,k,iv,js) = CMPLX(s_in(j),0.0) den%vacxy(i,k,iv,js) = CMPLX(s_in(j),0.0)
END DO END DO
END DO END DO
IF (.NOT.sym%invs2) THEN IF (.NOT.sym%invs2) THEN
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
j = j + 1 j = j + 1
rhtxy(i,k,iv,js) = rhtxy(i,k,iv,js) +CMPLX(0.0,s_in(j)) den%vacxy(i,k,iv,js) = den%vacxy(i,k,iv,js) + CMPLX(0.0,s_in(j))
END DO END DO
END DO END DO
END IF END IF
...@@ -85,34 +77,34 @@ CONTAINS ...@@ -85,34 +77,34 @@ CONTAINS
!---> off-diagonal part of the density matrix !---> off-diagonal part of the density matrix
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
cdom(i) = CMPLX(s_in(j),0.0) den%cdom(i) = CMPLX(s_in(j),0.0)
END DO END DO
DO i = 1,stars%ng3 DO i = 1,stars%ng3
j = j + 1 j = j + 1
cdom(i) = cdom(i) + CMPLX(0.0,s_in(j)) den%cdom(i) = den%cdom(i) + CMPLX(0.0,s_in(j))
END DO END DO
IF (input%film) THEN IF (input%film) THEN
DO iv = 1,vacuum%nvac DO iv = 1,vacuum%nvac
DO k = 1,vacuum%nmz DO k = 1,vacuum%nmz
j = j + 1 j = j + 1
cdomvz(k,iv) = CMPLX(s_in(j),0.0) den%cdomvz(k,iv) = CMPLX(s_in(j),0.0)
END DO END DO
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
j = j + 1 j = j + 1
cdomvxy(i,k,iv) = CMPLX(s_in(j),0.0) den%cdomvxy(i,k,iv) = CMPLX(s_in(j),0.0)
END DO END DO
END DO END DO
END DO END DO
DO iv = 1,vacuum%nvac DO iv = 1,vacuum%nvac
DO k = 1,vacuum%nmz DO k = 1,vacuum%nmz
j = j + 1 j = j + 1
cdomvz(k,iv) = cdomvz(k,iv) + CMPLX(0.0,s_in(j)) den%cdomvz(k,iv) = den%cdomvz(k,iv) + CMPLX(0.0,s_in(j))
END DO END DO
DO k = 1,oneD%odi%nq2-1 DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
j = j + 1 j = j + 1
cdomvxy(i,k,iv) = cdomvxy(i,k,iv)+ CMPLX(0.0,s_in(j)) den%cdomvxy(i,k,iv) = den%cdomvxy(i,k,iv)+ CMPLX(0.0,s_in(j))
END DO END DO
END DO END DO
END DO END DO
...@@ -125,7 +117,7 @@ CONTAINS ...@@ -125,7 +117,7 @@ CONTAINS
DO k = -3, 3 DO k = -3, 3
DO i = -3, 3 DO i = -3, 3
j = j + 1 j = j + 1
n_mmp(i,k,n,js) = CMPLX(s_in(j),s_in(j+1)) den%mmpMat(i,k,n,js) = CMPLX(s_in(j),s_in(j+1))
j = j + 1 j = j + 1
ENDDO ENDDO
ENDDO ENDDO
......
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