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
e89fd760
Commit
e89fd760
authored
Apr 16, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Introduce new genMTBasis subroutine
parent
0304c478
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
95 additions
and
77 deletions
+95
-77
cdn/cdnval.F90
cdn/cdnval.F90
+18
-41
eigen/tlmplm_cholesky.F90
eigen/tlmplm_cholesky.F90
+9
-32
global/CMakeLists.txt
global/CMakeLists.txt
+1
-0
global/genMTBasis.f90
global/genMTBasis.f90
+57
-0
types/types_usdus.F90
types/types_usdus.F90
+10
-4
No files found.
cdn/cdnval.F90
View file @
e89fd760
...
...
@@ -46,8 +46,7 @@ CONTAINS
!
USE
m_constants
USE
m_eig66_io
,
ONLY
:
write_dos
USE
m_radfun
USE
m_radflo
USE
m_genMTBasis
USE
m_rhomt
USE
m_rhonmt
USE
m_rhomtlo
...
...
@@ -124,19 +123,16 @@ CONTAINS
! .. Local Scalars ..
TYPE
(
t_lapw
)::
lapw
INTEGER
::
llpd
REAL
wronk
INTEGER
i
,
ie
,
iv
,
ivac
,
j
,
k
,
l
,
n
,
ilo
,
isp
,&
nbands
,
no
ded
,
nodeu
,
no
ccbd
,
nslibd
,
na
,&
nbands
,
noccbd
,
nslibd
,
na
,&
ikpt
,
jsp_start
,
jsp_end
,
ispin
INTEGER
skip_t
,
skip_tt
INTEGER
n_size
,
i_rec
,
n_rank
,
ncored
,
n_start
,
n_end
,
noccbd_l
,
nbasfcn
LOGICAL
l_fmpl
,
l_evp
,
l_orbcomprot
,
l_real
LOGICAL
l_fmpl
,
l_evp
,
l_orbcomprot
,
l_real
,
l_write
! ...Local Arrays ..
INTEGER
n_bands
(
0
:
dimension
%
neigd
)
REAL
eig
(
dimension
%
neigd
)
REAL
vz0
(
2
)
REAL
uuilon
(
atoms
%
nlod
,
atoms
%
ntype
),
duilon
(
atoms
%
nlod
,
atoms
%
ntype
)
REAL
ulouilopn
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
!orbcomp
REAL
,
ALLOCATABLE
::
orbcomp
(:,:,:),
qmtp
(:,:)
...
...
@@ -251,22 +247,24 @@ CONTAINS
na
=
1
ncored
=
0
l_write
=
input
%
cdinf
.AND.
mpi
%
irank
==
0
ALLOCATE
(
flo
(
atoms
%
jmtd
,
2
,
atoms
%
nlod
,
dimension
%
jspd
)
)
DO
n
=
1
,
atoms
%
ntype
IF
(
input
%
cdinf
.AND.
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=
8001
)
n
DO
l
=
0
,
atoms
%
lmax
(
n
)
DO
ispin
=
jsp_start
,
jsp_end
CALL
radfun
(
l
,
n
,
ispin
,
enpara
%
el0
(
l
,
n
,
ispin
),
vTot
%
mt
(
1
,
0
,
n
,
ispin
),
atoms
,&
f
(
1
,
1
,
l
,
ispin
),
g
(
1
,
1
,
l
,
ispin
),
usdus
,
nodeu
,
noded
,
wronk
)
IF
(
input
%
cdinf
.AND.
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=
8002
)
l
,&
enpara
%
el0
(
l
,
n
,
ispin
),
usdus
%
us
(
l
,
n
,
ispin
),
usdus
%
dus
(
l
,
n
,
ispin
),
nodeu
,&
usdus
%
uds
(
l
,
n
,
ispin
),
usdus
%
duds
(
l
,
n
,
ispin
),
noded
,
usdus
%
ddn
(
l
,
n
,
ispin
),&
wronk
END
DO
IF
(
noco
%
l_mperp
)
THEN
CALL
int_21
(
f
,
g
,
atoms
,
n
,
l
,
denCoeffsOffdiag
)
END
IF
DO
ispin
=
jsp_start
,
jsp_end
CALL
genMTBasis
(
atoms
,
enpara
,
vTot
,
mpi
,
n
,
ispin
,
l_write
,
usdus
,
f
(:,:,
0
:,
ispin
),
g
(:,:,
0
:,
ispin
),
flo
(:,:,:,
ispin
))
END
DO
IF
(
noco
%
l_mperp
)
THEN
DO
l
=
0
,
atoms
%
lmax
(
n
)
CALL
int_21
(
f
,
g
,
atoms
,
n
,
l
,
denCoeffsOffdiag
)
END
DO
DO
ilo
=
1
,
atoms
%
nlo
(
n
)
CALL
int_21lo
(
f
,
g
,
atoms
,
n
,
flo
,
ilo
,
denCoeffsOffdiag
)
END
DO
END
IF
IF
(
banddos
%
l_mcd
)
THEN
CALL
mcd_init
(
atoms
,
input
,
dimension
,
vTot
%
mt
(:,
0
,:,:),
g
,
f
,
mcd
,
n
,
jspin
)
ncored
=
max
(
mcd
%
ncore
(
n
),
ncored
)
...
...
@@ -276,30 +274,9 @@ CONTAINS
input
%
jspins
,
jspin
,
results
%
ef
,&
dimension
%
msh
,
vTot
%
mt
(:,
0
,:,:),
f
,
g
)
!---> generate the extra wavefunctions for the local orbitals,
!---> if there are any.
IF
(
atoms
%
nlo
(
n
)
>
0
)
THEN
DO
ispin
=
jsp_start
,
jsp_end
CALL
radflo
(
atoms
,
n
,
ispin
,
enpara
%
ello0
(
1
,
1
,
ispin
),
vTot
%
mt
(:,
0
,
n
,
ispin
),
f
(
1
,
1
,
0
,
ispin
),&
g
(
1
,
1
,
0
,
ispin
),
mpi
,
usdus
,
uuilon
,
duilon
,
ulouilopn
,
flo
(:,:,:,
ispin
))
END
DO
END
IF
DO
ilo
=
1
,
atoms
%
nlo
(
n
)
IF
(
noco
%
l_mperp
)
THEN
CALL
int_21lo
(
f
,
g
,
atoms
,
n
,
flo
,
ilo
,
denCoeffsOffdiag
)
END
IF
END
DO
na
=
na
+
atoms
%
neq
(
n
)
END
DO
DEALLOCATE
(
flo
)
8001
FORMAT
(
1x
,
/
,
/
,
' wavefunction parameters for atom type'
,
i3
,
':'
,
/
,
&
t32
,
'radial function'
,
t79
,
'energy derivative'
,
/
,
t3
,
'l'
,
t8
,
&
'energy'
,
t26
,
'value'
,
t39
,
'derivative'
,
t53
,
'nodes'
,
t68
,
&
'value'
,
t81
,
'derivative'
,
t95
,
'nodes'
,
t107
,
'norm'
,
t119
,
&
'wronskian'
)
8002
FORMAT
(
i3
,
f10.5
,
2
(
5x
,
1p
,
2e16.7
,
i5
),
1p
,
2e16.7
)
IF
(
input
%
film
)
vz0
(:)
=
vTot
%
vacz
(
vacuum
%
nmz
,:,
jspin
)
...
...
eigen/tlmplm_cholesky.F90
View file @
e89fd760
...
...
@@ -12,8 +12,7 @@ MODULE m_tlmplm_cholesky
jspin
,
jsp
,
mpi
,
v
,
input
,
td
,
ud
)
USE
m_intgr
,
ONLY
:
intgr3
USE
m_radflo
USE
m_radfun
USE
m_genMTBasis
USE
m_tlo
USE
m_gaunt
,
ONLY
:
gaunt1
,
gaunt2
USE
m_types
...
...
@@ -37,9 +36,9 @@ MODULE m_tlmplm_cholesky
! .. Local Scalars ..
COMPLEX
cil
COMPLEX
,
PARAMETER
::
ci
=
cmplx
(
0.
,
1.
)
REAL
temp
,
wronk
REAL
temp
INTEGER
i
,
l
,
l2
,
lamda
,
lh
,
lm
,
lmin
,
lmin0
,
lmp
,
lmpl
,
lmplm
,
lmx
,
lmxx
,
lp
,
info
,
in
INTEGER
lp1
,
lpl
,
mem
,
mems
,
mp
,
mu
,
n
,
nh
,
n
oded
,
nodeu
,
n
a
,
m
,
nsym
,
s
,
i_u
INTEGER
lp1
,
lpl
,
mem
,
mems
,
mp
,
mu
,
n
,
nh
,
na
,
m
,
nsym
,
s
,
i_u
LOGICAL
l_write
,
OK
! ..
! .. Local Arrays ..
...
...
@@ -50,8 +49,6 @@ MODULE m_tlmplm_cholesky
REAL
uvu
(
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+3
)/
2
,
0
:
sphhar
%
nlhd
)
REAL
f
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
),
g
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
),
x
(
atoms
%
jmtd
)
REAL
flo
(
atoms
%
jmtd
,
2
,
atoms
%
nlod
)
REAL
uuilon
(
atoms
%
nlod
,
atoms
%
ntype
),
duilon
(
atoms
%
nlod
,
atoms
%
ntype
)
REAL
ulouilopn
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
)
INTEGER
::
indt
(
0
:
SIZE
(
td
%
tuu
,
1
)
-1
)
!for constraint
...
...
@@ -83,10 +80,10 @@ MODULE m_tlmplm_cholesky
!$ l_write=.false.
!$ call gaunt2(atoms%lmaxd)
!$OMP PARALLEL DO DEFAULT(NONE)&
!$OMP PRIVATE(indt,dvd,dvu,uvd,uvu,f,g,x,flo
,uuilon,duilon,ulouilopn
)&
!$OMP PRIVATE(cil,temp,
wronk,
i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl)&
!$OMP PRIVATE(lmplm,lmx,lmxx,lp,lp1,lpl,m,mem,mems,mp,mu,n,nh
,noded
)&
!$OMP PRIVATE(n
odeu,n
sym,na,OK,s,in,info,c)&
!$OMP PRIVATE(indt,dvd,dvu,uvd,uvu,f,g,x,flo)&
!$OMP PRIVATE(cil,temp,i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl)&
!$OMP PRIVATE(lmplm,lmx,lmxx,lp,lp1,lpl,m,mem,mems,mp,mu,n,nh)&
!$OMP PRIVATE(nsym,na,OK,s,in,info,c)&
!$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,l_write,v,mpi,input,vr0)&
!$OMP SHARED(noco,uun21,udn21,dun21,ddn21)
DO
n
=
1
,
atoms
%
ntype
...
...
@@ -99,27 +96,7 @@ MODULE m_tlmplm_cholesky
!
!---> generate the wavefunctions for each l
!
IF
(
l_write
)
WRITE
(
6
,
FMT
=
8000
)
n
DO
l
=
0
,
atoms
%
lmax
(
n
)
CALL
radfun
(
l
,
n
,
jspin
,
enpara
%
el0
(
l
,
n
,
jspin
),
v
%
mt
(:,
0
,
n
,
jsp
),
atoms
,&
f
(
1
,
1
,
l
),
g
(
1
,
1
,
l
),
ud
,
nodeu
,
noded
,
wronk
)
IF
(
l_write
)
WRITE
(
6
,
FMT
=
8010
)
l
,
enpara
%
el0
(
l
,
n
,
jspin
),
ud
%
us
(
l
,
n
,
jspin
),&
ud
%
dus
(
l
,
n
,
jspin
),
nodeu
,
ud
%
uds
(
l
,
n
,
jspin
),
ud
%
duds
(
l
,
n
,
jspin
),
noded
,
ud
%
ddn
(
l
,
n
,
jspin
),
wronk
END
DO
8000
FORMAT
(
1x
,
/
,
/
,
' wavefunction parameters for atom type'
,
i3
,
':'
,
&
/
,
t32
,
'radial function'
,
t79
,
'energy derivative'
,
/
,
t3
,
&
'l'
,
t8
,
'energy'
,
t26
,
'value'
,
t39
,
'derivative'
,
t53
,
&
'nodes'
,
t68
,
'value'
,
t81
,
'derivative'
,
t95
,
'nodes'
,
t107
,
&
'norm'
,
t119
,
'wronskian'
)
8010
FORMAT
(
i3
,
f10.5
,
2
(
5x
,
1p
,
2e16.7
,
i5
),
1p
,
2e16.7
)
!
!---> generate the extra wavefunctions for the local orbitals,
!---> if there are any.
!
IF
(
atoms
%
nlo
(
n
)
.GE.
1
)
THEN
CALL
radflo
(
atoms
,
n
,
jspin
,
enpara
%
ello0
(
1
,
1
,
jspin
),
v
%
mt
(:,
0
,
n
,
jsp
),
f
,
g
,
mpi
,&
ud
,
uuilon
,
duilon
,
ulouilopn
,
flo
)
END
IF
CALL
genMTBasis
(
atoms
,
enpara
,
v
,
mpi
,
n
,
jspin
,
l_write
,
ud
,
f
,
g
,
flo
)
nsym
=
atoms
%
ntypsy
(
na
)
nh
=
sphhar
%
nlh
(
nsym
)
...
...
@@ -332,7 +309,7 @@ MODULE m_tlmplm_cholesky
!---> if there are any
IF
(
atoms
%
nlo
(
n
)
.GE.
1
)
THEN
CALL
tlo
(
atoms
,
sphhar
,
jspin
,
jsp
,
n
,
enpara
,
1
,
input
,
v
%
mt
(
1
,
0
,
n
,
jsp
),&
na
,
flo
,
f
,
g
,
ud
,
u
uilon
,
duilon
,
ulouilopn
,
td
)
na
,
flo
,
f
,
g
,
ud
,
u
d
%
uuilon
(:,:,
jspin
),
ud
%
duilon
(:,:,
jspin
),
ud
%
ulouilopn
(:,:,:,
jspin
)
,
td
)
ENDIF
...
...
global/CMakeLists.txt
View file @
e89fd760
...
...
@@ -21,6 +21,7 @@ set(fleur_F90 ${fleur_F90}
global/constants.f90
global/checkdop.F90
global/checkdopall.f90
global/genMTBasis.f90
global/chkmt.f90
global/convn.f90
global/phasy1.f90
...
...
global/genMTBasis.f90
0 → 100644
View file @
e89fd760
MODULE
m_genMTBasis
CONTAINS
SUBROUTINE
genMTBasis
(
atoms
,
enpara
,
vTot
,
mpi
,
iType
,
jspin
,
l_write
,
usdus
,
f
,
g
,
flo
)
USE
m_types
USE
m_radfun
USE
m_radflo
IMPLICIT
NONE
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_enpara
),
INTENT
(
IN
)
::
enpara
TYPE
(
t_potden
),
INTENT
(
IN
)
::
vTot
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_usdus
),
INTENT
(
INOUT
)
::
usdus
INTEGER
,
INTENT
(
IN
)
::
iType
INTEGER
,
INTENT
(
IN
)
::
jspin
LOGICAL
,
INTENT
(
IN
)
::
l_write
REAL
,
INTENT
(
INOUT
)
::
f
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
)
REAL
,
INTENT
(
INOUT
)
::
g
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
)
REAL
,
INTENT
(
INOUT
)
::
flo
(
atoms
%
jmtd
,
2
,
atoms
%
nlod
)
INTEGER
::
l
,
nodeu
,
noded
REAL
::
wronk
IF
(
l_write
)
WRITE
(
6
,
FMT
=
8000
)
iType
DO
l
=
0
,
atoms
%
lmax
(
iType
)
CALL
radfun
(
l
,
iType
,
jspin
,
enpara
%
el0
(
l
,
iType
,
jspin
),
vTot
%
mt
(:,
0
,
iType
,
jspin
),
atoms
,&
f
(
1
,
1
,
l
),
g
(
1
,
1
,
l
),
usdus
,
nodeu
,
noded
,
wronk
)
IF
(
l_write
)
THEN
WRITE
(
6
,
FMT
=
8010
)
l
,
enpara
%
el0
(
l
,
iType
,
jspin
),
usdus
%
us
(
l
,
iType
,
jspin
),
usdus
%
dus
(
l
,
iType
,
jspin
),&
nodeu
,
usdus
%
uds
(
l
,
iType
,
jspin
),
usdus
%
duds
(
l
,
iType
,
jspin
),
noded
,
usdus
%
ddn
(
l
,
iType
,
jspin
),
wronk
END
IF
END
DO
! Generate the extra wavefunctions for the local orbitals, if there are any.
IF
(
atoms
%
nlo
(
iType
)
.GE.
1
)
THEN
CALL
radflo
(
atoms
,
iType
,
jspin
,
enpara
%
ello0
(
1
,
1
,
jspin
),
vTot
%
mt
(:,
0
,
iType
,
jspin
),
f
,
g
,
mpi
,&
usdus
,
usdus
%
uuilon
(
1
,
1
,
jspin
),
usdus
%
duilon
(
1
,
1
,
jspin
),
usdus
%
ulouilopn
(
1
,
1
,
1
,
jspin
),
flo
)
END
IF
8000
FORMAT
(
1x
,
/
,
/
,
' wavefunction parameters for atom type'
,
i3
,
':'
,
&
/
,
t32
,
'radial function'
,
t79
,
'energy derivative'
,
/
,
t3
,
&
'l'
,
t8
,
'energy'
,
t26
,
'value'
,
t39
,
'derivative'
,
t53
,
&
'nodes'
,
t68
,
'value'
,
t81
,
'derivative'
,
t95
,
'nodes'
,
t107
,
&
'norm'
,
t119
,
'wronskian'
)
8010
FORMAT
(
i3
,
f10.5
,
2
(
5x
,
1p
,
2e16.7
,
i5
),
1p
,
2e16.7
)
END
SUBROUTINE
genMTBasis
END
MODULE
m_genMTBasis
types/types_usdus.F90
View file @
e89fd760
...
...
@@ -14,8 +14,11 @@ MODULE m_types_usdus
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
ulos
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
dulos
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
uulon
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
dulon
!(nlod,ntype,jspd)
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:,:)
::
uloulopn
! (nlod,nlod,ntypd,jspd)
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
dulon
! (nlod,ntype,jspd)
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:,:)
::
uloulopn
! (nlod,nlod,ntypd,jspd)
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
uuilon
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:)
::
duilon
! (nlod,ntype,jspd)
REAL
,
ALLOCATABLE
,
DIMENSION
(:,:,:,:)
::
ulouilopn
! (nlod,nlod,ntypd,jspd)
CONTAINS
PROCEDURE
::
init
=>
usdus_init
END
TYPE
t_usdus
...
...
@@ -31,7 +34,7 @@ CONTAINS
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
INTEGER
,
INTENT
(
IN
)
::
jsp
INTEGER
::
err
(
1
0
)
INTEGER
::
err
(
1
3
)
ALLOCATE
(
ud
%
uloulopn
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
1
)
)
ALLOCATE
(
ud
%
ddn
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
2
)
)
ALLOCATE
(
ud
%
us
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
3
))
...
...
@@ -40,8 +43,11 @@ CONTAINS
ALLOCATE
(
ud
%
duds
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
6
))
ALLOCATE
(
ud
%
ulos
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
7
))
ALLOCATE
(
ud
%
dulos
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
8
)
)
ALLOCATE
(
ud
%
uulon
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
9
))
ALLOCATE
(
ud
%
uulon
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
9
))
ALLOCATE
(
ud
%
dulon
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
)
,
stat
=
err
(
10
))
ALLOCATE
(
ud
%
uuilon
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
11
))
ALLOCATE
(
ud
%
duilon
(
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
12
))
ALLOCATE
(
ud
%
ulouilopn
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
,
jsp
),
stat
=
err
(
13
))
IF
(
ANY
(
err
>
0
))
CALL
judft_error
(
"Not enough memory allocating usdus datatype"
)
...
...
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