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

carrying home some work

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