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
52
Issues
52
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
e5456adc
Commit
e5456adc
authored
Oct 12, 2016
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' of fleur-git:fleur into develop
Conflicts: eigen/hsmt_sph.F90
parents
475e6968
5c6dc2c0
Changes
22
Hide whitespace changes
Inline
Side-by-side
Showing
22 changed files
with
438 additions
and
408 deletions
+438
-408
cdn/cdnval.F90
cdn/cdnval.F90
+34
-26
cdn/pwden.F90
cdn/pwden.F90
+27
-27
cdn/q_int_sl.F90
cdn/q_int_sl.F90
+9
-10
cdn/vacden.F90
cdn/vacden.F90
+19
-20
cdn_mt/abclocdn.F90
cdn_mt/abclocdn.F90
+12
-13
cdn_mt/abclocdn_pulay.F90
cdn_mt/abclocdn_pulay.F90
+12
-13
cdn_mt/abcof.F90
cdn_mt/abcof.F90
+10
-11
diagonalization/eigen_diag.F90
diagonalization/eigen_diag.F90
+34
-33
diagonalization/franza.F90
diagonalization/franza.F90
+47
-47
dos/sympsi.F90
dos/sympsi.F90
+14
-14
eigen/eigen.F90
eigen/eigen.F90
+29
-26
eigen/hsint.F90
eigen/hsint.F90
+27
-28
eigen/hsmt.F90
eigen/hsmt.F90
+16
-17
eigen/hsmt_sph.F90
eigen/hsmt_sph.F90
+44
-44
eigen/hsvac.F90
eigen/hsvac.F90
+20
-21
eigen/od_hsvac.F90
eigen/od_hsvac.F90
+20
-21
eigen_secvar/aline.F90
eigen_secvar/aline.F90
+21
-21
eigen_soc/hsohelp.F90
eigen_soc/hsohelp.F90
+16
-3
force/to_pulay.F90
force/to_pulay.F90
+9
-10
global/types.F90
global/types.F90
+13
-0
io/xmlOutput.F90
io/xmlOutput.F90
+3
-1
mpi/mingeselle.F90
mpi/mingeselle.F90
+2
-2
No files found.
cdn/cdnval.F90
View file @
e5456adc
...
...
@@ -164,8 +164,6 @@ CONTAINS
INTEGER
,
ALLOCATABLE
::
gvac1d
(:),
gvac2d
(:)
,
kveclo
(:)
INTEGER
,
ALLOCATABLE
::
jsym
(:),
ksym
(:)
COMPLEX
,
ALLOCATABLE
::
z_c
(:,:)
REAL
,
ALLOCATABLE
::
z_r
(:,:)
REAL
,
ALLOCATABLE
::
aclo
(:,:,:),
acnmt
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
bclo
(:,:,:),
bcnmt
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
cclo
(:,:,:,:),
ccnmt
(:,:,:,:,:),
we
(:)
...
...
@@ -192,7 +190,8 @@ CONTAINS
TYPE
(
t_orblo
),
ALLOCATABLE
::
orblo
(:,:,:,:,:)
TYPE
(
t_mt21
),
ALLOCATABLE
::
mt21
(:,:)
TYPE
(
t_lo21
),
ALLOCATABLE
::
lo21
(:,:)
TYPE
(
t_usdus
)::
usdus
TYPE
(
t_usdus
)
::
usdus
TYPE
(
t_zMat
)
::
zMat
LOGICAL
::
l_real
l_real
=
sym
%
invs
.or.
noco
%
l_soc
...
...
@@ -521,24 +520,33 @@ CONTAINS
n_end
=
noccbd
END
IF
END
IF
zMat
%
l_real
=
l_real
IF
(
l_real
)
THEN
IF
(
.NOT.
ALLOCATED
(
z_r
))
ALLOCATE
(
z_r
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
z_r
=
0
IF
(
.NOT.
ALLOCATED
(
zMat
%
z_r
))
THEN
ALLOCATE
(
zMat
%
z_r
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
zMat
%
nbasfcn
=
dimension
%
nbasfcn
zMat
%
nbands
=
dimension
%
neigd
END
IF
zMat
%
z_r
=
0
CALL
cdn_read
(&
eig_id
,
dimension
%
nvd
,
dimension
%
jspd
,
mpi
%
irank
,
mpi
%
isize
,&
ikpt
,
jspin
,
dimension
%
nbasfcn
,
noco
%
l_ss
,
noco
%
l_noco
,&
noccbd
,
n_start
,
n_end
,&
lapw
%
nmat
,
lapw
%
nv
,
ello
,
evdu
,
epar
,
kveclo
,&
lapw
%
k1
,
lapw
%
k2
,
lapw
%
k3
,
bkpt
,
wk
,
nbands
,
eig
,
z_r
)
lapw
%
k1
,
lapw
%
k2
,
lapw
%
k3
,
bkpt
,
wk
,
nbands
,
eig
,
z
Mat
%
z
_r
)
ELSE
IF
(
.NOT.
ALLOCATED
(
z_c
))
ALLOCATE
(
z_c
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
z_c
=
0
IF
(
.NOT.
ALLOCATED
(
zMat
%
z_c
))
THEN
ALLOCATE
(
zMat
%
z_c
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
zMat
%
nbasfcn
=
dimension
%
nbasfcn
zMat
%
nbands
=
dimension
%
neigd
END
IF
zMat
%
z_c
=
0
CALL
cdn_read
(&
eig_id
,
dimension
%
nvd
,
dimension
%
jspd
,
mpi
%
irank
,
mpi
%
isize
,&
ikpt
,
jspin
,
dimension
%
nbasfcn
,
noco
%
l_ss
,
noco
%
l_noco
,&
noccbd
,
n_start
,
n_end
,&
lapw
%
nmat
,
lapw
%
nv
,
ello
,
evdu
,
epar
,
kveclo
,&
lapw
%
k1
,
lapw
%
k2
,
lapw
%
k3
,
bkpt
,
wk
,
nbands
,
eig
,
z_c
)
lapw
%
k1
,
lapw
%
k2
,
lapw
%
k3
,
bkpt
,
wk
,
nbands
,
eig
,
z
Mat
%
z
_c
)
endif
!IF (l_evp.AND.(isize.GT.1)) THEN
! eig(1:noccbd) = eig(n_start:n_end)
...
...
@@ -576,9 +584,9 @@ CONTAINS
eig
(
nslibd
)
=
eig
(
i
)
we
(
nslibd
)
=
we
(
i
)
if
(
l_real
)
THEN
z
_r
(:,
nslibd
)
=
z_r
(:,
i
)
z
Mat
%
z_r
(:,
nslibd
)
=
zMat
%
z_r
(:,
i
)
else
z
_c
(:,
nslibd
)
=
z_c
(:,
i
)
z
Mat
%
z_c
(:,
nslibd
)
=
zMat
%
z_c
(:,
i
)
endif
END
IF
END
DO
...
...
@@ -592,9 +600,9 @@ CONTAINS
eig
(
nslibd
)
=
eig
(
sliceplot
%
nnne
)
we
(
nslibd
)
=
we
(
sliceplot
%
nnne
)
if
(
l_real
)
Then
z
_r
(:,
nslibd
)
=
z_r
(:,
sliceplot
%
nnne
)
z
Mat
%
z_r
(:,
nslibd
)
=
zMat
%
z_r
(:,
sliceplot
%
nnne
)
else
z
_c
(:,
nslibd
)
=
z_c
(:,
sliceplot
%
nnne
)
z
Mat
%
z_c
(:,
nslibd
)
=
zMat
%
z_c
(:,
sliceplot
%
nnne
)
endif
ELSE
DO
i
=
1
,
nbands
...
...
@@ -603,9 +611,9 @@ CONTAINS
eig
(
nslibd
)
=
eig
(
i
)
we
(
nslibd
)
=
we
(
i
)
if
(
l_real
)
THEN
z
_r
(:,
nslibd
)
=
z_r
(:,
i
)
z
Mat
%
z_r
(:,
nslibd
)
=
zMat
%
z_r
(:,
i
)
else
z
_c
(:,
nslibd
)
=
z_c
(:,
i
)
z
Mat
%
z_c
(:,
nslibd
)
=
zMat
%
z_c
(:,
i
)
endif
END
IF
END
DO
...
...
@@ -632,17 +640,17 @@ CONTAINS
IF
(
.NOT.
((
jspin
.EQ.
2
)
.AND.
noco
%
l_noco
))
THEN
CALL
timestart
(
"cdnval: pwden"
)
CALL
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
ikpt
,&
jspin
,
lapw
,
noccbd
,
igq_fft
,
we
,
eig
,
bkpt
,
qpw
,
cdom
,
qis
,
results
%
force
,
f_b8
,
z
_r
,
z_c
,
l_real
)
jspin
,
lapw
,
noccbd
,
igq_fft
,
we
,
eig
,
bkpt
,
qpw
,
cdom
,
qis
,
results
%
force
,
f_b8
,
z
Mat
,
l_real
)
CALL
timestop
(
"cdnval: pwden"
)
END
IF
!+new
!---> charge of each valence state in this k-point of the SBZ
!---> in the layer interstitial region of the film
!
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.EQ.
-3
))
THEN
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.EQ.
-3
))
THEN
IF
(
.NOT.
((
jspin
.EQ.
2
)
.AND.
noco
%
l_noco
))
THEN
CALL
q_int_sl
(
jspin
,
stars
,
atoms
,
sym
,
volsl
,
volintsl
,&
cell
,
noccbd
,
lapw
,
nsl
,
zsl
,
nmtsl
,
oneD
,
qintsl
(:,:),
z
_r
,
z_c
,
l_real
)
cell
,
noccbd
,
lapw
,
nsl
,
zsl
,
nmtsl
,
oneD
,
qintsl
(:,:),
z
Mat
,
l_real
)
!
END
IF
...
...
@@ -654,7 +662,7 @@ CONTAINS
CALL
timestart
(
"cdnval: vacden"
)
CALL
vacden
(
vacuum
,
dimension
,
stars
,
oneD
,
kpts
,
input
,
cell
,
atoms
,
noco
,
banddos
,&
gvac1d
,
gvac2d
,
we
,
ikpt
,
jspin
,
vz
,
vz0
,
noccbd
,
bkpt
,
lapw
,
evac
,
eig
,&
rhtxy
,
rht
,
qvac
,
qvlay
,
qstars
,
cdomvz
,
cdomvxy
,
z
_r
,
z_c
,
l_real
)
rhtxy
,
rht
,
qvac
,
qvlay
,
qstars
,
cdomvz
,
cdomvxy
,
z
Mat
,
l_real
)
CALL
timestop
(
"cdnval: vacden"
)
END
IF
!---> perform Brillouin zone integration and summation over the
...
...
@@ -693,13 +701,13 @@ CONTAINS
cveccof
(
3
,
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
natd
)
)
CALL
to_pulay
(
input
,
atoms
,
noccbd
,
sym
,
lapw
,
noco
,
cell
,
bkpt
,
noccbd
,
eig
,
usdus
,&
kveclo
,
ispin
,
oneD
,
acof
(:,
0
:,:,
ispin
),
bcof
(:,
0
:,:,
ispin
),&
e1cof
,
e2cof
,
aveccof
,
bveccof
,
ccof
(
-
atoms
%
llod
,
1
,
1
,
1
,
ispin
),
acoflo
,
bcoflo
,
cveccof
,
z
_r
,
z_c
,
l_real
)
e1cof
,
e2cof
,
aveccof
,
bveccof
,
ccof
(
-
atoms
%
llod
,
1
,
1
,
1
,
ispin
),
acoflo
,
bcoflo
,
cveccof
,
z
Mat
,
l_real
)
CALL
timestop
(
"cdnval: to_pulay"
)
ELSE
CALL
timestart
(
"cdnval: abcof"
)
CALL
abcof
(
input
,
atoms
,
noccbd
,
sym
,
cell
,
bkpt
,
lapw
,
noccbd
,
usdus
,
noco
,
ispin
,
kveclo
,
oneD
,&
acof
(:,
0
:,:,
ispin
),
bcof
(:,
0
:,:,
ispin
),
ccof
(
-
atoms
%
llod
:,:,:,:,
ispin
),
z
_r
,
z_c
,
l_real
)
acof
(:,
0
:,:,
ispin
),
bcof
(:,
0
:,:,
ispin
),
ccof
(
-
atoms
%
llod
:,:,:,:,
ispin
),
z
Mat
,
l_real
)
CALL
timestop
(
"cdnval: abcof"
)
END
IF
...
...
@@ -828,7 +836,7 @@ CONTAINS
cartk
=
matmul
(
bkpt
,
cell
%
bmat
)
IF
(
banddos
%
ndir
.GT.
0
)
THEN
CALL
sympsi
(
bkpt
,
lapw
%
nv
(
jspin
),
lapw
%
k1
(:,
jspin
),
lapw
%
k2
(:,
jspin
),&
lapw
%
k3
(:,
jspin
),
sym
,
dimension
,
nbands
,
cell
,
eig
,
noco
,
ksym
,
jsym
,
z
_r
,
z_c
,
l_real
)
lapw
%
k3
(:,
jspin
),
sym
,
dimension
,
nbands
,
cell
,
eig
,
noco
,
ksym
,
jsym
,
z
Mat
,
l_real
)
END
IF
!
!--dw now write k-point data to tmp_dos
...
...
@@ -843,10 +851,10 @@ CONTAINS
!---> end of loop over PE's
IF
(
l_real
)
THEN
DEALLOCATE
(
z_r
)
else
DEALLOCATE
(
z_c
)
endif
DEALLOCATE
(
z
Mat
%
z
_r
)
ELSE
DEALLOCATE
(
zMat
%
z_c
)
END
IF
END
IF
! --> end "IF ((mod(i_rec-1,mpi%isize).EQ.mpi%irank).OR.l_evp) THEN"
END
DO
!---> end of k-point loop
DEALLOCATE
(
we
,
f
,
g
,
usdus
%
us
,
usdus
%
dus
,
usdus
%
duds
,
usdus
%
uds
,
usdus
%
ddn
)
...
...
cdn/pwden.F90
View file @
e5456adc
...
...
@@ -7,7 +7,7 @@
MODULE
m_pwden
CONTAINS
SUBROUTINE
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
&
ikpt
,
jspin
,
lapw
,
ne
,
igq_fft
,
we
,
eig
,
bkpt
,
qpw
,
cdom
,
qis
,
forces
,
f_b8
,
z
_r
,
z_c
,
realdata
)
ikpt
,
jspin
,
lapw
,
ne
,
igq_fft
,
we
,
eig
,
bkpt
,
qpw
,
cdom
,
qis
,
forces
,
f_b8
,
z
Mat
,
realdata
)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
...
...
@@ -78,7 +78,7 @@ CONTAINS
USE
m_cfft
USE
m_types
IMPLICIT
NONE
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_banddos
),
INTENT
(
IN
)
::
banddos
...
...
@@ -89,14 +89,14 @@ CONTAINS
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
INTEGER
,
INTENT
(
IN
)
::
igq_fft
(
0
:
stars
%
kq1d
*
stars
%
kq2d
*
stars
%
kq3d
-1
)
REAL
,
INTENT
(
IN
)
::
we
(:)
!(nobd)
REAL
,
INTENT
(
IN
)
::
eig
(:)
!(dimension%neigd)
REAL
,
INTENT
(
IN
)
::
bkpt
(
3
)
!-----> BASIS FUNCTION INFORMATION
INTEGER
,
INTENT
(
IN
)::
ne
COMPLEX
,
OPTIONAL
,
INTENT
(
IN
)
::
z_c
(:,:)
!(dimension%nbasfcn,dimension%neigd)
REAL
,
OPTIONAL
,
INTENT
(
IN
)
::
z_r
(:,:)
!(dimension%nbasfcn,dimension%neigd)
LOGICAL
,
OPTIONAL
,
INTENT
(
IN
)::
realdata
!-----> CHARGE DENSITY INFORMATION
INTEGER
,
INTENT
(
IN
)
::
ikpt
,
jspin
...
...
@@ -138,7 +138,7 @@ CONTAINS
IF
(
PRESENT
(
realdata
))
THEN
l_real
=
realdata
ELSE
l_real
=
PRESENT
(
z_r
)
l_real
=
zMat
%
l_real
ENDIF
!-------> ABBREVIATIONS
...
...
@@ -234,8 +234,8 @@ CONTAINS
q0_22
=
zero
IF
(
.NOT.
l_real
)
THEN
DO
nu
=
1
,
ne
q0_11
=
q0_11
+
we
(
nu
)
*
CPP_BLAS_cdotc
(
lapw
%
nv
(
1
),
z
_c
(
1
,
nu
),
1
,
z_c
(
1
,
nu
),
1
)
q0_22
=
q0_22
+
we
(
nu
)
*
CPP_BLAS_cdotc
(
lapw
%
nv
(
2
),
z
_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+1
,
nu
),
1
,
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+1
,
nu
),
1
)
q0_11
=
q0_11
+
we
(
nu
)
*
CPP_BLAS_cdotc
(
lapw
%
nv
(
1
),
z
Mat
%
z_c
(
1
,
nu
),
1
,
zMat
%
z_c
(
1
,
nu
),
1
)
q0_22
=
q0_22
+
we
(
nu
)
*
CPP_BLAS_cdotc
(
lapw
%
nv
(
2
),
z
Mat
%
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+1
,
nu
),
1
,
zMat
%
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+1
,
nu
),
1
)
ENDDO
ENDIF
q0_11
=
q0_11
/
cell
%
omtil
...
...
@@ -243,11 +243,11 @@ CONTAINS
ELSE
IF
(
l_real
)
THEN
DO
nu
=
1
,
ne
q0
=
q0
+
we
(
nu
)
*
CPP_BLAS_sdot
(
lapw
%
nv
(
jspin
),
z
_r
(
1
,
nu
),
1
,
z_r
(
1
,
nu
),
1
)
q0
=
q0
+
we
(
nu
)
*
CPP_BLAS_sdot
(
lapw
%
nv
(
jspin
),
z
Mat
%
z_r
(
1
,
nu
),
1
,
zMat
%
z_r
(
1
,
nu
),
1
)
ENDDO
ELSE
DO
nu
=
1
,
ne
q0
=
q0
+
we
(
nu
)
*
REAL
(
CPP_BLAS_cdotc
(
lapw
%
nv
(
jspin
),
z
_c
(
1
,
nu
),
1
,
z_c
(
1
,
nu
),
1
))
q0
=
q0
+
we
(
nu
)
*
REAL
(
CPP_BLAS_cdotc
(
lapw
%
nv
(
jspin
),
z
Mat
%
z_c
(
1
,
nu
),
1
,
zMat
%
z_c
(
1
,
nu
),
1
))
ENDDO
ENDIF
q0
=
q0
/
cell
%
omtil
...
...
@@ -317,19 +317,19 @@ CONTAINS
!------> map WF into FFTbox
IF
(
noco
%
l_ss
)
THEN
DO
iv
=
1
,
lapw
%
nv
(
1
)
psi1r
(
iv1d
(
iv
,
1
)
)
=
REAL
(
z_c
(
iv
,
nu
)
)
psi1i
(
iv1d
(
iv
,
1
)
)
=
AIMAG
(
z_c
(
iv
,
nu
)
)
psi1r
(
iv1d
(
iv
,
1
)
)
=
REAL
(
z
Mat
%
z
_c
(
iv
,
nu
)
)
psi1i
(
iv1d
(
iv
,
1
)
)
=
AIMAG
(
z
Mat
%
z
_c
(
iv
,
nu
)
)
ENDDO
DO
iv
=
1
,
lapw
%
nv
(
2
)
psi2r
(
iv1d
(
iv
,
2
)
)
=
REAL
(
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
psi2i
(
iv1d
(
iv
,
2
)
)
=
AIMAG
(
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
psi2r
(
iv1d
(
iv
,
2
)
)
=
REAL
(
z
Mat
%
z
_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
psi2i
(
iv1d
(
iv
,
2
)
)
=
AIMAG
(
z
Mat
%
z
_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
ENDDO
ELSE
DO
iv
=
1
,
lapw
%
nv
(
jspin
)
psi1r
(
iv1d
(
iv
,
jspin
)
)
=
REAL
(
z_c
(
iv
,
nu
)
)
psi1i
(
iv1d
(
iv
,
jspin
)
)
=
AIMAG
(
z_c
(
iv
,
nu
)
)
psi2r
(
iv1d
(
iv
,
jspin
))
=
REAL
(
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
psi2i
(
iv1d
(
iv
,
jspin
))
=
AIMAG
(
z_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
psi1r
(
iv1d
(
iv
,
jspin
)
)
=
REAL
(
z
Mat
%
z
_c
(
iv
,
nu
)
)
psi1i
(
iv1d
(
iv
,
jspin
)
)
=
AIMAG
(
z
Mat
%
z
_c
(
iv
,
nu
)
)
psi2r
(
iv1d
(
iv
,
jspin
))
=
REAL
(
z
Mat
%
z
_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
psi2i
(
iv1d
(
iv
,
jspin
))
=
AIMAG
(
z
Mat
%
z
_c
(
lapw
%
nv
(
1
)
+
atoms
%
nlotot
+
iv
,
nu
))
ENDDO
ENDIF
...
...
@@ -339,12 +339,12 @@ CONTAINS
!------> map WF into FFTbox
IF
(
l_real
)
THEN
DO
iv
=
1
,
lapw
%
nv
(
jspin
)
psir
(
iv1d
(
iv
,
jspin
)
)
=
z_r
(
iv
,
nu
)
psir
(
iv1d
(
iv
,
jspin
)
)
=
z
Mat
%
z
_r
(
iv
,
nu
)
ENDDO
ELSE
DO
iv
=
1
,
lapw
%
nv
(
jspin
)
psir
(
iv1d
(
iv
,
jspin
)
)
=
REAL
(
z_c
(
iv
,
nu
))
psii
(
iv1d
(
iv
,
jspin
)
)
=
AIMAG
(
z_c
(
iv
,
nu
))
psir
(
iv1d
(
iv
,
jspin
)
)
=
REAL
(
z
Mat
%
z
_c
(
iv
,
nu
))
psii
(
iv1d
(
iv
,
jspin
)
)
=
AIMAG
(
z
Mat
%
z
_c
(
iv
,
nu
))
ENDDO
ENDIF
ENDIF
...
...
@@ -388,7 +388,7 @@ CONTAINS
DO
i
=
1
,
3
s
=
s
+
xk
(
i
)
*
cell
%
bmat
(
i
,
j
)
ENDDO
kpsir
(
iv1d
(
iv
,
jspin
)
)
=
s
*
z_r
(
iv
,
nu
)
kpsir
(
iv1d
(
iv
,
jspin
)
)
=
s
*
z
Mat
%
z
_r
(
iv
,
nu
)
ENDDO
CALL
rfft
(
isn
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
+1
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,&
nw1
,
nw2
,
nw3
,
wsave
,
kpsir
(
ifftq3d
),
kpsir
(
-
ifftq2
))
...
...
@@ -421,8 +421,8 @@ CONTAINS
DO
i
=
1
,
3
s
=
s
+
xk
(
i
)
*
cell
%
bmat
(
i
,
j
)
ENDDO
kpsir
(
iv1d
(
iv
,
jspin
)
)
=
s
*
REAL
(
z_c
(
iv
,
nu
))
kpsii
(
iv1d
(
iv
,
jspin
)
)
=
s
*
AIMAG
(
z_c
(
iv
,
nu
))
kpsir
(
iv1d
(
iv
,
jspin
)
)
=
s
*
REAL
(
z
Mat
%
z
_c
(
iv
,
nu
))
kpsii
(
iv1d
(
iv
,
jspin
)
)
=
s
*
AIMAG
(
z
Mat
%
z
_c
(
iv
,
nu
))
ENDDO
CALL
cfft
(
kpsir
,
kpsii
,
ifftq3
,
stars
%
kq1_fft
,
ifftq1
,
isn
)
...
...
@@ -620,12 +620,12 @@ CONTAINS
IF
(
ABS
(
q0
-
REAL
(
cwk
(
1
))
)/
q0
.GT.
tol_3
)
THEN
WRITE
(
99
,
*
)
"XX:"
,
ne
,
lapw
%
nv
IF
(
l_real
)
THEN
DO
istr
=
1
,
SIZE
(
z_r
,
2
)
WRITE
(
99
,
*
)
"X:"
,
istr
,
z_r
(:,
istr
)
DO
istr
=
1
,
SIZE
(
z
Mat
%
z
_r
,
2
)
WRITE
(
99
,
*
)
"X:"
,
istr
,
z
Mat
%
z
_r
(:,
istr
)
ENDDO
ELSE
DO
istr
=
1
,
SIZE
(
z_c
,
2
)
WRITE
(
99
,
*
)
"X:"
,
istr
,
z_c
(:,
istr
)
DO
istr
=
1
,
SIZE
(
z
Mat
%
z
_c
,
2
)
WRITE
(
99
,
*
)
"X:"
,
istr
,
z
Mat
%
z
_c
(:,
istr
)
ENDDO
ENDIF
WRITE
(
6
,
'(
''
bad quality of charge density
''
,2f13.8)'
)
q0
,
REAL
(
cwk
(
1
)
)
...
...
cdn/q_int_sl.F90
View file @
e5456adc
...
...
@@ -2,7 +2,7 @@ MODULE m_qintsl
USE
m_juDFT
CONTAINS
SUBROUTINE
q_int_sl
(
isp
,
stars
,
atoms
,
sym
,
volsl
,
volintsl
,
cell
,&
ne
,
lapw
,
nsl
,
zsl
,
nmtsl
,
oneD
,
qintslk
,
z
_r
,
z_c
,
realdata
)
ne
,
lapw
,
nsl
,
zsl
,
nmtsl
,
oneD
,
qintslk
,
z
Mat
,
realdata
)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
...
...
@@ -20,6 +20,7 @@ CONTAINS
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
!
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
ne
,
isp
,
nsl
...
...
@@ -29,8 +30,6 @@ CONTAINS
REAL
,
INTENT
(
IN
)
::
volintsl
(
atoms
%
natd
)
REAL
,
INTENT
(
IN
)
::
zsl
(
2
,
atoms
%
natd
)
,
volsl
(
atoms
%
natd
)
REAL
,
INTENT
(
OUT
)::
qintslk
(:,:)
!(nsl,dimension%neigd)
REAL
,
OPTIONAL
,
INTENT
(
IN
)
::
z_r
(:,:)
!(dimension%nbasfcn,dimension%neigd)
COMPLEX
,
OPTIONAL
,
INTENT
(
IN
)
::
z_c
(:,:)
LOGICAL
,
OPTIONAL
,
INTENT
(
IN
)
::
realdata
! ..
! .. Local Scalars ..
...
...
@@ -45,7 +44,7 @@ CONTAINS
IF
(
PRESENT
(
realdata
))
THEN
l_real
=
realdata
ELSE
l_real
=
PRESENT
(
z_r
)
l_real
=
zMat
%
l_real
ENDIF
! ..
IF
(
oneD
%
odi
%
d1
)
CALL
juDFT_error
(
"well, does not work with 1D. Not clear how to define a layer."
,
calledby
=
"q_int_sl"
)
...
...
@@ -79,11 +78,11 @@ CONTAINS
q1
=
0.0
IF
(
l_real
)
THEN
DO
i
=
1
,
lapw
%
nv
(
isp
)
q1
=
q1
+
z
_r
(
i
,
n
)
*
z_r
(
i
,
n
)
q1
=
q1
+
z
Mat
%
z_r
(
i
,
n
)
*
zMat
%
z_r
(
i
,
n
)
ENDDO
ELSE
DO
i
=
1
,
lapw
%
nv
(
isp
)
q1
=
q1
+
REAL
(
z
_c
(
i
,
n
)
*
CONJG
(
z_c
(
i
,
n
)))
q1
=
q1
+
REAL
(
z
Mat
%
z_c
(
i
,
n
)
*
CONJG
(
zMat
%
z_c
(
i
,
n
)))
ENDDO
ENDIF
z_z
(
1
)
=
q1
/
cell
%
omtil
...
...
@@ -104,11 +103,11 @@ CONTAINS
phase
=
stars
%
rgphs
(
ix1
,
iy1
,
iz1
)/
(
stars
%
nstr
(
ind
)
*
cell
%
omtil
)
phasep
=
stars
%
rgphs
(
-
ix1
,
-
iy1
,
-
iz1
)/
(
stars
%
nstr
(
indp
)
*
cell
%
omtil
)
IF
(
l_real
)
THEN
z_z
(
ind
)
=
z_z
(
ind
)
+
z
_r
(
j
,
n
)
*
z_r
(
i
,
n
)
*
REAL
(
phase
)
z_z
(
indp
)
=
z_z
(
indp
)
+
z
_r
(
i
,
n
)
*
z_r
(
j
,
n
)
*
REAL
(
phasep
)
z_z
(
ind
)
=
z_z
(
ind
)
+
z
Mat
%
z_r
(
j
,
n
)
*
zMat
%
z_r
(
i
,
n
)
*
REAL
(
phase
)
z_z
(
indp
)
=
z_z
(
indp
)
+
z
Mat
%
z_r
(
i
,
n
)
*
zMat
%
z_r
(
j
,
n
)
*
REAL
(
phasep
)
ELSE
z_z
(
ind
)
=
z_z
(
ind
)
+
z
_c
(
j
,
n
)
*
CONJG
(
z_c
(
i
,
n
))
*
phase
z_z
(
indp
)
=
z_z
(
indp
)
+
z
_c
(
i
,
n
)
*
CONJG
(
z_c
(
j
,
n
))
*
phasep
z_z
(
ind
)
=
z_z
(
ind
)
+
z
Mat
%
z_c
(
j
,
n
)
*
CONJG
(
zMat
%
z_c
(
i
,
n
))
*
phase
z_z
(
indp
)
=
z_z
(
indp
)
+
z
Mat
%
z_c
(
i
,
n
)
*
CONJG
(
zMat
%
z_c
(
j
,
n
))
*
phasep
ENDIF
ENDDO
ENDDO
...
...
cdn/vacden.F90
View file @
e5456adc
...
...
@@ -12,7 +12,7 @@ CONTAINS
we
,
ikpt
,
jspin
,
vz
,
vz0
,&
ne
,
bkpt
,
lapw
,&
evac
,
eig
,
rhtxy
,
rht
,
qvac
,
qvlay
,&
stcoeff
,
cdomvz
,
cdomvxy
,
z
_r
,
z_c
,
realdata
)
stcoeff
,
cdomvz
,
cdomvxy
,
z
Mat
,
realdata
)
!***********************************************************************
! ****** change vacden(....,q) for vacuum density of states shz Jan.96
...
...
@@ -64,6 +64,7 @@ CONTAINS
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
jspin
INTEGER
,
INTENT
(
IN
)
::
ne
...
...
@@ -73,8 +74,6 @@ CONTAINS
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
bkpt
(
3
)
REAL
,
INTENT
(
IN
)
::
evac
(
2
,
DIMENSION
%
jspd
)
COMPLEX
,
OPTIONAL
,
INTENT
(
IN
)::
z_c
(
DIMENSION
%
nbasfcn
,
DIMENSION
%
neigd
)
REAL
,
OPTIONAL
,
INTENT
(
IN
)::
z_r
(
DIMENSION
%
nbasfcn
,
DIMENSION
%
neigd
)
COMPLEX
,
INTENT
(
INOUT
)::
rhtxy
(
vacuum
%
nmzxyd
,
oneD
%
odi
%
n2d
-1
,
2
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)::
rht
(
vacuum
%
nmzd
,
2
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
OUT
)
::
qvlay
(
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkptd
,
DIMENSION
%
jspd
)
...
...
@@ -127,7 +126,7 @@ CONTAINS
IF
(
PRESENT
(
realdata
))
THEN
l_real
=
realdata
ELSE
l_real
=
PRESENT
(
z_r
)
l_real
=
zMat
%
l_real
ENDIF
! ..
...
...
@@ -339,11 +338,11 @@ CONTAINS
t_1
(
l
,
m
)
*
stars
%
sk2
(
irec2
)
*
dbss
(
m
),
0.0
)/&
((
wronk_1
)
*
SQRT
(
cell
%
omtil
))
IF
(
l_real
)
THEN
ac_1
(
l
,
m
,:
ne
,
ispin
)
=
ac_1
(
l
,
m
,:
ne
,
ispin
)
+
z_r
(
kspin
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
ispin
)
=
bc_1
(
l
,
m
,:
ne
,
ispin
)
+
z_r
(
kspin
,:
ne
)
*
bv_1
ac_1
(
l
,
m
,:
ne
,
ispin
)
=
ac_1
(
l
,
m
,:
ne
,
ispin
)
+
zMat
%
z_r
(
kspin
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
ispin
)
=
bc_1
(
l
,
m
,:
ne
,
ispin
)
+
zMat
%
z_r
(
kspin
,:
ne
)
*
bv_1
ELSE
ac_1
(
l
,
m
,:
ne
,
ispin
)
=
ac_1
(
l
,
m
,:
ne
,
ispin
)
+
z_c
(
kspin
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
ispin
)
=
bc_1
(
l
,
m
,:
ne
,
ispin
)
+
z_c
(
kspin
,:
ne
)
*
bv_1
ac_1
(
l
,
m
,:
ne
,
ispin
)
=
ac_1
(
l
,
m
,:
ne
,
ispin
)
+
zMat
%
z_c
(
kspin
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
ispin
)
=
bc_1
(
l
,
m
,:
ne
,
ispin
)
+
zMat
%
z_c
(
kspin
,:
ne
)
*
bv_1
END
IF
END
DO
! -mb:mb
END
IF
...
...
@@ -382,11 +381,11 @@ CONTAINS
bv
=
c_1
*
CMPLX
(
dt
(
l
),
zks
*
t
(
l
)
)
! -----> loop over basis functions
IF
(
l_real
)
THEN
ac
(
l
,:
ne
,
ispin
)
=
ac
(
l
,:
ne
,
ispin
)
+
z_r
(
kspin
,:
ne
)
*
av
bc
(
l
,:
ne
,
ispin
)
=
bc
(
l
,:
ne
,
ispin
)
+
z_r
(
kspin
,:
ne
)
*
bv
ac
(
l
,:
ne
,
ispin
)
=
ac
(
l
,:
ne
,
ispin
)
+
z
Mat
%
z
_r
(
kspin
,:
ne
)
*
av
bc
(
l
,:
ne
,
ispin
)
=
bc
(
l
,:
ne
,
ispin
)
+
z
Mat
%
z
_r
(
kspin
,:
ne
)
*
bv
ELSE
ac
(
l
,:
ne
,
ispin
)
=
ac
(
l
,:
ne
,
ispin
)
+
z_c
(
kspin
,:
ne
)
*
av
bc
(
l
,:
ne
,
ispin
)
=
bc
(
l
,:
ne
,
ispin
)
+
z_c
(
kspin
,:
ne
)
*
bv
ac
(
l
,:
ne
,
ispin
)
=
ac
(
l
,:
ne
,
ispin
)
+
z
Mat
%
z
_c
(
kspin
,:
ne
)
*
av
bc
(
l
,:
ne
,
ispin
)
=
bc
(
l
,:
ne
,
ispin
)
+
z
Mat
%
z
_c
(
kspin
,:
ne
)
*
bv
ENDIF
ENDDO
!---> end of spin loop
...
...
@@ -439,11 +438,11 @@ CONTAINS
t_1
(
l
,
m
)
*
stars
%
sk2
(
irec2
)
*
dbss
(
m
),
0.0
)/&
((
wronk_1
)
*
SQRT
(
cell
%
omtil
))
IF
(
l_real
)
THEN
ac_1
(
l
,
m
,:
ne
,
jspin
)
=
ac_1
(
l
,
m
,:
ne
,
jspin
)
+
z_r
(
k
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
jspin
)
=
bc_1
(
l
,
m
,:
ne
,
jspin
)
+
z_r
(
k
,:
ne
)
*
bv_1
ac_1
(
l
,
m
,:
ne
,
jspin
)
=
ac_1
(
l
,
m
,:
ne
,
jspin
)
+
zMat
%
z_r
(
k
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
jspin
)
=
bc_1
(
l
,
m
,:
ne
,
jspin
)
+
zMat
%
z_r
(
k
,:
ne
)
*
bv_1
ELSE
ac_1
(
l
,
m
,:
ne
,
jspin
)
=
ac_1
(
l
,
m
,:
ne
,
jspin
)
+
z_r
(
k
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
jspin
)
=
bc_1
(
l
,
m
,:
ne
,
jspin
)
+
z_r
(
k
,:
ne
)
*
bv_1
ac_1
(
l
,
m
,:
ne
,
jspin
)
=
ac_1
(
l
,
m
,:
ne
,
jspin
)
+
zMat
%
z_c
(
k
,:
ne
)
*
av_1
bc_1
(
l
,
m
,:
ne
,
jspin
)
=
bc_1
(
l
,
m
,:
ne
,
jspin
)
+
zMat
%
z_c
(
k
,:
ne
)
*
bv_1
ENDIF
END
DO
! -mb:mb
END
IF
...
...
@@ -477,11 +476,11 @@ CONTAINS
bv
=
c_1
*
CMPLX
(
dt
(
l
),
zks
*
t
(
l
)
)
! -----> loop over basis functions
IF
(
l_real
)
THEN
ac
(
l
,:
ne
,
jspin
)
=
ac
(
l
,:
ne
,
jspin
)
+
z_r
(
k
,:
ne
)
*
av
bc
(
l
,:
ne
,
jspin
)
=
bc
(
l
,:
ne
,
jspin
)
+
z_r
(
k
,:
ne
)
*
bv
ac
(
l
,:
ne
,
jspin
)
=
ac
(
l
,:
ne
,
jspin
)
+
z
Mat
%
z
_r
(
k
,:
ne
)
*
av
bc
(
l
,:
ne
,
jspin
)
=
bc
(
l
,:
ne
,
jspin
)
+
z
Mat
%
z
_r
(
k
,:
ne
)
*
bv
ELSE
ac
(
l
,:
ne
,
jspin
)
=
ac
(
l
,:
ne
,
jspin
)
+
z_c
(
k
,:
ne
)
*
av
bc
(
l
,:
ne
,
jspin
)
=
bc
(
l
,:
ne
,
jspin
)
+
z_c
(
k
,:
ne
)
*
bv
ac
(
l
,:
ne
,
jspin
)
=
ac
(
l
,:
ne
,
jspin
)
+
z
Mat
%
z
_c
(
k
,:
ne
)
*
av
bc
(
l
,:
ne
,
jspin
)
=
bc
(
l
,:
ne
,
jspin
)
+
z
Mat
%
z
_c
(
k
,:
ne
)
*
bv
ENDIF
ENDDO
END
IF
! D1
...
...
cdn_mt/abclocdn.F90
View file @
e5456adc
...
...
@@ -21,13 +21,14 @@ MODULE m_abclocdn
!*********************************************************************
CONTAINS
SUBROUTINE
abclocdn
(
atoms
,
sym
,
noco
,
ccchi
,
kspin
,
iintsp
,
con1
,
phase
,
ylm
,&
ntyp
,
na
,
k
,
s
,
nv
,
ne
,
nbasf0
,
alo1
,
blo1
,
clo1
,
kvec
,
nkvec
,
enough
,
acof
,
bcof
,
ccof
,
z
_r
,
z_c
)
ntyp
,
na
,
k
,
s
,
nv
,
ne
,
nbasf0
,
alo1
,
blo1
,
clo1
,
kvec
,
nkvec
,
enough
,
acof
,
bcof
,
ccof
,
z
Mat
)
!
USE
m_types
IMPLICIT
NONE
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
kspin
,
iintsp
...
...
@@ -47,8 +48,6 @@ CONTAINS
COMPLEX
,
INTENT
(
INOUT
)
::
bcof
(:,
0
:,:)
!(nobd,0:dimension%lmd,atoms%natd)
COMPLEX
,
INTENT
(
INOUT
)
::
ccof
(
-
atoms
%
llod
:,:,:,:)
!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%natd)
INTEGER
,
INTENT
(
INOUT
)
::
nkvec
(
atoms
%
nlod
,
atoms
%
natd
)
COMPLEX
,
OPTIONAL
,
INTENT
(
IN
)
::
z_c
(:,:)
!(dimension%nbasfcn,dimension%neigd)
REAL
,
OPTIONAL
,
INTENT
(
IN
)
::
z_r
(:,:)
!(dimension%nbasfcn,dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX
ctmp
,
term1
...
...
@@ -59,7 +58,7 @@ CONTAINS
COMPLEX
clotmp
(
-
atoms
%
llod
:
atoms
%
llod
)
! ..
LOGICAL
::
l_real
l_real
=
PRESENT
(
z_r
)
l_real
=
zMat
%
l_real
! ..
enough
(
na
)
=
.TRUE.
term1
=
con1
*
((
atoms
%
rmt
(
ntyp
)
**
2
)/
2
)
*
phase
...
...
@@ -89,15 +88,15 @@ CONTAINS
!+gu_con
IF
(
noco
%
l_noco
)
THEN
IF
(
noco
%
l_ss
)
THEN
ctmp
=
clotmp
(
m
)
*
ccchi
(
iintsp
)
*
z_c
(
kspin
+
nbasf
,
i
)
ctmp
=
clotmp
(
m
)
*
ccchi
(
iintsp
)
*
z
Mat
%
z
_c
(
kspin
+
nbasf
,
i
)
ELSE
ctmp
=
clotmp
(
m
)
*
(
ccchi
(
1
)
*
z
_c
(
nbasf
,
i
)
+
ccchi
(
2
)
*
z_c
(
kspin
+
nbasf
,
i
)
)
ctmp
=
clotmp
(
m
)
*
(
ccchi
(
1
)
*
z
Mat
%
z_c
(
nbasf
,
i
)
+
ccchi
(
2
)
*
zMat
%
z_c
(
kspin
+
nbasf
,
i
)
)
ENDIF
ELSE
IF
(
l_real
)
THEN
ctmp
=
z_r
(
nbasf
,
i
)
*
clotmp
(
m
)
ctmp
=
z
Mat
%
z
_r
(
nbasf
,
i
)
*
clotmp
(
m
)
ELSE
ctmp
=
z_c
(
nbasf
,
i
)
*
clotmp
(
m
)
ctmp
=
z
Mat
%
z
_c
(
nbasf
,
i
)
*
clotmp
(
m
)
ENDIF
ENDIF
acof
(
i
,
lm
,
na
)
=
acof
(
i
,
lm
,
na
)
+
ctmp
*
alo1
(
lo
,
ntyp
)
...
...
@@ -136,22 +135,22 @@ CONTAINS
!+gu_con
IF
(
noco
%
l_noco
)
THEN
IF
(
noco
%
l_ss
)
THEN
ctmp
=
clotmp
(
m
)
*
ccchi
(
iintsp
)
*
z_c
(
kspin
+
nbasf
,
i
)
ctmp
=
clotmp
(
m
)
*
ccchi
(
iintsp
)
*
z
Mat
%
z
_c
(
kspin
+
nbasf
,
i
)
ELSE
ctmp
=
clotmp
(
m
)
*
(
ccchi
(
1
)
*
z
_c
(
nbasf
,
i
)
+
ccchi
(
2
)
*
z_c
(
kspin
+
nbasf
,
i
)
)
ctmp
=
clotmp
(
m
)
*
(
ccchi
(
1
)
*
z
Mat
%
z_c
(
nbasf
,
i
)
+
ccchi
(
2
)
*
zMat
%
z_c
(
kspin
+
nbasf
,
i
)
)
ENDIF
ELSE
IF
(
l_real
)
THEN
ctmp
=
z_r
(
nbasf
,
i
)
*
clotmp
(
m
)
ctmp
=
z
Mat
%
z
_r
(
nbasf
,
i
)
*
clotmp
(
m
)
ELSE
ctmp
=
z_c
(
nbasf
,
i
)
*
clotmp
(
m
)
ctmp
=
z
Mat
%
z
_c
(
nbasf
,
i
)
*
clotmp
(
m
)
ENDIF
ENDIF
acof
(
i
,
lm
,
na
)
=
acof
(
i
,
lm
,
na
)
+
ctmp
*
alo1
(
lo
,
ntyp
)
bcof
(
i
,
lm
,
na
)
=
bcof
(
i
,
lm
,
na
)
+
ctmp
*
blo1
(
lo
,
ntyp
)
ccof
(
m
,
i
,
lo
,
na
)
=
ccof
(
m
,
i
,
lo
,
na
)
+
ctmp
*
clo1
(
lo
,
ntyp
)
IF
(
noco
%
l_soc
.AND.
sym
%
invs
)
THEN
ctmp
=
z_c
(
nbasf
,
i
)
*
CONJG
(
clotmp
(
m
))
*
(
-1
)
**
(
l
-
m
)
ctmp
=
z
Mat
%
z
_c
(
nbasf
,
i
)
*
CONJG
(
clotmp
(
m
))
*
(
-1
)
**
(
l
-
m
)
na2
=
sym
%
invsatnr
(
na
)
lmp
=
ll1
-
m
acof
(
i
,
lmp
,
na2
)
=
acof
(
i
,
lmp
,
na2
)
+
ctmp
*
alo1
(
lo
,
ntyp
)
...
...
cdn_mt/abclocdn_pulay.F90
View file @
e5456adc
...
...
@@ -13,7 +13,7 @@ CONTAINS
&
con1
,
phase
,
ylm
,
ntyp
,
na
,
k
,
fgp
,&
&
s
,
nv
,
ne
,
nbasf0
,
alo1
,
blo1
,
clo1
,&
&
kvec
,
nkvec
,
enough
,
acof
,
bcof
,
ccof
,&
&
acoflo
,
bcoflo
,
aveccof
,
bveccof
,
cveccof
,
z
_r
,
z_c
,
realdata
)
&
acoflo
,
bcoflo
,
aveccof
,
bveccof
,
cveccof
,
z
Mat
,
realdata
)
!
!*********************************************************************
! for details see abclocdn; calles by to_pulay
...
...
@@ -24,6 +24,7 @@ CONTAINS
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_zMat
),
INTENT
(
IN
)
::
zMat
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
iintsp
...
...
@@ -48,8 +49,6 @@ CONTAINS