Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
57
Issues
57
List
Boards
Labels
Milestones
Packages
Packages
Container Registry
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
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
...
@@ -371,7 +371,7 @@ CONTAINS
isn
=
1
isn
=
1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
#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
,&
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
! GM forces part
IF
(
input
%
l_f
)
THEN
IF
(
input
%
l_f
)
THEN
...
@@ -566,8 +566,8 @@ CONTAINS
...
@@ -566,8 +566,8 @@ CONTAINS
isn
=
-1
isn
=
-1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
#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
,&
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
))
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
,&
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
))
stars
%
kq1_fft
,
stars
%
kq2_fft
,
stars
%
kq3_fft
,
wsave
,
kpsir
(
ifftq3d
),
ekin
(
-
ifftq2
))
#else
#else
...
@@ -620,18 +620,19 @@ CONTAINS
...
@@ -620,18 +620,19 @@ CONTAINS
DO
istr
=
1
,
stars
%
ng3_fft
DO
istr
=
1
,
stars
%
ng3_fft
cwk
(
istr
)
=
scale
*
cwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
cwk
(
istr
)
=
scale
*
cwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
ENDDO
ENDDO
#ifdef CPP_APW
IF
(
input
%
l_useapw
)
THEN
IF
(
input
%
l_f
)
THEN
DO
istr
=
1
,
stars
%
ng3_fft
IF
(
input
%
l_f
)
THEN
ecwk
(
istr
)
=
scale
*
ecwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
DO
istr
=
1
,
stars
%
ng3_fft
ENDDO
ecwk
(
istr
)
=
scale
*
ecwk
(
istr
)
/
REAL
(
stars
%
nstr
(
istr
)
)
CALL
forces_b8
(&
ENDDO
atoms
,
ecwk
,
stars
,&
CALL
force_b8
(&
sym
,
cell
,&
atoms
,
ecwk
,
stars
,&
jspin
,&
sym
,
cell
,&
forces
,
f_b8
)
jspin
,&
forces
,
f_b8
)
ENDIF
ENDIF
ENDIF
#endif
!
!
!---> check charge neutralilty
!---> 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
MODULE
m_abcof
CONTAINS
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
)
noco
,
jspin
,
kveclo
,
oneD
,
acof
,
bcof
,
ccof
)
! ************************************************************
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! subroutine constructs the a,b coefficients of the linearized
...
@@ -16,7 +16,8 @@ CONTAINS
...
@@ -16,7 +16,8 @@ CONTAINS
USE
m_ylm
USE
m_ylm
USE
m_types
USE
m_types
IMPLICIT
NONE
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_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
...
@@ -79,9 +80,7 @@ CONTAINS
...
@@ -79,9 +80,7 @@ CONTAINS
DO
lo
=
1
,
atoms
%
nlo
(
n
)
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
l
,
n
)
=
.true.
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
l
,
n
)
=
.true.
ENDDO
ENDDO
#ifdef CPP_APW
IF
((
input
%
l_useapw
)
.AND.
(
atoms
%
lapw_l
(
n
)
.GE.
l
))
apw
(
l
,
n
)
=
.false.
IF
(
atoms
%
lapw_l
(
n
)
.GE.
l
)
apw
(
l
,
n
)
=
.false.
#endif
ENDDO
ENDDO
DO
lo
=
1
,
atoms
%
nlo
(
n
)
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
atoms
%
llo
(
lo
,
n
),
n
)
=
.true.
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
atoms
%
llo
(
lo
,
n
),
n
)
=
.true.
...
...
cdn_mt/abcof3.F90
View file @
fdeca975
MODULE
m_abcof3
MODULE
m_abcof3
CONTAINS
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
)
usdus
,
kveclo
,
oneD
,
a
,
b
,
bascof_lo
)
! ************************************************************
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! subroutine constructs the a,b coefficients of the linearized
...
@@ -16,6 +16,7 @@ CONTAINS
...
@@ -16,6 +16,7 @@ CONTAINS
USE
m_ylm
USE
m_ylm
USE
m_types
USE
m_types
IMPLICIT
NONE
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
...
@@ -61,9 +62,8 @@ CONTAINS
...
@@ -61,9 +62,8 @@ CONTAINS
DO
lo
=
1
,
atoms
%
nlo
(
n
)
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
l
,
n
)
=
.true.
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
l
,
n
)
=
.true.
ENDDO
ENDDO
#ifdef CPP_APW
IF
((
input
%
l_useapw
)
.AND.
(
atoms
%
lapw_l
(
n
)
.GE.
l
))
apw
(
l
,
n
)
=
.false.
IF
(
atoms
%
lapw_l
(
n
)
.GE.
l
)
apw
(
l
,
n
)
=
.false.
#endif
ENDDO
ENDDO
DO
lo
=
1
,
atoms
%
nlo
(
n
)
DO
lo
=
1
,
atoms
%
nlo
(
n
)
IF
(
atoms
%
l_dulo
(
lo
,
n
))
apw
(
atoms
%
llo
(
lo
,
n
),
n
)
=
.true.
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.*")
...
@@ -17,6 +17,8 @@ elseif ($ENV{FC} MATCHES "gfortran.*")
set (configfile "cmake/cmake.gfortran.config")
set (configfile "cmake/cmake.gfortran.config")
elseif ($ENV{FC} MATCHES "ifort.*")
elseif ($ENV{FC} MATCHES "ifort.*")
set (configfile "cmake/cmake.ifort.config")
set (configfile "cmake/cmake.ifort.config")
elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
set (configfile "cmake/cmake.darwin.config")
elseif (${sitename} MATCHES "iff.*")
elseif (${sitename} MATCHES "iff.*")
set (configfile "cmake/cmake.iff.config")
set (configfile "cmake/cmake.iff.config")
elseif (${sitename} MATCHES "jrl.*")
elseif (${sitename} MATCHES "jrl.*")
...
@@ -28,8 +30,6 @@ elseif (${sitename} MATCHES "jrl.*")
...
@@ -28,8 +30,6 @@ elseif (${sitename} MATCHES "jrl.*")
endif()
endif()
elseif (${sitename} MATCHES "juquee.*")
elseif (${sitename} MATCHES "juquee.*")
set (configfile "cmake/cmake.juqueen.config")
set (configfile "cmake/cmake.juqueen.config")
elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
set (configfile "cmake/cmake.darwin.config")
endif ()
endif ()
if (${configfile} MATCHES "NOTFOUND")
if (${configfile} MATCHES "NOTFOUND")
...
...
diagonalization/chani.F90
View file @
fdeca975
...
@@ -302,17 +302,11 @@ CONTAINS
...
@@ -302,17 +302,11 @@ CONTAINS
WRITE
(
*
,
*
)
'ERROR: chani.F: Allocating rwork failed'
WRITE
(
*
,
*
)
'ERROR: chani.F: Allocating rwork failed'
CALL
juDFT_error
(
'Failed to allocated "rwork"'
,
calledby
=
'chani'
)
CALL
juDFT_error
(
'Failed to allocated "rwork"'
,
calledby
=
'chani'
)
ENDIF
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
,&
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
,&
0.0
,
1.0
,
1
,
num
,
abstol
,
num1
,
num2
,
eig2
,
orfac
,
eigvec
,
1
,
1
,&
desceigv
,
work2
,
-1
,
rwork
,
-1
,
iwork
,
-1
,
ifail
,
iclustr
,&
desceigv
,
work2
,
-1
,
rwork
,
-1
,
iwork
,
-1
,
ifail
,
iclustr
,&
gap
,
ierr
)
gap
,
ierr
)
#endif
IF
(
ABS
(
work2
(
1
))
.GT.
lwork2
)
THEN
IF
(
ABS
(
work2
(
1
))
.GT.
lwork2
)
THEN
lwork2
=
work2
(
1
)
lwork2
=
work2
(
1
)
DEALLOCATE
(
work2
)
DEALLOCATE
(
work2
)
...
...
diagonalization/eigen_diag.F90
View file @
fdeca975
...
@@ -56,7 +56,7 @@ CONTAINS
...
@@ -56,7 +56,7 @@ CONTAINS
#ifdef CPP_SCALAPACK
#ifdef CPP_SCALAPACK
USE
m_chani
USE
m_chani
#endif
#endif
#ifdef CPP_
elemental
#ifdef CPP_
ELEMENTAL
USE
m_elemental
USE
m_elemental
#endif
#endif
IMPLICIT
NONE
IMPLICIT
NONE
...
...
diagonalization/geneigbrobl.F90
View file @
fdeca975
...
@@ -24,17 +24,6 @@ CONTAINS
...
@@ -24,17 +24,6 @@ CONTAINS
REAL
,
INTENT
(
OUT
)
::
eig
(:)
REAL
,
INTENT
(
OUT
)
::
eig
(:)
INTEGER
,
INTENT
(
OUT
)
::
ne
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
#ifdef CPP_INVERSION
REAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
REAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
...
@@ -44,7 +33,6 @@ CONTAINS
...
@@ -44,7 +33,6 @@ CONTAINS
COMPLEX
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
z
(:,:)
COMPLEX
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
z
(:,:)
#endif
#endif
#endif
! ... Local Variables ..
! ... Local Variables ..
...
@@ -82,9 +70,7 @@ CONTAINS
...
@@ -82,9 +70,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
ENDDO
!save some storage by deallocation of unused array
!save some storage by deallocation of unused array
#ifndef CPP_F90
DEALLOCATE
(
a
)
DEALLOCATE
(
a
)
#endif
!metric
!metric
ALLOCATE
(
largeb
(
nsize
,
nsize
),
stat
=
err
)
ALLOCATE
(
largeb
(
nsize
,
nsize
),
stat
=
err
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
"error allocating largeb"
,
calledby
=
"geneigprobl"
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
"error allocating largeb"
,
calledby
=
"geneigprobl"
)
...
@@ -97,9 +83,7 @@ CONTAINS
...
@@ -97,9 +83,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
ENDDO
!save some storage by deallocation of unused array
!save some storage by deallocation of unused array
#ifndef CPP_F90
DEALLOCATE
(
b
)
DEALLOCATE
(
b
)
#endif
...
@@ -120,7 +104,6 @@ CONTAINS
...
@@ -120,7 +104,6 @@ CONTAINS
IF
(
err
/
=
0
)
CALL
juDFT_error
(
" error allocating work"
,
calledby
=
"geneigprobl"
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
" error allocating work"
,
calledby
=
"geneigprobl"
)
ALLOCATE
(
isuppz
(
2
*
nsize
),
stat
=
err
)
ALLOCATE
(
isuppz
(
2
*
nsize
),
stat
=
err
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
"error allocating isuppz"
,
calledby
=
"geneigprobl"
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
"error allocating isuppz"
,
calledby
=
"geneigprobl"
)
#ifndef CPP_F90
IF
(
allocated
(
z
))
THEN
IF
(
allocated
(
z
))
THEN
IF
(
.not.
(
size
(
z
,
1
)
==
nbasfcn
.and.
size
(
z
,
2
)
==
neigd
))
deallocate
(
z
)
IF
(
.not.
(
size
(
z
,
1
)
==
nbasfcn
.and.
size
(
z
,
2
)
==
neigd
))
deallocate
(
z
)
ENDIF
ENDIF
...
@@ -131,10 +114,8 @@ CONTAINS
...
@@ -131,10 +114,8 @@ CONTAINS
CALL
juDFT_error
(
"error allocating z"
,
calledby
=
"geneigprobl"
)
CALL
juDFT_error
(
"error allocating z"
,
calledby
=
"geneigprobl"
)
ENDIF
ENDIF
ENDIF
ENDIF
#endif
sizez
=
size
(
z
,
1
)
sizez
=
size
(
z
,
1
)
iu
=
min
(
nsize
,
neigd
)
iu
=
min
(
nsize
,
neigd
)
#ifndef CPP_F90
IF
(
l_J
)
THEN
IF
(
l_J
)
THEN
CALL
CPP_LAPACK_ssyevr
(
'N'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
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
)
sizez
,
isuppz
,
work
,
lwork
,
iwork
,
liwork
,
info
)
...
@@ -142,10 +123,6 @@ CONTAINS
...
@@ -142,10 +123,6 @@ CONTAINS
CALL
CPP_LAPACK_ssyevr
(
'V'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
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
)
sizez
,
isuppz
,
work
,
lwork
,
iwork
,
liwork
,
info
)
ENDIF
ENDIF
#else
eig
=
0.0
eigTemp
=
0.0
#endif
IF
(
info
/
=
0
)
CALL
juDFT_error
(
"error in ssyevr"
,
calledby
=
"geneigprobl"
)
IF
(
info
/
=
0
)
CALL
juDFT_error
(
"error in ssyevr"
,
calledby
=
"geneigprobl"
)
DEALLOCATE
(
isuppz
,
work
,
iwork
)
DEALLOCATE
(
isuppz
,
work
,
iwork
)
...
@@ -174,7 +151,6 @@ CONTAINS
...
@@ -174,7 +151,6 @@ CONTAINS
lrwork
=
84
*
nsize
lrwork
=
84
*
nsize
ALLOCATE
(
work
(
lrwork
),
stat
=
err
)
ALLOCATE
(
work
(
lrwork
),
stat
=
err
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
" error allocating work"
,
calledby
=
"geneigprobl"
)
IF
(
err
/
=
0
)
CALL
juDFT_error
(
" error allocating work"
,
calledby
=
"geneigprobl"
)
#ifndef CPP_F90
IF
(
allocated
(
z
))
THEN
IF
(
allocated
(
z
))
THEN
IF
(
.not.
(
size
(
z
,
1
)
==
nbasfcn
.and.
size
(
z
,
2
)
==
neigd
))
deallocate
(
z
)
IF
(
.not.
(
size
(
z
,
1
)
==
nbasfcn
.and.
size
(
z
,
2
)
==
neigd
))
deallocate
(
z
)
ENDIF
ENDIF
...
@@ -185,27 +161,15 @@ CONTAINS
...
@@ -185,27 +161,15 @@ CONTAINS
CALL
juDFT_error
(
"error allocating z"
,
calledby
=
"geneigprobl"
)
CALL
juDFT_error
(
"error allocating z"
,
calledby
=
"geneigprobl"
)
ENDIF
ENDIF
ENDIF
ENDIF
#endif
sizez
=
size
(
z
,
1
)
sizez
=
size
(
z
,
1
)
iu
=
min
(
nsize
,
neigd
)
iu
=
min
(
nsize
,
neigd
)
#ifndef CPP_F90
IF
(
l_J
)
THEN
IF
(
l_J
)
THEN
CALL
CPP_LAPACK_cheevr
(
'N'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
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
)
sizez
,
isuppz
,
cwork
,
lwork
,
work
,
lrwork
,
iwork
,
liwork
,
info
)
ELSE
ELSE
#if (1==1)
CALL
CPP_LAPACK_cheevr
(
'V'
,
'I'
,
'U'
,
nsize
,
largea
,
nsize
,
lb
,
ub
,
1
,
iu
,
toler
,
ne
,
eigTemp
,
z
,&
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
)
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
ENDIF
#else
eig
=
0.0
eigTemp
=
0.0
#endif
IF
(
info
/
=
0
)
CALL
juDFT_error
(
"error in cheevr"
,
calledby
=
"geneigprobl"
)
IF
(
info
/
=
0
)
CALL
juDFT_error
(
"error in cheevr"
,
calledby
=
"geneigprobl"
)
DEALLOCATE
(
isuppz
)
DEALLOCATE
(
isuppz
)
deallocate
(
work
)
deallocate
(
work
)
...
...
diagonalization/zsymsecloc.F90
View file @
fdeca975
...
@@ -50,17 +50,6 @@ CONTAINS
...
@@ -50,17 +50,6 @@ CONTAINS
! .. Array Arguments ..
! .. Array Arguments ..
INTEGER
,
INTENT
(
IN
)
::
matind
(
dimension
%
nbasfcn
,
2
)
INTEGER
,
INTENT
(
IN
)
::
matind
(
dimension
%
nbasfcn
,
2
)
REAL
,
INTENT
(
OUT
)
::
eig
(
dimension
%
neigd
)
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
#ifdef CPP_INVERSION
REAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
REAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
a
(:),
b
(:)
...
@@ -70,7 +59,6 @@ CONTAINS
...
@@ -70,7 +59,6 @@ CONTAINS
COMPLEX
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
z
(:,:)
COMPLEX
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
z
(:,:)
#endif
#endif
#endif
#ifdef CPP_INVERSION
#ifdef CPP_INVERSION
real
locrec
(
atoms
%
nlotot
,
atoms
%
nlotot
)
real
locrec
(
atoms
%
nlotot
,
atoms
%
nlotot
)
...
@@ -105,9 +93,7 @@ CONTAINS
...
@@ -105,9 +93,7 @@ CONTAINS
! print*,"in zsymsecloc"
! print*,"in zsymsecloc"
#ifndef CPP_F90
deallocate
(
z
)
deallocate
(
z
)
#endif
!******************************************
!******************************************
! l_zref=.false. => simply call eigensolver
! l_zref=.false. => simply call eigensolver
...
@@ -115,10 +101,8 @@ CONTAINS
...
@@ -115,10 +101,8 @@ CONTAINS
if
(
.not.
sym
%
l_zref
)
then
if
(
.not.
sym
%
l_zref
)
then
call
geneigprobl
(
dimension
%
nbasfcn
,
nsize
,
dimension
%
neigd
,
jij
%
l_j
,
a
,
b
,
z
,
eig
,
ne
)
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
(
a
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
b
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
b
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
#endif
return
return
!******************************************
!******************************************
! l_zref=.true. => blockdiagonalize
! l_zref=.true. => blockdiagonalize
...
@@ -461,9 +445,7 @@ CONTAINS
...
@@ -461,9 +445,7 @@ CONTAINS
! z1 holds eigenvectors of even block.
! z1 holds eigenvectors of even block.
! z2 holds eigenvectors of odd block.
! z2 holds eigenvectors of odd block.
!********************************************************************
!********************************************************************
#ifndef CPP_F90
allocate
(
z
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
allocate
(
z
(
dimension
%
nbasfcn
,
dimension
%
neigd
))
#endif
allocate
(
evensort
(
ne
))
allocate
(
evensort
(
ne
))
etemp1
(
ne1
+1
)
=
99.9e9
etemp1
(
ne1
+1
)
=
99.9e9
etemp2
(
ne2
+1
)
=
99.9e9
etemp2
(
ne2
+1
)
=
99.9e9
...
@@ -529,10 +511,8 @@ CONTAINS
...
@@ -529,10 +511,8 @@ CONTAINS
endif
!evensort
endif
!evensort
enddo
!ii
enddo
!ii
#ifndef CPP_F90
allocate
(
a
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
a
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
b
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
allocate
(
b
(
dimension
%
nbasfcn
*
(
dimension
%
nbasfcn
+1
)/
2
))
#endif
endif
!sym%l_zref
endif
!sym%l_zref
deallocate
(
z1
,
z2
,
etemp1
,
etemp2
,
evensort
)
deallocate
(
z1
,
z2
,
etemp1
,
etemp2
,
evensort
)
...
...
eigen/eigen.F90
View file @
fdeca975
...
@@ -453,7 +453,7 @@ CONTAINS
...
@@ -453,7 +453,7 @@ CONTAINS
!---> set up interstitial hamiltonian and overlap matrices
!---> set up interstitial hamiltonian and overlap matrices
!
!
call
timestart
(
"Interstitial Hamiltonian&Overlap"
)
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"
)
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 @@
...
@@ -6,7 +6,7 @@
MODULE
m_hsint
MODULE
m_hsint
CONTAINS
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
)
n_size
,
n_rank
,
bkpt
,
cell
,
atoms
,
aa
,
bb
)
!*********************************************************************
!*********************************************************************
! initializes and sets up the hamiltonian and overlap matrices
! initializes and sets up the hamiltonian and overlap matrices
...
@@ -35,6 +35,7 @@ CONTAINS
...
@@ -35,6 +35,7 @@ CONTAINS
!*********************************************************************
!*********************************************************************
USE
m_types
USE
m_types
IMPLICIT
NONE
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_jij
),
INTENT
(
IN
)
::
jij
TYPE
(
t_jij
),
INTENT
(
IN
)
::
jij
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
...
@@ -114,16 +115,16 @@ CONTAINS
...
@@ -114,16 +115,16 @@ CONTAINS
IF
(
in
.EQ.
0
)
CYCLE
IF
(
in
.EQ.
0
)
CYCLE
phase
=
stars
%
rgphs
(
i1
,
i2
,
i3
)
phase
=
stars
%
rgphs
(
i1
,
i2
,
i3
)
!+APW_LO
!+APW_LO
#ifdef CPP_APW
IF
(
input
%
l_useapw
)
THEN
b1
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
i
,
ispin
)
;
b2
(
1
)
=
bkpt
(
1
)
+
lapw
%
k1
(
j
,
ispin
)
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
(
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
)
b1
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
i
,
ispin
)
;
b2
(
3
)
=
bkpt
(
3
)
+
lapw
%
k3
(
j
,
ispin
)
r2
=
DOT_PRODUCT
(
MATMUL
(
b2
,
cell
%
bbmat
),
b1
)
r2
=
DOT_PRODUCT
(
MATMUL
(
b2
,
cell
%
bbmat
),
b1
)
th
=
phase
*
(
0.5
*
r2
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
th
=
phase
*
(
0.5
*
r2
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
#else
ELSE
th
=
phase
*
(
0.25
*
(
lapw
%
rk
(
i
,
ispin
)
**
2
+
lapw
%
rk
(
j
,
ispin
)
**
2
)
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
th
=
phase
*
(
0.25
*
(
lapw
%
rk
(
i
,
ispin
)
**
2
+
lapw
%
rk
(
j
,
ispin
)
**
2
)
*
stars
%
ustep
(
in
)
+
vpw
(
in
))
#endif
ENDIF
!-APW_LO
!-APW_LO
!---> determine matrix element and store
!---> determine matrix element and store