Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
51
Issues
51
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
5c6ae6b5
Commit
5c6ae6b5
authored
Nov 13, 2019
by
Alexander Neukirchen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Playing around with boundaries and cutting components.
parent
9b23d5db
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
147 additions
and
124 deletions
+147
-124
main/fleur.F90
main/fleur.F90
+11
-11
main/vgen.F90
main/vgen.F90
+1
-1
mix/kerker.F90
mix/kerker.F90
+1
-1
optional/plot.f90
optional/plot.f90
+2
-2
rdmft/rdmft.F90
rdmft/rdmft.F90
+1
-1
vgen/divergence.f90
vgen/divergence.f90
+64
-55
vgen/vgen_coulomb.F90
vgen/vgen_coulomb.F90
+5
-2
vgen/vmts.F90
vgen/vmts.F90
+0
-2
vgen/xcBfield.f90
vgen/xcBfield.f90
+62
-49
No files found.
main/fleur.F90
View file @
5c6ae6b5
...
...
@@ -517,20 +517,20 @@ CONTAINS
! Test: Build a field, for which the theoretical divergence etc. are known and
! compare with the result of the routine.
CALL
builddivtest
(
stars
,
atoms
,
sphhar
,
vacuum
,
sym
,
cell
,
1
,
testDen
)
!CALL makeBxc(stars,atoms,sphhar,vacuum,input,noco,vTot
,testDen)
!CALL matrixsplit(stars, atoms, sphhar, vacuum, input, noco, 1.0, inDen, dummyDen, testDen(1), testDen(2), testDen(3)
)
!
CALL builddivtest(stars,atoms,sphhar,vacuum,sym,cell,1,testDen)
!CALL makeVectorField(stars,atoms,sphhar,vacuum,input,noco,inDen,1.0
,testDen)
CALL
makeVectorField
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
noco
,
vtot
,
2.0
,
testDen
)
!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.
,
'testDen '
,
testDen
(
1
)
,
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)
DO
i
=
1
,
3
CALL
testGrad
(
i
)
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
POTDEN_TYPE_POTTOT
,
vacuum
%
nmzd
,
vacuum
%
nmzxyd
,
stars
%
ng2
)
ALLOCATE
(
testGrad
(
i
)
%
pw_w
,
mold
=
testGrad
(
i
)
%
pw
)
ENDDO
CALL
divpotgrad
(
stars
,
atoms
,
sphhar
,
vacuum
,
sym
,
cell
,
noco
,
testDen
(
2
),
testGrad
)
CALL
savxsf
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
oneD
,
sym
,
cell
,
noco
,
.FALSE.
,
.FALSE.
,
'testGrad '
,
testGrad
(
1
),
testGrad
(
1
),
testGrad
(
2
),
testGrad
(
3
))
CALL
sourcefree
(
mpi
,
dimension
,
field
,
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
oneD
,
sym
,
cell
,
noco
,
testDen
)
!
DO i=1,3
!
CALL testGrad(i)%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,atoms%n_u,1,.FALSE.,.FALSE.,POTDEN_TYPE_POTTOT,vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
!
ALLOCATE(testGrad(i)%pw_w,mold=testGrad(i)%pw)
!
ENDDO
!CALL divpotgrad(stars,atoms,sphhar,vacuum,sym,cell,noco,testDen(3
),testGrad)
!
CALL savxsf(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, .FALSE., .FALSE., 'testGrad ', testGrad(1), testGrad(1), testGrad(2), testGrad(3))
CALL
add_usage_data
(
"Iterations"
,
iter
)
...
...
main/vgen.F90
View file @
5c6ae6b5
...
...
@@ -80,7 +80,7 @@ CONTAINS
!sum up both spins in den into workden
CALL
den
%
sum_both_spin
(
workden
)
CALL
vgen_coulomb
(
1
,
mpi
,
dimension
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
sphhar
,
atoms
,
workden
,
vCoul
,
results
)
CALL
vgen_coulomb
(
1
,
mpi
,
dimension
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
sphhar
,
atoms
,
.FALSE.
,
workden
,
vCoul
,
results
)
CALL
vCoul
%
copy_both_spin
(
vTot
)
vCoul
%
mt
(:,:,:,
input
%
jspins
)
=
vCoul
%
mt
(:,:,:,
1
)
...
...
mix/kerker.F90
View file @
5c6ae6b5
...
...
@@ -58,7 +58,7 @@ CONTAINS
#endif
IF
(
.NOT.
input
%
film
)
THEN
CALL
vgen_coulomb
(
1
,
mpi
,
DIMENSION
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
&
sphhar
,
atoms
,
resDen
,
vYukawa
)
sphhar
,
atoms
,
.FALSE.
,
resDen
,
vYukawa
)
ELSE
if
(
mpi
%
irank
==
0
)
then
call
resDenMod
%
init
(
stars
,
atoms
,
sphhar
,
vacuum
,
noco
,
input
%
jspins
,
POTDEN_TYPE_DEN
)
...
...
optional/plot.f90
View file @
5c6ae6b5
...
...
@@ -1096,10 +1096,10 @@ CONTAINS
.FALSE.
,
.TRUE.
,
'phiDiv '
,
phi
)
CALL
savxsf
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
oneD
,
sym
,
cell
,
noco
,
&
.FALSE.
,
.
TRU
E.
,
'gradPhiDiv '
,
divGrx
,
divGrx
,
divGry
,
divGrz
)
.FALSE.
,
.
FALS
E.
,
'gradPhiDiv '
,
divGrx
,
divGrx
,
divGry
,
divGrz
)
CALL
savxsf
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
oneD
,
sym
,
cell
,
noco
,
&
.FALSE.
,
.
TRU
E.
,
'bCorrected '
,
xcBmodx
,
xcBmodx
,
xcBmody
,
xcBmodz
)
.FALSE.
,
.
FALS
E.
,
'bCorrected '
,
xcBmodx
,
xcBmodx
,
xcBmody
,
xcBmodz
)
CALL
savxsf
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
oneD
,
sym
,
cell
,
noco
,
&
.FALSE.
,
.FALSE.
,
'divCorrected '
,
div2
)
...
...
rdmft/rdmft.F90
View file @
5c6ae6b5
...
...
@@ -401,7 +401,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
CALL
overallVCoul
%
resetPotDen
()
ALLOCATE
(
overallVCoul
%
pw_w
(
size
(
overallVCoul
%
pw
,
1
),
size
(
overallVCoul
%
pw
,
2
)))
overallVCoul
%
pw_w
(:,:)
=
0.0
CALL
vgen_coulomb
(
1
,
mpi
,
DIMENSION
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
sphhar
,
atoms
,
overallDen
,
overallVCoul
)
CALL
vgen_coulomb
(
1
,
mpi
,
DIMENSION
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
sphhar
,
atoms
,
.FALSE.
,
overallDen
,
overallVCoul
)
CALL
convol
(
stars
,
overallVCoul
%
pw_w
(:,
1
),
overallVCoul
%
pw
(:,
1
),
stars
%
ufft
)
! Is there a problem with a second spin?!
#ifdef CPP_MPI
CALL
mpi_bc_potden
(
mpi
,
stars
,
sphhar
,
atoms
,
input
,
vacuum
,
oneD
,
noco
,
overallVCoul
)
...
...
vgen/divergence.f90
View file @
5c6ae6b5
...
...
@@ -9,7 +9,7 @@ MODULE m_divergence
PUBLIC
::
mt_div
,
pw_div
,
divergence
,
mt_grad
,
pw_grad
,
divpotgrad
CONTAINS
SUBROUTINE
mt_div
(
n
,
atoms
,
sphhar
,
sym
,
bxc
,
div
)
SUBROUTINE
mt_div
(
atoms
,
sphhar
,
sym
,
bxc
,
div
)
USE
m_mt_tofrom_grid
!--------------------------------------------------------------------------
...
...
@@ -25,68 +25,72 @@ CONTAINS
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
n
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
IN
)
::
bxc
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
IN
OUT
)
::
bxc
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
div
TYPE
(
t_gradients
)
::
gradx
,
grady
,
gradz
TYPE
(
t_gradients
)
::
gradx
,
grady
,
gradz
REAL
,
ALLOCATABLE
::
thet
(:),
phi
(:),
div_temp
(:,
:)
,
div_temp2
(:,
:)
REAL
,
ALLOCATABLE
::
thet
(:),
phi
(:),
div_temp
(:,
:)
REAL
::
r
,
th
,
ph
,
eps
INTEGER
::
jr
,
k
,
nsp
,
kt
,
i
,
lh
,
lhmax
INTEGER
::
jr
,
k
,
nsp
,
kt
,
i
,
lh
,
lhmax
,
n
nsp
=
atoms
%
nsp
()
lhmax
=
sphhar
%
nlh
(
atoms
%
ntypsy
(
SUM
(
atoms
%
neq
(:
n
-
1
))
+
1
))
eps
=
1.e-10
eps
=
1.e-12
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
(
div_temp2
(
atoms
%
jri
(
n
)
*
nsp
,
1
))
ALLOCATE
(
thet
(
atoms
%
nsp
()),
phi
(
atoms
%
nsp
()))
CALL
init_mt_grid
(
1
,
atoms
,
sphhar
,
.TRUE.
,
sym
,
thet
,
phi
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
bxc
(
1
)
%
mt
(:,
0
:,
n
,:),
n
,
gradx
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
bxc
(
2
)
%
mt
(:,
0
:,
n
,:),
n
,
grady
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
bxc
(
3
)
%
mt
(:,
0
:,
n
,:),
n
,
gradz
)
kt
=
0
DO
jr
=
1
,
atoms
%
jri
(
n
)
r
=
atoms
%
rmsh
(
jr
,
n
)
DO
k
=
1
,
nsp
th
=
thet
(
k
)
ph
=
phi
(
k
)
div_temp
(
kt
+
k
,
1
)
=
(
SIN
(
th
)
*
COS
(
ph
)
*
gradx
%
gr
(
1
,
kt
+
k
,
1
)
+
SIN
(
th
)
*
SIN
(
ph
)
*
grady
%
gr
(
1
,
kt
+
k
,
1
)
+
COS
(
th
)
*
gradz
%
gr
(
1
,
kt
+
k
,
1
))&
+
(
COS
(
th
)
*
COS
(
ph
)
*
gradx
%
gr
(
2
,
kt
+
k
,
1
)
+
COS
(
th
)
*
SIN
(
ph
)
*
grady
%
gr
(
2
,
kt
+
k
,
1
)
-
SIN
(
th
)
*
gradz
%
gr
(
2
,
kt
+
k
,
1
))/
r
&
-
(
SIN
(
ph
)
*
gradx
%
gr
(
3
,
kt
+
k
,
1
)
-
COS
(
ph
)
*
grady
%
gr
(
3
,
kt
+
k
,
1
))/(
r
*
SIN
(
th
))
ENDDO
! k
kt
=
kt
+
nsp
ENDDO
! jr
CALL
mt_from_grid
(
atoms
,
sphhar
,
n
,
1
,
div_temp
,
div
%
mt
(:,
0
:,
n
,:))
DO
jr
=
1
,
atoms
%
jri
(
n
)
DO
lh
=
0
,
lhmax
IF
(
ABS
(
div
%
mt
(
jr
,
lh
,
n
,
1
))
<
eps
)
THEN
div
%
mt
(
jr
,
lh
,
n
,:)
=
0.0
END
IF
END
DO
DO
i
=
1
,
3
bxc
(
i
)
%
mt
(:,
1
:,:,:)
=
0.0
END
DO
kt
=
0
DO
jr
=
1
,
atoms
%
jri
(
n
)
r
=
atoms
%
rmsh
(
jr
,
n
)
div
%
mt
(
jr
,
0
:,
n
,:)
=
div
%
mt
(
jr
,
0
:,
n
,:)
*
r
**
2
kt
=
kt
+
nsp
ENDDO
! jr
CALL
mt_to_grid
(
.FALSE.
,
1
,
atoms
,
sphhar
,
div
%
mt
(:,
0
:,
n
,:),
n
,
gradx
,
div_temp2
)
DO
n
=
1
,
atoms
%
ntype
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
))
div_temp
=
0.0
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
bxc
(
1
)
%
mt
(:,
0
:,
n
,:),
n
,
gradx
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
bxc
(
2
)
%
mt
(:,
0
:,
n
,:),
n
,
grady
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
bxc
(
3
)
%
mt
(:,
0
:,
n
,:),
n
,
gradz
)
kt
=
0
DO
jr
=
1
,
atoms
%
jri
(
n
)
r
=
atoms
%
rmsh
(
jr
,
n
)
DO
k
=
1
,
nsp
th
=
thet
(
k
)
ph
=
phi
(
k
)
div_temp
(
kt
+
k
,
1
)
=
(
SIN
(
th
)
*
COS
(
ph
)
*
gradx
%
gr
(
1
,
kt
+
k
,
1
)
+
SIN
(
th
)
*
SIN
(
ph
)
*
grady
%
gr
(
1
,
kt
+
k
,
1
)
+
COS
(
th
)
*
gradz
%
gr
(
1
,
kt
+
k
,
1
))&
+
(
COS
(
th
)
*
COS
(
ph
)
*
gradx
%
gr
(
2
,
kt
+
k
,
1
)
+
COS
(
th
)
*
SIN
(
ph
)
*
grady
%
gr
(
2
,
kt
+
k
,
1
)
-
SIN
(
th
)
*
gradz
%
gr
(
2
,
kt
+
k
,
1
))/
r
&
-
(
SIN
(
ph
)
*
gradx
%
gr
(
3
,
kt
+
k
,
1
)
-
COS
(
ph
)
*
grady
%
gr
(
3
,
kt
+
k
,
1
))/(
r
*
SIN
(
th
))
END
DO
!k
kt
=
kt
+
nsp
END
DO
!jr
CALL
mt_from_grid
(
atoms
,
sphhar
,
n
,
1
,
div_temp
,
div
%
mt
(:,
0
:,
n
,:))
DEALLOCATE
(
gradx
%
gr
,
grady
%
gr
,
gradz
%
gr
,
div_temp
)
END
DO
!n
!DO n = 1, atoms%ntype
! lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1))
! DO jr = 1, atoms%jri(n)
! DO lh=0, lhmax
! IF (ABS(div%mt(jr,lh,n,1))<eps) THEN
! IF (lh/=1) THEN
! div%mt(jr,lh,n,:)=0.0
! END IF
! END DO
! END DO
!END DO
DO
n
=
1
,
atoms
%
ntype
lhmax
=
sphhar
%
nlh
(
atoms
%
ntypsy
(
SUM
(
atoms
%
neq
(:
n
-
1
))
+
1
))
DO
lh
=
0
,
lhmax
div
%
mt
(:,
lh
,
n
,
1
)
=
div
%
mt
(:,
lh
,
n
,
1
)
*
atoms
%
rmsh
(:,
n
)
**
2
ENDDO
!lh
ENDDO
!n
CALL
finish_mt_grid
...
...
@@ -155,15 +159,10 @@ CONTAINS
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
IN
)
::
bxc
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
IN
OUT
)
::
bxc
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
div
INTEGER
::
n
DO
n
=
1
,
atoms
%
ntype
CALL
mt_div
(
n
,
atoms
,
sphhar
,
sym
,
bxc
,
div
)
END
DO
CALL
mt_div
(
atoms
,
sphhar
,
sym
,
bxc
,
div
)
CALL
pw_div
(
stars
,
sym
,
cell
,
noco
,
bxc
,
div
)
END
SUBROUTINE
divergence
...
...
@@ -191,6 +190,7 @@ CONTAINS
TYPE
(
t_potden
),
INTENT
(
IN
)
::
den
TYPE
(
t_potden
),
dimension
(
3
),
INTENT
(
INOUT
)
::
gradphi
TYPE
(
t_potden
)
::
denloc
TYPE
(
t_gradients
)
::
grad
REAL
,
ALLOCATABLE
::
thet
(:),
phi
(:),
grad_temp
(:,
:,
:)
...
...
@@ -205,9 +205,15 @@ CONTAINS
ALLOCATE
(
grad_temp
(
atoms
%
jri
(
n
)
*
nsp
,
1
,
3
))
ALLOCATE
(
thet
(
atoms
%
nsp
()),
phi
(
atoms
%
nsp
()))
denloc
=
den
DO
lh
=
0
,
lhmax
denloc
%
mt
(:,
lh
,
n
,
1
)
=
denloc
%
mt
(:,
lh
,
n
,
1
)
*
atoms
%
rmsh
(:,
n
)
**
2
END
DO
! lh
CALL
init_mt_grid
(
1
,
atoms
,
sphhar
,
.TRUE.
,
sym
,
thet
,
phi
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
den
%
mt
(:,
0
:,
n
,:),
n
,
grad
)
CALL
mt_to_grid
(
.TRUE.
,
1
,
atoms
,
sphhar
,
den
loc
%
mt
(:,
0
:,
n
,:),
n
,
grad
)
kt
=
0
DO
jr
=
1
,
atoms
%
jri
(
n
)
...
...
@@ -226,6 +232,9 @@ CONTAINS
CALL
mt_from_grid
(
atoms
,
sphhar
,
n
,
1
,
grad_temp
(:,:,
i
),
gradphi
(
i
)
%
mt
(:,
0
:,
n
,:))
DO
lh
=
0
,
lhmax
gradphi
(
i
)
%
mt
(:,
lh
,
n
,
1
)
=
gradphi
(
i
)
%
mt
(:,
lh
,
n
,
1
)
*
atoms
%
rmsh
(:,
n
)
**
2
IF
((
sphhar
%
llh
(
lh
,
1
)/
=
0
)
.AND.
(
sphhar
%
llh
(
lh
,
1
)/
=
2
))
THEN
gradphi
(
i
)
%
mt
(:,
lh
,
n
,
1
)
=
0.0
END
IF
END
DO
! lh
END
DO
! i
...
...
vgen/vgen_coulomb.F90
View file @
5c6ae6b5
...
...
@@ -11,7 +11,7 @@ module m_vgen_coulomb
contains
subroutine
vgen_coulomb
(
ispin
,
mpi
,
dimension
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
&
cell
,
sphhar
,
atoms
,
den
,
vCoul
,
results
)
cell
,
sphhar
,
atoms
,
d
osf
,
d
en
,
vCoul
,
results
)
!----------------------------------------------------------------------------
! FLAPW potential generator
!----------------------------------------------------------------------------
...
...
@@ -50,6 +50,7 @@ contains
type
(
t_cell
),
intent
(
in
)
::
cell
type
(
t_sphhar
),
intent
(
in
)
::
sphhar
type
(
t_atoms
),
intent
(
in
)
::
atoms
LOGICAL
,
INTENT
(
IN
)
::
dosf
type
(
t_potden
),
intent
(
in
)
::
den
type
(
t_potden
),
intent
(
inout
)
::
vCoul
type
(
t_results
),
intent
(
inout
),
optional
::
results
...
...
@@ -174,7 +175,9 @@ contains
call
timestop
(
"interstitial"
)
end
if
! mpi%irank == 0
if
(
dosf
)
then
vCoul
%
pw
(:,:)
=
0.0
end
do
! MUFFIN-TIN POTENTIAL
call
timestart
(
"MT-spheres"
)
...
...
vgen/vmts.F90
View file @
5c6ae6b5
...
...
@@ -74,8 +74,6 @@ contains
#endif
integer
::
OMP_GET_NUM_THREADS
,
OMP_GET_THREAD_NUM
! SPHERE BOUNDARY CONTRIBUTION to the coefficients calculated from the values
! of the interstitial Coulomb / Yukawa potential on the sphere boundary
...
...
vgen/xcBfield.f90
View file @
5c6ae6b5
...
...
@@ -17,20 +17,22 @@ MODULE m_xcBfield
! consistent source-free fields.
!-----------------------------------------------------------------------------
PUBLIC
::
makeBxc
,
sourcefree
,
builddivtest
PUBLIC
::
makeBxc
,
sourcefree
,
builddivtest
! TODO: Build a routine to pack A_vec
! back into the matrix correctly.
CONTAINS
SUBROUTINE
make
Bxc
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
noco
,
vTot
,
bx
c
)
SUBROUTINE
make
VectorField
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
noco
,
denmat
,
factor
,
aVe
c
)
! Contructs the exchange-correlation magnetic field from the total poten-
! tial matrix
. Only used for the implementation of source free fields and
! the
refore only applicable in a fully non-collinear description of magne-
! tism.
! tial matrix
or the magnetic density for the density matrix. Only used for
! the
implementation of source free fields and therefore only applicable in
!
a fully non-collinear description of magne
tism.
!
! Assumes the following form for the potential matrix:
! V_mat = V*Id_(2x2) + sigma_vec*B_vec
! Assumes the following form for the density/potential matrix:
! rho_mat = n*Id_(2x2) + conj(sigma_vec)*m_vec
! V_mat = V*Id_(2x2) + sigma_vec*B_vec
!
!
B
_vec is saved as a density type with an additional r^2-factor.
!
A
_vec is saved as a density type with an additional r^2-factor.
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
...
...
@@ -38,8 +40,9 @@ CONTAINS
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
OUT
)
::
bxc
TYPE
(
t_potden
),
INTENT
(
IN
)
::
denmat
REAL
,
INTENT
(
IN
)
::
factor
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
OUT
)
::
aVec
TYPE
(
t_potden
),
DIMENSION
(
4
)
::
dummyDen
INTEGER
::
i
,
itype
,
ir
...
...
@@ -54,28 +57,31 @@ CONTAINS
ALLOCATE
(
dummyDen
(
i
)
%
pw_w
,
mold
=
dummyDen
(
i
)
%
pw
)
ENDDO
CALL
matrixsplit
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
noco
,
2.0
,
vto
t
,
&
CALL
matrixsplit
(
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
noco
,
factor
,
denma
t
,
&
dummyDen
(
1
),
dummyDen
(
2
),
dummyDen
(
3
),
dummyDen
(
4
))
r2
=
1.0
! Initialize and fill the magnetic field.
DO
itype
=
1
,
atoms
%
ntype
DO
ir
=
1
,
atoms
%
jri
(
itype
)
r2
=
atoms
%
rmsh
(
ir
,
itype
)
**
2
DO
i
=
1
,
3
CALL
bxc
(
i
)
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
&
atoms
%
ntype
,
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
&
POTDEN_TYPE_POTTOT
,
vacuum
%
nmzd
,
vacuum
%
nmzxyd
,
stars
%
ng2
)
ALLOCATE
(
bxc
(
i
)
%
pw_w
,
mold
=
bxc
(
i
)
%
pw
)
bxc
(
i
)
%
mt
(:,
0
:,:,:)
=
dummyDen
(
i
+1
)
%
mt
(:,
0
:,:,:)
bxc
(
i
)
%
pw
(
1
:,:)
=
dummyDen
(
i
+1
)
%
pw
(
1
:,:)
bxc
(
i
)
%
vacz
(
1
:,
1
:,:)
=
dummyDen
(
i
+1
)
%
vacz
(
1
:,
1
:,:)
bxc
(
i
)
%
vacxy
(
1
:,
1
:,
1
:,:)
=
dummyDen
(
i
+1
)
%
vacxy
(
1
:,
1
:,
1
:,:)
ENDDO
END
DO
END
DO
! Initialize and fill the vector field.
DO
i
=
1
,
3
CALL
aVec
(
i
)
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
&
atoms
%
ntype
,
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
&
POTDEN_TYPE_POTTOT
,
vacuum
%
nmzd
,
vacuum
%
nmzxyd
,
stars
%
ng2
)
ALLOCATE
(
aVec
(
i
)
%
pw_w
,
mold
=
aVec
(
i
)
%
pw
)
DO
itype
=
1
,
atoms
%
ntype
DO
ir
=
1
,
atoms
%
jri
(
itype
)
IF
(
factor
==
2.0
)
THEN
r2
=
atoms
%
rmsh
(
ir
,
itype
)
**
2
END
IF
aVec
(
i
)
%
mt
(
ir
,
0
:,
itype
,:)
=
dummyDen
(
i
+1
)
%
mt
(
ir
,
0
:,
itype
,:)
*
r2
END
DO
!ir
END
DO
!itype
aVec
(
i
)
%
pw
(
1
:,:)
=
dummyDen
(
i
+1
)
%
pw
(
1
:,:)
aVec
(
i
)
%
vacz
(
1
:,
1
:,:)
=
dummyDen
(
i
+1
)
%
vacz
(
1
:,
1
:,:)
aVec
(
i
)
%
vacxy
(
1
:,
1
:,
1
:,:)
=
dummyDen
(
i
+1
)
%
vacxy
(
1
:,
1
:,
1
:,:)
END
DO
!i
END
SUBROUTINE
make
Bxc
END
SUBROUTINE
make
VectorField
SUBROUTINE
sourcefree
(
mpi
,
dimension
,
field
,
stars
,
atoms
,
sphhar
,
vacuum
,
input
,
oneD
,
sym
,
cell
,
noco
,
bxc
)
USE
m_vgen_coulomb
...
...
@@ -87,6 +93,9 @@ CONTAINS
! b) Solve the Poisson equation (nabla_vec*nabla_vec)phi=-4*pi*d.
! c) Construct an auxiliary vector field C_vec=(nabla_vec phi)/(4*pi).
! d) Build A_vec_sf=A_vec+C_vec, which is source free by construction.
!
! Note: A_vec is assumed to be a density with an additional factor of r^2.
! A field of the same form will also be calculated.
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
...
...
@@ -100,12 +109,12 @@ CONTAINS
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
IN
)
::
bxc
TYPE
(
t_potden
),
DIMENSION
(
3
),
INTENT
(
IN
OUT
)
::
bxc
TYPE
(
t_atoms
)
::
atloc
TYPE
(
t_potden
)
::
div
,
phi
,
checkdiv
TYPE
(
t_potden
),
DIMENSION
(
3
)
::
cvec
,
corrB
INTEGER
::
n
,
jr
INTEGER
::
n
,
jr
,
lh
,
lhmax
CALL
div
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
&
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
POTDEN_TYPE_DEN
,
&
...
...
@@ -113,33 +122,41 @@ CONTAINS
ALLOCATE
(
div
%
pw_w
,
mold
=
div
%
pw
)
CALL
divergence
(
stars
,
atoms
,
sphhar
,
vacuum
,
sym
,
cell
,
noco
,
bxc
,
div
)
div
%
mt
(:,
2
:,:,:)
=
0.0
div
%
mt
(:,
0
,:,:)
=
0.0
atloc
=
atoms
atloc
%
zatom
=
0.0
atloc
%
zatom
=
0.0
!Local atoms variable with no charges; needed for the potential generation.
eps
=
1.e-10
CALL
phi
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
POTDEN_TYPE_POTCOUL
,
vacuum
%
nmzd
,
vacuum
%
nmzxyd
,
stars
%
ng2
)
ALLOCATE
(
phi
%
pw_w
(
SIZE
(
phi
%
pw
,
1
),
size
(
phi
%
pw
,
2
)))
phi
%
pw_w
=
CMPLX
(
0.0
,
0.0
)
CALL
vgen_coulomb
(
1
,
mpi
,
dimension
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
sphhar
,
atloc
,
div
,
phi
)
DO
n
=
1
,
atoms
%
ntype
CALL
vgen_coulomb
(
1
,
mpi
,
dimension
,
oneD
,
input
,
field
,
vacuum
,
sym
,
stars
,
cell
,
sphhar
,
atloc
,
.TRUE.
,
div
,
phi
)
DO
n
=
1
,
atoms
%
ntype
lhmax
=
sphhar
%
nlh
(
atoms
%
ntypsy
(
SUM
(
atoms
%
neq
(:
n
-
1
))
+
1
))
DO
lh
=
0
,
lhmax
phi
%
mt
(:,
lh
,
n
,
1
)
=
phi
%
mt
(:,
lh
,
n
,
1
)
*
atoms
%
rmsh
(:,
n
)
**
2
DO
jr
=
1
,
atoms
%
jri
(
n
)
DO
lh
=
0
,
lhmax
!IF (ABS(phi%mt(jr,lh,n,1))<eps) THEN
IF
(
lh
/
=
1
)
THEN
phi
%
mt
(
jr
,
lh
,
n
,:)
=
0.0
END
IF
END
DO
END
DO
END
DO
DO
i
=
1
,
3
CALL
cvec
(
i
)
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
POTDEN_TYPE_
POTTOT
,
vacuum
%
nmzd
,
vacuum
%
nmzxyd
,
stars
%
ng2
)
CALL
cvec
(
i
)
%
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
(
cvec
(
i
)
%
pw_w
,
mold
=
cvec
(
i
)
%
pw
)
ENDDO
CALL
divpotgrad
(
stars
,
atoms
,
sphhar
,
vacuum
,
sym
,
cell
,
noco
,
phi
,
cvec
)
DO
i
=
1
,
3
CALL
corrB
(
i
)
%
init_potden_simple
(
stars
%
ng3
,
atoms
%
jmtd
,
sphhar
%
nlhd
,
atoms
%
ntype
,
atoms
%
n_u
,
1
,
.FALSE.
,
.FALSE.
,
POTDEN_TYPE_
POTTOT
,
vacuum
%
nmzd
,
vacuum
%
nmzxyd
,
stars
%
ng2
)
CALL
corrB
(
i
)
%
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
(
corrB
(
i
)
%
pw_w
,
mold
=
corrB
(
i
)
%
pw
)
CALL
corrB
(
i
)
%
addPotDen
(
bxc
(
i
),
cvec
(
i
))
ENDDO
...
...
@@ -151,9 +168,9 @@ CONTAINS
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), 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
),
checkdiv
)
END
SUBROUTINE
sourcefree
...
...
@@ -226,9 +243,9 @@ CONTAINS
!print *, th/pi_const
!print *, ph/pi_const
!(r/atoms%rmt(n))
A_temp
(
kt
+
k
,
1
,
1
)
=
(
r
**
2
)
*
r
*
SIN
(
th
)
*
COS
(
ph
)
A_temp
(
kt
+
k
,
2
,
1
)
=
(
r
**
2
)
*
r
*
SIN
(
th
)
*
SIN
(
ph
)
A_temp
(
kt
+
k
,
3
,
1
)
=
(
r
**
2
)
*
r
*
COS
(
th
)
A_temp
(
kt
+
k
,
1
,
1
)
=
(
r
**
2
)
*
r
*
*
2
!*
SIN(th)*COS(ph)
A_temp
(
kt
+
k
,
2
,
1
)
=
(
r
**
2
)
*
r
*
*
2
!*
SIN(th)*SIN(ph)
A_temp
(
kt
+
k
,
3
,
1
)
=
(
r
**
2
)
*
r
*
*
2
!*
COS(th)
ENDDO
! k
kt
=
kt
+
nsp
END
DO
! ir
...
...
@@ -286,10 +303,6 @@ CONTAINS
END
DO
END
DO
!z-loop
!DO i=1,ifftxc3
!A_temp(i,:,:)=0.5
!END DO
DO
i
=
1
,
3
CALL
pw_from_grid
(
.TRUE.
,
stars
,
.TRUE.
,
A_temp
(:,
i
,:),
Avec
(
i
)
%
pw
,
Avec
(
i
)
%
pw_w
)
END
DO
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment