Commit 1b2ec199 authored by Alexander Neukirchen's avatar Alexander Neukirchen

Sourcefree in its most basic form works; still some problems.

parent c57acc4c
......@@ -519,13 +519,12 @@ CONTAINS
!CALL builddivtest(stars,atoms,sphhar,vacuum,sym,cell,1,testDen)
!CALL makeBxc(stars,atoms,sphhar,vacuum,input,noco,vTot,testDen)
!CALL dummyDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
!CALL matrixsplit(stars, atoms, sphhar, vacuum, input, noco, 1.0, inDen, dummyDen, testDen(1), testDen(2), testDen(3))
!CALL checkplotinp()
!CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDen ', dummyDen, testDen(1), testDen(2), testDen(3))
CALL matrixsplit(stars, atoms, sphhar, vacuum, input, noco, 1.0, inDen, dummyDen, testDen(1), testDen(2), testDen(3))
CALL checkplotinp()
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDen ', dummyDen, testDen(1), testDen(2), testDen(3))
!CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDeny ', testDen(2))
!CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testDenz ', testDen(3))
!CALL sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,testDen)
CALL sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,testDen)
CALL add_usage_data("Iterations",iter)
......
......@@ -1071,7 +1071,7 @@ CONTAINS
SUBROUTINE plotBtest(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, &
noco, div, phi, divGrx, divGry, divGrz, &
xcBmodx, xcBmody, xcBmodz)
xcBmodx, xcBmody, xcBmodz, div2)
IMPLICIT NONE
......@@ -1085,31 +1085,33 @@ CONTAINS
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden), INTENT(IN) :: div, phi, divGrx, divGry, divGrz, &
xcBmodx, xcBmody, xcBmodz
xcBmodx, xcBmody, xcBmodz, div2
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .FALSE., 'divergence ', div)
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'modPot ', phi)
LOGICAL :: xsf
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'divPotx ', divGrx)
.FALSE., .FALSE., 'div ', div)
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'divPoty ', divGry)
.FALSE., .TRUE., 'phiDiv ', phi)
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'divPotz ', divGrz)
.FALSE., .TRUE., 'gradPhiDiv ', divGrx, divGrx, divGry, divGrz)
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'xcBmodx ', xcBmodx)
.FALSE., .TRUE., 'bCorrected ', xcBmodx, xcBmodx, xcBmody, xcBmodz)
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'xcBmody ', xcBmody)
.FALSE., .FALSE., 'divCorrected ', div2)
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, &
.FALSE., .TRUE., 'xcBmodz ', xcBmodz)
INQUIRE(file="div.xsf",exist=xsf)
IF (xsf) THEN
OPEN (120, FILE='gradPhiDiv_f.xsf', STATUS='OLD')
CLOSE (120, STATUS="DELETE")
OPEN (120, FILE='bCorrected_f.xsf', STATUS='OLD')
CLOSE (120, STATUS="DELETE")
END IF
END SUBROUTINE plotBtest
......
......@@ -224,24 +224,11 @@ CONTAINS
DO i=1,3
CALL mt_from_grid(atoms, sphhar, n, 1, grad_temp(:,:,i), gradphi(i)%mt(:,0:,n,:))
DO jr = 1, atoms%jri(n)
DO lh=0, lhmax
IF (ABS(gradphi(i)%mt(jr,lh,n,1))<eps) THEN
gradphi(i)%mt(jr,lh,n,:)=0.0
END IF
END DO
END DO
END DO
DO lh=0, lhmax
gradphi(i)%mt(:,lh,n,1) = gradphi(i)%mt(:,lh,n,1)*atoms%rmsh(:, n)**2
END DO ! lh
END DO ! i
kt = 0
DO jr = 1, atoms%jri(n)
r =atoms%rmsh(jr, n)
DO i=1,3
gradphi(i)%mt(jr,0:,n,:) = gradphi(i)%mt(jr,0:,n,:)*r**2
END DO
kt = kt+nsp
ENDDO ! jr
CALL finish_mt_grid
END SUBROUTINE mt_grad
......@@ -313,32 +300,8 @@ CONTAINS
TYPE(t_potden), INTENT(IN) :: pot
TYPE(t_potden), dimension(3), INTENT(INOUT) :: grad
!TYPE(t_potden) :: den
!REAL, ALLOCATABLE :: ch(:, :)
REAL :: r
!REAL, ALLOCATABLE :: r2Array(:)
INTEGER :: jr, k, nsp, kt, n
!CALL den%init(stars,atoms,sphhar,vacuum,noco,1,POTDEN_TYPE_DEN)
!ALLOCATE(den%pw_w,mold=den%pw)
nsp = atoms%nsp()
!ALLOCATE(r2Array(nsp*atoms%jri(n)))
!ALLOCATE(ch(nsp*atoms%jri(n),1))
!CALL init_mt_grid(1, atoms, sphhar, .TRUE., sym)
!CALL mt_to_grid(.TRUE., 1, atoms, sphhar, pot%mt(:,0:,n,:), n, dummygrad, ch)
!ch(:,1)=ch(:,1)*r2Array
!CALL mt_from_grid(atoms, sphhar, n, 1, ch, den%mt(:,0:,n,:))
!CALL finish_mt_grid
INTEGER :: n
!den%pw = pot%pw
!den%pw_w = pot%pw_w
!den%vacz = pot%vacz
!den%vacxy = pot%vacxy
DO n=1,atoms%ntype
CALL mt_grad(n,atoms,sphhar,sym,pot,grad)
END DO
......
......@@ -103,7 +103,7 @@ CONTAINS
TYPE(t_potden), DIMENSION(3), INTENT(IN) :: bxc
TYPE(t_atoms) :: atloc
TYPE(t_potden) :: div,phi
TYPE(t_potden) :: div,phi,checkdiv
TYPE(t_potden), DIMENSION(3) :: cvec, corrB
INTEGER :: n, jr
......@@ -126,16 +126,9 @@ CONTAINS
DO n=1, atoms%ntype
lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1))
DO jr = 1, atoms%jri(n)
r=atoms%rmsh(jr, n)
DO lh=0, lhmax
!IF (ABS(phi%mt(jr,lh,n,1))<eps) THEN
! phi%mt(jr,lh,n,:)=0.0
!ELSE
phi%mt(jr,0:,n,:) = phi%mt(jr,0:,n,:)*r**2
!END IF
END DO
END DO ! jr
DO lh=0, lhmax
phi%mt(:,lh,n,1) = phi%mt(:,lh,n,1)*atoms%rmsh(:, n)**2
END DO
END DO
DO i=1,3
......@@ -150,10 +143,17 @@ CONTAINS
ALLOCATE(corrB(i)%pw_w,mold=corrB(i)%pw)
CALL corrB(i)%addPotDen(bxc(i),cvec(i))
ENDDO
CALL checkdiv%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype, &
atoms%n_u,1,.FALSE.,.FALSE.,POTDEN_TYPE_DEN, &
vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
ALLOCATE(checkdiv%pw_w,mold=checkdiv%pw)
CALL divergence(stars,atoms,sphhar,vacuum,sym,cell,noco,corrB,checkdiv)
CALL plotBtest(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, &
noco, div, phi, cvec(1), cvec(2), cvec(3), &
corrB(1), corrB(2), corrB(3))
corrB(1), corrB(2), corrB(3), checkdiv)
END SUBROUTINE sourcefree
......
  • The divergence (when put on a real space grid) is reduced by a factor of ~1000. It still shows its highest values at the cores and there are some discontinuities at the MT boundaries. There is still work to be done.

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