Commit 3d474af6 authored by Alexander Neukirchen's avatar Alexander Neukirchen

carrying home some work

parent db45ba06
...@@ -142,7 +142,8 @@ CONTAINS ...@@ -142,7 +142,8 @@ CONTAINS
! Initialize and load inDen density (start) ! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
DO i=1,3 DO i=1,3
CALL xcB(i)%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) CALL xcB(i)%init(stars,atoms,sphhar,vacuum,noco,1,POTDEN_TYPE_DEN)
ALLOCATE(xcB(i)%pw_w,mold=xcB(i)%pw)
ENDDO ENDDO
archiveType = CDN_ARCHIVE_TYPE_CDN1_const archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
...@@ -498,7 +499,9 @@ CONTAINS ...@@ -498,7 +499,9 @@ CONTAINS
END DO scfloop ! DO WHILE (l_cont) END DO scfloop ! DO WHILE (l_cont)
! DIVERGENCE ! DIVERGENCE
CALL divB%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) CALL divB%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
ALLOCATE(divB%pw_w,mold=divB%pw)
DO i=1,atoms%ntype DO i=1,atoms%ntype
CALL divergence(input%jspins,i,stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft,atoms,sphhar,sym,stars,cell,vacuum,noco,xcB,divB) CALL divergence(input%jspins,i,stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft,atoms,sphhar,sym,stars,cell,vacuum,noco,xcB,divB)
......
...@@ -65,11 +65,11 @@ CONTAINS ...@@ -65,11 +65,11 @@ CONTAINS
CALL vTot%resetPotDen() CALL vTot%resetPotDen()
CALL vCoul%resetPotDen() CALL vCoul%resetPotDen()
CALL vx%resetPotDen() CALL vx%resetPotDen()
DO i=1,3 ! DO i=1,3
CALL xcB(i)%resetPotden() ! CALL xcB(i)%resetPotden()
ALLOCATE(xcB(i)%pw_w,mold=vTot%pw) ! ALLOCATE(xcB(i)%pw_w,mold=den%pw_w)
xcB(i)%pw_w = 0.0 ! xcB(i)%pw_w = CMPLX(0.0,0.0)
ENDDO ! ENDDO
ALLOCATE(vx%pw_w,mold=vTot%pw) ALLOCATE(vx%pw_w,mold=vTot%pw)
vx%pw_w = 0.0 vx%pw_w = 0.0
......
...@@ -9,7 +9,7 @@ MODULE m_divergence ...@@ -9,7 +9,7 @@ MODULE m_divergence
PUBLIC :: mt_div, pw_div, divergence!, divpotgrad PUBLIC :: mt_div, pw_div, divergence!, divpotgrad
CONTAINS CONTAINS
SUBROUTINE mt_div(jspins,n,atoms,sphhar,sym,xcB,div) SUBROUTINE mt_div(n,atoms,sphhar,sym,xcB,div)
!-----------------------------------------------------------------------------! !-----------------------------------------------------------------------------!
!By use of the cartesian components of a field, its radial/angular derivati- ! !By use of the cartesian components of a field, its radial/angular derivati- !
!ves in the muffin tin at each spherical grid point and the corresponding an- ! !ves in the muffin tin at each spherical grid point and the corresponding an- !
...@@ -24,7 +24,7 @@ CONTAINS ...@@ -24,7 +24,7 @@ CONTAINS
IMPLICIT NONE IMPLICIT NONE
INTEGER, INTENT(IN) :: jspins, n INTEGER, INTENT(IN) :: n
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_sym), INTENT(IN) :: sym TYPE(t_sym), INTENT(IN) :: sym
...@@ -40,14 +40,15 @@ CONTAINS ...@@ -40,14 +40,15 @@ CONTAINS
nsp = atoms%nsp() nsp = atoms%nsp()
ALLOCATE (gradx%gr(3,atoms%jri(n)*nsp,jspins),grady%gr(3,atoms%jri(n)*nsp,jspins),gradz%gr(3,atoms%jri(n)*nsp,jspins)) ALLOCATE (gradx%gr(3,atoms%jri(n)*nsp,1),grady%gr(3,atoms%jri(n)*nsp,1),gradz%gr(3,atoms%jri(n)*nsp,1))
ALLOCATE (div_temp(atoms%jri(n)*nsp,jspins)) ALLOCATE (div_temp(atoms%jri(n)*nsp,1))
ALLOCATE (thet(atoms%nsp()),phi(atoms%nsp()))
CALL init_mt_grid(jspins, atoms, sphhar, .TRUE., sym) CALL init_mt_grid(1, atoms, sphhar, .TRUE., sym, thet, phi)
CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(1)%mt(:,0:,n,:), n, gradx) CALL mt_to_grid(.TRUE., 1, atoms, sphhar, xcB(1)%mt(:,0:,n,:), n, gradx)
CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(2)%mt(:,0:,n,:), n, grady) CALL mt_to_grid(.TRUE., 1, atoms, sphhar, xcB(2)%mt(:,0:,n,:), n, grady)
CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(3)%mt(:,0:,n,:), n, gradz) CALL mt_to_grid(.TRUE., 1, atoms, sphhar, xcB(3)%mt(:,0:,n,:), n, gradz)
kt = 0 kt = 0
DO jr = 1, atoms%jri(n) DO jr = 1, atoms%jri(n)
...@@ -55,15 +56,15 @@ CONTAINS ...@@ -55,15 +56,15 @@ CONTAINS
DO k = 1, nsp DO k = 1, nsp
th = thet(k) th = thet(k)
ph = phi(k) ph = phi(k)
div_temp(kt+nsp,1) = (SIN(th)*COS(ph)*gradx%gr(1,kt+nsp,jspins) + SIN(th)*SIN(ph)*grady%gr(1,kt+nsp,jspins) + COS(th)*gradz%gr(1,kt+nsp,jspins))& div_temp(kt+nsp,1) = (SIN(th)*COS(ph)*gradx%gr(1,kt+nsp,1) + SIN(th)*SIN(ph)*grady%gr(1,kt+nsp,1) + COS(th)*gradz%gr(1,kt+nsp,1))&
+(COS(th)*COS(ph)*gradx%gr(2,kt+nsp,jspins) + COS(th)*SIN(ph)*grady%gr(2,kt+nsp,jspins) - SIN(th)*gradz%gr(2,kt+nsp,jspins))/r& +(COS(th)*COS(ph)*gradx%gr(2,kt+nsp,1) + COS(th)*SIN(ph)*grady%gr(2,kt+nsp,1) - SIN(th)*gradz%gr(2,kt+nsp,1))/r&
-(SIN(ph)*gradx%gr(3,kt+nsp,jspins) + COS(ph)*grady%gr(3,kt+nsp,jspins))/(r*SIN(th)) -(SIN(ph)*gradx%gr(3,kt+nsp,1) + COS(ph)*grady%gr(3,kt+nsp,1))/(r*SIN(th))
ENDDO ! k ENDDO ! k
kt = kt+nsp kt = kt+nsp
ENDDO ! jr ENDDO ! jr
CALL mt_from_grid(atoms, sphhar, n, jspins, div_temp, div%mt(:,0:,n,:)) CALL mt_from_grid(atoms, sphhar, n, 1, div_temp, div%mt(:,0:,n,:))
CALL finish_mt_grid CALL finish_mt_grid
...@@ -103,9 +104,9 @@ CONTAINS ...@@ -103,9 +104,9 @@ CONTAINS
CALL init_pw_grid(.TRUE.,stars,sym,cell) CALL init_pw_grid(.TRUE.,stars,sym,cell)
CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(1)%pw,gradx) CALL pw_to_grid(.TRUE.,1,noco%l_noco,stars,cell,xcB(1)%pw,gradx)
CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(2)%pw,grady) CALL pw_to_grid(.TRUE.,1,noco%l_noco,stars,cell,xcB(2)%pw,grady)
CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(3)%pw,gradz) CALL pw_to_grid(.TRUE.,1,noco%l_noco,stars,cell,xcB(3)%pw,gradz)
DO i = 1, nsp DO i = 1, nsp
div_temp(i,1)=gradx%gr(1,i,1)+grady%gr(2,i,1)+gradz%gr(3,i,1) div_temp(i,1)=gradx%gr(1,i,1)+grady%gr(2,i,1)+gradz%gr(3,i,1)
...@@ -134,12 +135,10 @@ CONTAINS ...@@ -134,12 +135,10 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_potden), dimension(3), INTENT(OUT) :: xcB TYPE(t_potden), dimension(3), INTENT(IN) :: xcB
TYPE(t_potden), INTENT(OUT) :: div TYPE(t_potden), INTENT(INOUT) :: div
CALL div%init(stars,atoms,sphhar,vacuum,noco,jspins,POTDEN_TYPE_DEN)
CALL mt_div(jspins,n,atoms,sphhar,sym,xcB,div) CALL mt_div(n,atoms,sphhar,sym,xcB,div)
CALL pw_div(ifftxc3,jspins,stars,cell,noco,sym,xcB,div) CALL pw_div(ifftxc3,jspins,stars,cell,noco,sym,xcB,div)
END SUBROUTINE divergence END SUBROUTINE divergence
......
...@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid ...@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid
REAL, ALLOCATABLE :: wt(:), rx(:, :), thet(:), phi(:) REAL, ALLOCATABLE :: wt(:), rx(:, :), thet(:), phi(:)
PUBLIC :: init_mt_grid, mt_to_grid, mt_from_grid, finish_mt_grid PUBLIC :: init_mt_grid, mt_to_grid, mt_from_grid, finish_mt_grid
CONTAINS CONTAINS
SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym) SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym, thout, phout)
USE m_gaussp USE m_gaussp
USE m_lhglptg USE m_lhglptg
USE m_lhglpts USE m_lhglpts
...@@ -23,6 +23,8 @@ CONTAINS ...@@ -23,6 +23,8 @@ CONTAINS
TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_sphhar), INTENT(IN) :: sphhar
LOGICAL, INTENT(IN) :: dograds LOGICAL, INTENT(IN) :: dograds
TYPE(t_sym), INTENT(IN) :: sym TYPE(t_sym), INTENT(IN) :: sym
REAL, INTENT(OUT), OPTIONAL :: thout(:)
REAL, INTENT(OUT), OPTIONAL :: phout(:)
! generate nspd points on a sherical shell with radius 1.0 ! generate nspd points on a sherical shell with radius 1.0
! angular mesh equidistant in phi, ! angular mesh equidistant in phi,
...@@ -40,6 +42,11 @@ CONTAINS ...@@ -40,6 +42,11 @@ CONTAINS
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), dograds, sym, & CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), dograds, sym, &
ylh, thet, phi, ylht, ylhtt, ylhf, ylhff, ylhtf) ylh, thet, phi, ylht, ylhtt, ylhf, ylhff, ylhtf)
IF (PRESENT(thout)) THEN
thout=thet
phout=phi
END IF
ELSE ELSE
CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh) CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
END IF END IF
......
...@@ -69,6 +69,7 @@ CONTAINS ...@@ -69,6 +69,7 @@ CONTAINS
ifft3 = 27*stars%mx1*stars%mx2*stars%mx3 ifft3 = 27*stars%mx1*stars%mx2*stars%mx3
IF (ifft3.NE.SIZE(den%theta_pw)) CALL judft_error("Wrong size of angles") IF (ifft3.NE.SIZE(den%theta_pw)) CALL judft_error("Wrong size of angles")
ifft2 = SIZE(den%phi_vacxy,1) ifft2 = SIZE(den%phi_vacxy,1)
DO i=1,3 DO i=1,3
xcB(i)%vacxy(:,:,:,:)=0.0 xcB(i)%vacxy(:,:,:,:)=0.0
xcB(i)%vacz(:,:,:)=0.0 xcB(i)%vacz(:,:,:)=0.0
......
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