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
fdeca975
Commit
fdeca975
authored
Sep 26, 2016
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Removed lots of preprocessor dependencies, fixed BUG in last commit
parent
43beef12
Changes
43
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
43 changed files
with
3474 additions
and
3889 deletions
+3474
-3889
cdn/cdnval.F90
cdn/cdnval.F90
+159
-160
cdn/pwden.F90
cdn/pwden.F90
+15
-14
cdn_mt/#abccoflo.f90#
cdn_mt/#abccoflo.f90#
+0
-145
cdn_mt/abcof.F90
cdn_mt/abcof.F90
+4
-5
cdn_mt/abcof3.F90
cdn_mt/abcof3.F90
+4
-4
cmake/Architectures.txt
cmake/Architectures.txt
+2
-2
diagonalization/chani.F90
diagonalization/chani.F90
+1
-7
diagonalization/eigen_diag.F90
diagonalization/eigen_diag.F90
+1
-1
diagonalization/geneigbrobl.F90
diagonalization/geneigbrobl.F90
+0
-36
diagonalization/zsymsecloc.F90
diagonalization/zsymsecloc.F90
+0
-20
eigen/eigen.F90
eigen/eigen.F90
+1
-1
eigen/hlomat.F90
eigen/hlomat.F90
+119
-117
eigen/hsint.F90
eigen/hsint.F90
+22
-21
eigen/hsmt_extra.F90
eigen/hsmt_extra.F90
+4
-4
eigen/hsmt_fjgj.F90
eigen/hsmt_fjgj.F90
+4
-4
eigen/hsmt_sph.F90
eigen/hsmt_sph.F90
+74
-74
eigen/hsvac.F90
eigen/hsvac.F90
+46
-46
eigen/slomat.F90
eigen/slomat.F90
+32
-31
eigen/tlmplm.F90
eigen/tlmplm.F90
+1
-1
eigen_secvar/aline.F90
eigen_secvar/aline.F90
+1
-1
eigen_soc/hsohelp.F90
eigen_soc/hsohelp.F90
+2
-2
force/CMakeLists.txt
force/CMakeLists.txt
+1
-0
force/force_a21.F90
force/force_a21.F90
+82
-83
force/force_a8.F90
force/force_a8.F90
+42
-40
force/to_pulay.F90
force/to_pulay.F90
+7
-7
global/types.F90
global/types.F90
+1
-0
global/utility.F90
global/utility.F90
+1
-39
include/cpp_double.h
include/cpp_double.h
+0
-11
include/juDFT_env.h
include/juDFT_env.h
+0
-7
init/dimen7.F90
init/dimen7.F90
+0
-3
init/inped.F90
init/inped.F90
+556
-616
init/setlomap.F90
init/setlomap.F90
+71
-73
inpgen/atom_input.f
inpgen/atom_input.f
+7
-6
io/r_inpXML.F90
io/r_inpXML.F90
+2207
-2204
juDFT/juDFT_env.h
juDFT/juDFT_env.h
+0
-30
main/fleur.F90
main/fleur.F90
+0
-4
main/vgen.F90
main/vgen.F90
+1
-23
math/cfft.F
math/cfft.F
+2
-0
vgen/CMakeLists.txt
vgen/CMakeLists.txt
+2
-4
vgen/vmtxcg.F90
vgen/vmtxcg.F90
+0
-29
xc-pot/corg91.F
xc-pot/corg91.F
+1
-5
xc-pot/exchpbe.F
xc-pot/exchpbe.F
+0
-4
xc-pot/xch91.F
xc-pot/xch91.F
+1
-5
No files found.
cdn/cdnval.F90
View file @
fdeca975
This diff is collapsed.
Click to expand it.
cdn/pwden.F90
View file @
fdeca975
...
...
@@ -371,7 +371,7 @@ CONTAINS
isn
=
1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
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
,
psir
(
ifftq3d
),
psir
(
-
ifftq2
))
nw1
,
nw2
,
nw3
,
wsave
,
psir
(
ifftq3d
),
psir
(
-
ifftq2
))
! GM forces part
IF
(
input
%
l_f
)
THEN
...
...
@@ -566,8 +566,8 @@ CONTAINS
isn
=
-1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
CALL
rfft
(
isn
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
+1
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,&
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,
wsave
,
psir
(
ifftq3d
),
rhon
(
-
ifftq2
))
CALL
rfft
(
isn
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
+1
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,&
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,
wsave
,
psir
(
ifftq3d
),
rhon
(
-
ifftq2
))
IF
(
input
%
l_f
)
CALL
rfft
(
isn
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
+1
,
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,&
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,
wsave
,
kpsir
(
ifftq3d
),
ekin
(
-
ifftq2
))
#else
...
...
@@ -620,18 +620,19 @@ CONTAINS
DO
istr
=
1
,
stars
%
ng3_fft
cwk
(
istr
)
=
scale
*
cwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
ENDDO
#ifdef CPP_APW
IF
(
input
%
l_f
)
THEN
DO
istr
=
1
,
stars
%
ng3_fft
ecwk
(
istr
)
=
scale
*
ecwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
ENDDO
CALL
forces_b8
(&
atoms
,
ecwk
,
stars
,&
sym
,
cell
,&
jspin
,&
forces
,
f_b8
)
IF
(
input
%
l_useapw
)
THEN
IF
(
input
%
l_f
)
THEN
DO
istr
=
1
,
stars
%
ng3_fft
ecwk
(
istr
)
=
scale
*
ecwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
ENDDO
CALL
force_b8
(&
atoms
,
ecwk
,
stars
,&
sym
,
cell
,&
jspin
,&
forces
,
f_b8
)
ENDIF
ENDIF
#endif
!
!---> check charge neutralilty
!
...
...
cdn_mt/#abccoflo.f90#
deleted
100644 → 0
View file @
43beef12
MODULE m_abccoflo
USE m_juDFT
!*********************************************************************
! Calculates the (upper case) A, B and C coefficients for the local
! orbitals.
! Philipp Kurz 99/04
!*********************************************************************
CONTAINS
SUBROUTINE abccoflo(atoms, con1,rph,cph,ylm,ntyp,na,k,nv,&
l_lo1,alo1,blo1,clo1, nkvec, enough,alo,blo,clo,kvec)
!
!*************** ABBREVIATIONS ***************************************
! kvec : stores the number of the G-vectors, that have been used to
! construct the local orbitals
! nkvec : stores the number of G-vectors that have been found and
! accepted during the construction of the local orbitals.
! enough : enough is set to .true. when enough G-vectors have been
! accepted.
! linindq : if the norm of that part of a local orbital (contructed
! with a trial G-vector) that is orthogonal to the previous
! ones is larger than linindq, then this G-vector is
! accepted.
!*********************************************************************
!
USE m_constants
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
REAL, INTENT (IN) :: con1,cph ,rph
INTEGER, INTENT (IN) :: k,na,ntyp,nv
LOGICAL, INTENT (IN) :: l_lo1
LOGICAL, INTENT (OUT):: enough
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN):: kvec(2* (2*atoms%llod+1),atoms%nlod) )
REAL, INTENT (IN) :: alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (OUT):: alo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)
COMPLEX, INTENT (OUT):: blo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)
COMPLEX, INTENT (OUT):: clo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)
INTEGER,INTENT (INOUT):: nkvec(atoms%nlod)
! ..
! .. Local Scalars ..
COMPLEX term1
REAL,PARAMETER:: linindq=1.e-4
INTEGER l,lo ,mind,ll1,lm
LOGICAL linind
! ..
!
!---> the whole program is in hartree units, therefore 1/wronskian is
!---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
!---> and c coefficients, is included in the t-matrices. thus, it does
!---> not show up in the formula above.
!
!-abccoflo1
IF ( l_lo1) THEN
DO lo = 1,atoms%nlo(ntyp)
IF ( (nkvec(lo).EQ.0).AND.(atoms%llo(lo,ntyp).EQ.0) ) THEN
enough = .FALSE.
nkvec(lo) = 1
m = 0
clo(m,nkvec(lo),lo) = con1* ((atoms%rmt**2)/2) / SQRT(fpi_const)
alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
IF (kvec(nkvec(lo),lo)/=k) CALL juDFT_error("abccoflo:1"&
& ,calledby ="abccoflo")
ENDIF
ENDDO
ELSE
enough = .TRUE.
term1 = con1* ((atoms%rmt**2)/2)*CMPLX(rph,cph)
DO lo = 1,atoms%nlo(ntyp)
IF (atoms%invsat(na).EQ.0) THEN
IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough = .FALSE.
nkvec(lo) = nkvec(lo) + 1
l = atoms%llo(lo,ntyp)
ll1 = l*(l+1) + 1
DO m = -l,l
lm = ll1 + m
clo(m,nkvec(lo),lo) = term1*ylm(lm)
END DO
IF ( kvec(nkvec(lo),lo) == k ) THEN
DO m = -l,l
alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
END DO
! WRITE(6,9000) nkvec(lo),k,lo,na,
! + (clo(m,nkvec(lo),lo),m=-l,l)
! 9000 format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
ELSE
nkvec(lo) = nkvec(lo) - 1
ENDIF
ENDIF
ELSE
IF ((atoms%invsat(na).EQ.1) .OR. (atoms%invsat(na).EQ.2)) THEN
! only invsat=1 is needed invsat=2 for testing
IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough = .FALSE.
nkvec(lo) = nkvec(lo) + 1
l = atoms%llo(lo,ntyp)
ll1 = l*(l+1) + 1
DO m = -l,l
lm = ll1 + m
clo(m,nkvec(lo),lo) = term1*ylm(lm)
END DO
IF ( kvec(nkvec(lo),lo) == k ) THEN
DO m = -l,l
! if(l.eq.1) then
! WRITE(*,*)'k=',k,' clotmp=',clo(m,nkvec(lo),lo)
! WRITE(*,*)'clo1=',clo1(lo),' term1=',term1
! endif
alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
! kvec(nkvec(lo),lo) = k
END DO
ELSE
nkvec(lo) = nkvec(lo) - 1
END IF
END IF
END IF
END IF
END DO
IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
WRITE (6,FMT=*)&
& 'abccoflo did not find enough linearly independent'
WRITE (6,FMT=*)&
& 'clo coefficient-vectors. the linear independence'
WRITE (6,FMT=*) 'quality, linindq, is set to: ',linindq,'.'
WRITE (6,FMT=*) 'this value might be to large.'
CALL juDFT_error&
& ("abccoflo: did not find enough lin. ind. clo-vectors"&
& ,calledby ="abccoflo")
END IF
ENDIF ! abccoflo1
END SUBROUTINE abccoflo
END MODULE m_abccoflo
cdn_mt/abcof.F90
View file @
fdeca975
MODULE
m_abcof
CONTAINS
SUBROUTINE
abcof
(
atoms
,
nobd
,
sym
,
cell
,
bkpt
,
lapw
,
ne
,
z
,
usdus
,&
SUBROUTINE
abcof
(
input
,
atoms
,
nobd
,
sym
,
cell
,
bkpt
,
lapw
,
ne
,
z
,
usdus
,&
noco
,
jspin
,
kveclo
,
oneD
,
acof
,
bcof
,
ccof
)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
...
...
@@ -16,7 +16,8 @@ CONTAINS
USE
m_ylm
USE
m_types
IMPLICIT
NONE
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
...
...
@@ -79,9 +80,7 @@ CONTAINS
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
l
,
n
)
=
.true.
ENDDO
#ifdef CPP_APW
IF
(
atoms
%
lapw_l
(
n
)
.GE.
l
)
apw
(
l
,
n
)
=
.false.
#endif
IF
((
input
%
l_useapw
)
.AND.
(
atoms
%
lapw_l
(
n
)
.GE.
l
))
apw
(
l
,
n
)
=
.false.
ENDDO
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
atoms
%
llo
(
lo
,
n
),
n
)
=
.true.
...
...
cdn_mt/abcof3.F90
View file @
fdeca975
MODULE
m_abcof3
CONTAINS
SUBROUTINE
abcof3
(
atoms
,
sym
,
jspin
,
cell
,
bkpt
,
lapw
,&
SUBROUTINE
abcof3
(
input
,
atoms
,
sym
,
jspin
,
cell
,
bkpt
,
lapw
,&
usdus
,
kveclo
,
oneD
,
a
,
b
,
bascof_lo
)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
...
...
@@ -16,6 +16,7 @@ CONTAINS
USE
m_ylm
USE
m_types
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
...
...
@@ -61,9 +62,8 @@ CONTAINS
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
l
,
n
)
=
.true.
ENDDO
#ifdef CPP_APW
IF
(
atoms
%
lapw_l
(
n
)
.GE.
l
)
apw
(
l
,
n
)
=
.false.
#endif
IF
((
input
%
l_useapw
)
.AND.
(
atoms
%
lapw_l
(
n
)
.GE.
l
))
apw
(
l
,
n
)
=
.false.
ENDDO
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
atoms
%
llo
(
lo
,
n
),
n
)
=
.true.
...
...
cmake/Architectures.txt
View file @
fdeca975
...
...
@@ -17,6 +17,8 @@ elseif ($ENV{FC} MATCHES "gfortran.*")
set (configfile "cmake/cmake.gfortran.config")
elseif ($ENV{FC} MATCHES "ifort.*")
set (configfile "cmake/cmake.ifort.config")
elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
set (configfile "cmake/cmake.darwin.config")
elseif (${sitename} MATCHES "iff.*")
set (configfile "cmake/cmake.iff.config")
elseif (${sitename} MATCHES "jrl.*")
...
...
@@ -28,8 +30,6 @@ elseif (${sitename} MATCHES "jrl.*")
endif()
elseif (${sitename} MATCHES "juquee.*")
set (configfile "cmake/cmake.juqueen.config")
elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
set (configfile "cmake/cmake.darwin.config")
endif ()
if (${configfile} MATCHES "NOTFOUND")
...
...
diagonalization/chani.F90
View file @
fdeca975
...
...
@@ -302,17 +302,11 @@ CONTAINS
WRITE
(
*
,
*
)
'ERROR: chani.F: Allocating rwork failed'
CALL
juDFT_error
(
'Failed to allocated "rwork"'
,
calledby
=
'chani'
)
ENDIF
#ifdef CPP_T90
CALL
CPP_LAPACK_pzhegvx
(
1
,
'V'
,
'I'
,
'U'
,
m
,
asca
,
1
,
1
,
desca
,
bsca
,
1
,
1
,
desca
,&
0.0
,
1.0
,
1
,
m
,
abstol
,
num1
,
num2
,
eig2
,
orfac
,
eigvec
,
1
,
1
,&
desceigv
,
work2
,
-1
,
rwork
,
-1
,
iwork
,
-1
,
ifail
,
iclustr
,&
gap
,
ierr
)
#else
CALL
CPP_LAPACK_pzhegvx
(
1
,
'V'
,
'I'
,
'U'
,
m
,
asca
,
1
,
1
,
desca
,
bsca
,
1
,
1
,
desca
,&
0.0
,
1.0
,
1
,
num
,
abstol
,
num1
,
num2
,
eig2
,
orfac
,
eigvec
,
1
,
1
,&
desceigv
,
work2
,
-1
,
rwork
,
-1
,
iwork
,
-1
,
ifail
,
iclustr
,&
gap
,
ierr
)
#endif
IF
(
ABS
(
work2
(
1
))
.GT.
lwork2
)
THEN
lwork2
=
work2
(
1
)
DEALLOCATE
(
work2
)
...
...
diagonalization/eigen_diag.F90
View file @
fdeca975
...
...
@@ -56,7 +56,7 @@ CONTAINS
#ifdef CPP_SCALAPACK
USE
m_chani
#endif
#ifdef CPP_
elemental
#ifdef CPP_
ELEMENTAL
USE
m_elemental
#endif
IMPLICIT
NONE
...
...
diagonalization/geneigbrobl.F90
View file @
fdeca975
...
...
@@ -24,17 +24,6 @@ CONTAINS
REAL
,
INTENT
(
OUT
)
::
eig
(:)
INTEGER
,
INTENT
(
OUT
)
::
ne
#ifdef CPP_F90
#ifdef CPP_INVERSION
REAL
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
REAL
,
INTENT
(
INOUT
)
::
z
(:,:)
#else
COMPLEX
,
INTENT
(
INOUT
)::
a
(:),
b
(:)
COMPLEX
,
INTENT
(
INOUT
)
::
z
(:,:)
#endif
#else
#ifdef CPP_INVERSION
REAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
...
...
@@ -44,7 +33,6 @@ CONTAINS
COMPLEX
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
z
(:,:)
#endif
#endif
! ... Local Variables ..
...
...
@@ -82,9 +70,7 @@ CONTAINS
ENDDO
ENDDO
!save some storage by deallocation of unused array
#ifndef CPP_F90
DEALLOCATE
(
a
)
#endif
!metric
ALLOCATE
(
largeb
(
nsize
,
nsize
),
stat
=
err
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
"error allocating largeb"
,
calledby
=
"geneigprobl"
)
...
...
@@ -97,9 +83,7 @@ CONTAINS
ENDDO
ENDDO
!save some storage by deallocation of unused array
#ifndef CPP_F90
DEALLOCATE
(
b
)
#endif
...
...
@@ -120,7 +104,6 @@ CONTAINS
IF
(
err
/
=
0
)
CALL
juDFT_error
(
" error allocating work"
,
calledby
=
"geneigprobl"
)
ALLOCATE
(
isuppz
(
2
*
nsize
),
stat
=
err
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
"error allocating isuppz"
,
calledby
=
"geneigprobl"
)
#ifndef CPP_F90
IF
(
allocated
(
z
))
THEN
IF
(
.not.
(
size
(
z
,
1
)
==
nbasfcn
.and.
size
(
z
,
2
)
==
neigd
))
deallocate
(
z
)
ENDIF
...
...
@@ -131,10 +114,8 @@ CONTAINS
CALL
juDFT_error
(
"error allocating z"
,
calledby
=
"geneigprobl"
)
ENDIF
ENDIF
#endif
sizez
=
size
(
z
,
1
)
iu
=
min
(
nsize
,
neigd
)
#ifndef CPP_F90
IF
(
l_J
)
THEN
CALL
CPP_LAPACK_ssyevr
(
'N'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
sizez
,
isuppz
,
work
,
lwork
,
iwork
,
liwork
,
info
)
...
...
@@ -142,10 +123,6 @@ CONTAINS
CALL
CPP_LAPACK_ssyevr
(
'V'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
sizez
,
isuppz
,
work
,
lwork
,
iwork
,
liwork
,
info
)
ENDIF
#else
eig
=
0.0
eigTemp
=
0.0
#endif
IF
(
info
/
=
0
)
CALL
juDFT_error
(
"error in ssyevr"
,
calledby
=
"geneigprobl"
)
DEALLOCATE
(
isuppz
,
work
,
iwork
)
...
...
@@ -174,7 +151,6 @@ CONTAINS
lrwork
=
84
*
nsize
ALLOCATE
(
work
(
lrwork
),
stat
=
err
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
" error allocating work"
,
calledby
=
"geneigprobl"
)
#ifndef CPP_F90
IF
(
allocated
(
z
))
THEN
IF
(
.not.
(
size
(
z
,
1
)
==
nbasfcn
.and.
size
(
z
,
2
)
==
neigd
))
deallocate
(
z
)
ENDIF
...
...
@@ -185,27 +161,15 @@ CONTAINS
CALL
juDFT_error
(
"error allocating z"
,
calledby
=
"geneigprobl"
)
ENDIF
ENDIF
#endif
sizez
=
size
(
z
,
1
)
iu
=
min
(
nsize
,
neigd
)
#ifndef CPP_F90
IF
(
l_J
)
THEN
CALL
CPP_LAPACK_cheevr
(
'N'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
sizez
,
isuppz
,
cwork
,
lwork
,
work
,
lrwork
,
iwork
,
liwork
,
info
)
ELSE
#if (1==1)
CALL
CPP_LAPACK_cheevr
(
'V'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
sizez
,
isuppz
,
cwork
,
lwork
,
work
,
lrwork
,
iwork
,
liwork
,
info
)
#else
CALL
CPP_LAPACK_cheevx
(
'V'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
sizez
,
cwork
,
lwork
,
work
,
iwork
,
isuppz
,
info
)
#endif
ENDIF
#else
eig
=
0.0
eigTemp
=
0.0
#endif
IF
(
info
/
=
0
)
CALL
juDFT_error
(
"error in cheevr"
,
calledby
=
"geneigprobl"
)
DEALLOCATE
(
isuppz
)
deallocate
(
work
)
...
...
diagonalization/zsymsecloc.F90
View file @
fdeca975
...
...
@@ -50,17 +50,6 @@ CONTAINS
! .. Array Arguments ..
INTEGER
,
INTENT
(
IN
)
::
matind
(
dimension
%
nbasfcn
,
2
)
REAL
,
INTENT
(
OUT
)
::
eig
(
dimension
%
neigd
)
#ifdef CPP_F90
#ifdef CPP_INVERSION
REAL
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
REAL
,
INTENT
(
INOUT
)
::
z
(:,:)
#else
COMPLEX
,
INTENT
(
INOUT
)::
a
(:),
b
(:)
COMPLEX
,
INTENT
(
INOUT
)
::
z
(:,:)
#endif
#else
#ifdef CPP_INVERSION
REAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
...
...
@@ -70,7 +59,6 @@ CONTAINS
COMPLEX
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
z
(:,:)
#endif
#endif
#ifdef CPP_INVERSION
real
locrec
(
atoms
%
nlotot
,
atoms
%
nlotot
)
...
...
@@ -105,9 +93,7 @@ CONTAINS
! print*,"in zsymsecloc"
#ifndef CPP_F90
deallocate
(
z
)
#endif
!******************************************
! l_zref=.false. => simply call eigensolver
...
...
@@ -115,10 +101,8 @@ CONTAINS
if
(
.not.
sym
%
l_zref
)
then
call
geneigprobl
(
dimension
%
nbasfcn
,
nsize
,
dimension
%
neigd
,
jij
%
l_j
,
a
,
b
,
z
,
eig
,
ne
)
#ifndef CPP_F90
allocate
(
a
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
b
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
#endif
return
!******************************************
! l_zref=.true. => blockdiagonalize
...
...
@@ -461,9 +445,7 @@ CONTAINS
! z1 holds eigenvectors of even block.
! z2 holds eigenvectors of odd block.
!********************************************************************
#ifndef CPP_F90
allocate
(
z
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
#endif
allocate
(
evensort
(
ne
))
etemp1
(
ne1
+1
)
=
99.9e9
etemp2
(
ne2
+1
)
=
99.9e9
...
...
@@ -529,10 +511,8 @@ CONTAINS
endif
!evensort
enddo
!ii
#ifndef CPP_F90
allocate
(
a
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
b
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
#endif
endif
!sym%l_zref
deallocate
(
z1
,
z2
,
etemp1
,
etemp2
,
evensort
)
...
...
eigen/eigen.F90
View file @
fdeca975
...
...
@@ -453,7 +453,7 @@ CONTAINS
!---> set up interstitial hamiltonian and overlap matrices
!
call
timestart
(
"Interstitial Hamiltonian&Overlap"
)
CALL
hsint
(
noco
,
jij
,
stars
,
vpw
(:,
jsp
),
lapw
,
jsp
,
n_size
,
n_rank
,
kpts
%
bk
(:,
nk
),
cell
,
atoms
,
a
,
b
)
CALL
hsint
(
input
,
noco
,
jij
,
stars
,
vpw
(:,
jsp
),
lapw
,
jsp
,
n_size
,
n_rank
,
kpts
%
bk
(:,
nk
),
cell
,
atoms
,
a
,
b
)
call
timestop
(
"Interstitial Hamiltonian&Overlap"
)
!
...
...
eigen/hlomat.F90
View file @
fdeca975
This diff is collapsed.
Click to expand it.
eigen/hsint.F90
View file @
fdeca975
...
...
@@ -6,7 +6,7 @@
MODULE
m_hsint
CONTAINS
SUBROUTINE
hsint
(
noco
,
jij
,
stars
,
vpw
,
lapw
,
jspin
,&
SUBROUTINE
hsint
(
input
,
noco
,
jij
,
stars
,
vpw
,
lapw
,
jspin
,&
n_size
,
n_rank
,
bkpt
,
cell
,
atoms
,
aa
,
bb
)
!*********************************************************************
! initializes and sets up the hamiltonian and overlap matrices
...
...
@@ -35,6 +35,7 @@ CONTAINS
!*********************************************************************
USE
m_types
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_jij
),
INTENT
(
IN
)
::
jij
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
...
...
@@ -114,16 +115,16 @@ CONTAINS
IF
(
in
.EQ.
0
)
CYCLE
phase
=
stars
%
rgphs
(
i1
,
i2
,
i3
)
!+APW_LO
#ifdef CPP_APW
b1
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
i
,
ispin
)
;
b2
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
j
,
ispin
)
b1
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
i
,
ispin
)
;
b2
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
j
,
ispin
)
b1
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
i
,
ispin
)
;
b2
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
j
,
ispin
)
r2
=
DOT_PRODUCT
(
MATMUL
(
b2
,
cell
%
bbmat
),
b1
)
th
=
phase
*
(
0.5
*
r2
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
#else
th
=
phase
*
(
0.25
*
(
lapw
%
rk
(
i
,
ispin
)
**
2
+
lapw
%
rk
(
j
,
ispin
)
**
2
)
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
#endif
IF
(
input
%
l_useapw
)
THEN
b1
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
i
,
ispin
)
;
b2
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
j
,
ispin
)
b1
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
i
,
ispin
)
;
b2
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
j
,
ispin
)
b1
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
i
,
ispin
)
;
b2
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
j
,
ispin
)
r2
=
DOT_PRODUCT
(
MATMUL
(
b2
,
cell
%
bbmat
),
b1
)
th
=
phase
*
(
0.5
*
r2
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
ELSE
th
=
phase
*
(
0.25
*
(
lapw
%
rk
(
i
,
ispin
)
**
2
+
lapw
%
rk
(
j
,
ispin
)
**
2
)
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
ENDIF
!-APW_LO
!---> determine matrix element and store
ts
=
phase
*
stars
%
ustep
(
in
)
...
...
@@ -182,16 +183,16 @@ CONTAINS
ELSE
phase
=
stars
%
rgphs
(
i1
,
i2
,
i3
)
!+APW_LO
#ifdef CPP_APW
b1
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
i
,
ispin
)
;
b2
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
j
,
ispin
)
b1
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
i
,
ispin
)
;
b2
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
j
,
ispin
)
b1
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
i
,
ispin
)
;
b2
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
j
,
ispin
)
r2
=
DOT_PRODUCT
(
MATMUL
(
b2
,
cell
%
bbmat
),
b1
)
th
=
phase
*
(
0.5
*
r2
*
stars
%
ustep
(
in
)
+
vpw
(
in
)
)
#else
th
=
phase
*
(
0.25
*
(
lapw
%
rk
(
i
,
ispin
)
**
2
+
lapw
%
rk
(
j
,
ispin
)
**
2
)
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
#endif
IF
(
input
%
l_useapw
)
THEN
b1
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
i
,
ispin
)
;
b2
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
j
,
ispin
)
b1
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
i
,
ispin
)
;
b2
(
2
)
=
bkpt
(
2
)
+
lapw
%
k2
(
j
,
ispin
)
b1
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
i
,
ispin
)
;
b2
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
j
,
ispin
)
r2
=
DOT_PRODUCT
(
MATMUL
(
b2
,
cell
%
bbmat
),
b1
)
th
=
phase
*
(
0.5
*
r2
*
stars
%
ustep
(
in
)
+
vpw
(
in
)
)
ELSE
th
=
phase
*
(
0.25
*
(
lapw
%
rk
(
i
,
ispin
)
**
2
+
lapw
%
rk
(
j
,
ispin
)
**
2
)
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
ENDIF
!-APW_LO
ts
=
phase
*
stars
%
ustep
(
in
)
aa
(
ii
)
=
th
...
...
eigen/hsmt_extra.F90
View file @
fdeca975
...
...
@@ -248,11 +248,11 @@ CONTAINS
IF
(
l_socfirst
)
fjstart
=
isp
#ifndef CPP_INVERSION
CALL
slomat
(&
atoms
,
n
,
na
,
lapw
,
con1
,
n_size
,
n_rank
,
gk
,
rph
,
cph
,&
input
,
atoms
,
n
,
na
,
lapw
,
con1
,
n_size
,
n_rank
,
gk
,
rph
,
cph
,&
fj
(:,
0
:,:,
fjstart
:),
gj
(:,
0
:,:,
fjstart
:),&
kvec
,
isp
,
usdus
,
alo1
,
blo1
,
clo1
,
noco
,
ab_dim
,
1
,
1
,
chi11
,
chi22
,
chi21
,&
iilos
,
locols
,
nkvecprevats
,
bbhlp
)
CALL
hlomat
(
atoms
,
isp
,
isp
,
n_size
,
n_rank
,&
CALL
hlomat
(
input
,
atoms
,
isp
,
isp
,
n_size
,
n_rank
,&
n
,
na
,
lapw
,
ar
(:,
0
:,
1
),
br
(:,
0
:,
1
),
ai
(:,
0
:,
1
),
bi
(:,
0
:,
1
),&
el
(:,
n
,
isp
),
alo
,
blo
,
clo
,
usdus
,
noco
,
1
,
1
,
chi11
,
chi22
,
chi21
,&
iiloh
,
locolh
,
nkvecprevath
,
tlmplm
,
aahlp
)
...
...
@@ -261,11 +261,11 @@ CONTAINS
jd
=
1
;
IF
(
noco
%
l_noco
)
jd
=
isp
DO
iintsp
=
1
,
nintsp
DO
jintsp
=
1
,
nintsp
CALL
slomat
(
atoms
,
n
,
na
,
lapw
,
con1
,
n_size
,
n_rank
,&
CALL
slomat
(
input
,
atoms
,
n
,
na
,
lapw
,
con1
,
n_size
,
n_rank
,&
gk
,
rph
,
cph
,
fj
,
gj
,
kvec
,
isp
,
usdus
,
alo1
,
blo1
,
clo1
,
noco
,&
ab_dim
,
iintsp
,
jintsp
,
chi11
,
chi22
,
chi21
,&
iilos
,
locols
,
nkvecprevats
,
bb
)
CALL
hlomat
(
atoms
,
isp
,
jd
,
n_size
,
n_rank
,&
CALL
hlomat
(
input
,
atoms
,
isp
,
jd
,
n_size
,
n_rank
,&
n
,
na
,
lapw
,
ar
(:,
0
:,
jintsp
),
br
(:,
0
:,
jintsp
),
ai
(:,
0
:,
jintsp
),
bi
(:,
0
:,
jintsp
),&
el
(:,
n
,
isp
),
alo
,
blo
,
clo
,
usdus
,
noco
,
iintsp
,
jintsp
,
chi11
,
chi22
,
chi21
,&
iiloh
,
locolh
,
nkvecprevath
,
tlmplm
,
aa
)
...
...
eigen/hsmt_fjgj.F90
View file @
fdeca975
...
...
@@ -7,7 +7,7 @@ MODULE m_hsmt_fjgj
use
m_juDFT
implicit
none
CONTAINS
SUBROUTINE
hsmt_fjgj
(
atoms
,
isp
,
noco
,
l_socfirst
,
cell
,
nintsp
,
lapw
,
usdus
,
fj
,
gj
)
SUBROUTINE
hsmt_fjgj
(
input
,
atoms
,
isp
,
noco
,
l_socfirst
,
cell
,
nintsp
,
lapw
,
usdus
,
fj
,
gj
)
!Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
!radial functions at the MT boundary as contained in usdus
USE
m_constants
,
ONLY
:
fpi_const
...
...
@@ -15,6 +15,7 @@ CONTAINS
USE
m_dsphbs
USE
m_types
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
...
...
@@ -43,9 +44,8 @@ CONTAINS
DO
n
=
1
,
atoms
%
ntype
DO
l
=
0
,
atoms
%
lmax
(
n
)