Commit df877d36 authored by Matthias Redies's avatar Matthias Redies

hopefully sucessful merge

parents cbac3b75 0bf8699e
stages:
- build
- test
- coverage
- deploy
- build-pgi
- test-pgi
- build-intel
- test-intel
build-gfortran:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: build
......@@ -42,9 +44,14 @@ pages:
cache:
paths:
- build
- public
script:
- cd /builds/fleur/fleur/build ; make doc
- mv docs/html/ ../public/
- mv /builds/fleur/fleur/docs/Docu_main.html ../public/index.html
environment:
name: Doxygen
url: https://fleur.iffgit.fz-juelich.de/fleur
artifacts:
paths:
- public
......@@ -111,3 +118,27 @@ test-intel:
- schedules
- web
- triggers
gfortran-coverage:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: coverage
cache:
paths:
- build
script:
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make
- lcov --capture --initial -d CMakeFiles -o baseline.info
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";ctest
- lcov --capture -d CMakeFiles -o after.info
- lcov --add-tracefile baseline.info --add-tracefile after.info -o combined.info
- genhtml combined.info --output-directory html_out
- mkdir ../public;mv html_out ../public/coverage_html
artifacts:
paths:
- public
environment:
name: Coverage
url: https://fleur.iffgit.fz-juelich.de/fleur/coverage_html
only:
- web
- schedules
\ No newline at end of file
......@@ -103,4 +103,9 @@ module purge
ml Architecture/KNL
module load intel-para CMake HDF5 libxml2/.2.9.7 ELPA/2017.11.001-hybrid
/work/ias-1/s.rost/fleur_booster/fleur/build/fleur
```
\ No newline at end of file
```
## Developing Fleur
We agreed to use a unified indentation-width of 3.
Hint: [vim](http://vim.wikia.com/wiki/Converting_tabs_to_spaces) [emacs](https://www.gnu.org/software/emacs/manual/html_node/efaq/Changing-the-length-of-a-Tab.html)
\ No newline at end of file
......@@ -9,7 +9,9 @@ CONTAINS
!***********************************************************************
!
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
USE m_types
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
......
......@@ -7,8 +7,11 @@ MODULE m_qal21
CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_types_setup
USE m_types_dos
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_types_denCoeffsOffdiag
USE m_rotdenmat
USE m_types
IMPLICIT NONE
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
......
......@@ -11,7 +11,8 @@ CONTAINS
SUBROUTINE calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
USE m_juDFT
USE m_types
USE m_types_setup
USE m_types_cdnval, ONLY: t_eigVecCoeffs,t_denCoeffs
USE m_rhomt
USE m_rhonmt
USE m_rhomtlo
......
......@@ -29,7 +29,6 @@ include(mix/CMakeLists.txt)
include(vgen/CMakeLists.txt)
include(inpgen/CMakeLists.txt)
include(docs/CMakeLists.txt)
include(tests/CMakeLists.txt)
include(mpi/CMakeLists.txt)
include(hybrid/CMakeLists.txt)
include(eels/CMakeLists.txt)
......@@ -39,11 +38,15 @@ include(wannier/uhu/CMakeLists.txt)
include(forcetheorem/CMakeLists.txt)
include(rdmft/CMakeLists.txt)
include(tests/tests_old.cmake)
#include(tests/tests_new.cmake)
set(inpgen_F77 ${inpgen_F77}
inpgen/element.f inpgen/atom_input.f inpgen/crystal.f inpgen/lattice2.f inpgen/setab.f inpgen/super_check.f
inpgen/atom_sym.f inpgen/generator.f inpgen/read_record.f inpgen/soc_or_ssdw.f inpgen/symproperties.f
inpgen/bravais_symm.f inpgen/set_atom_core.f inpgen/spg_gen.f global/triang.f
inpgen/closure.f inpgen/lapw_input.f inpgen/struct_input.f inpgen/write_struct.f
inpgen/lapw_input.f inpgen/struct_input.f inpgen/write_struct.f
io/calculator.f global/ss_sym.f global/soc_sym.f math/inv3.f io/rw_symfile.f
global/sort.f init/kptgen_hybrid.f init/od_kptsgen.f init/bravais.f init/divi.f init/brzone.f
init/kptmop.f init/kpttet.f init/bandstr1.F init/ordstar.f init/fulstar.f init/kprep.f
......@@ -53,7 +56,7 @@ init/tetcon.f init/kvecon.f init/boxdim.f math/ylm4.f global/radsra.f math/intgr
set(inpgen_F90 ${inpgen_F90} global/constants.f90 io/xsf_io.f90
eigen/vec_for_lo.f90 eigen/orthoglo.F90 juDFT/usage_data.F90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90 inpgen/closure.f90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 io/w_inpXML.f90 init/julia.f90 global/utility.F90
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90 dos/nstm3.f90 cdn/int_21.f90
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90 force/force_a21.F90 force/force_a21_lo.f90 force/force_a21_U.f90 force/force_a12.f90
......
......@@ -4,6 +4,8 @@ if (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel")
if (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "13.0.0.0")
set(FLEUR_WARN_MESSAGE "You are using an old version of the Intel Fortran Compiler. Most likely FLEUR will not be build sucessfully. Consider to upgrade your compiler.")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -openmp -assume byterecl")
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_OLDINTEL")
set(FLEUR_DEFINITIONS ${FLEUR_DEFINITIONS} "CPP_OLDINTEL")
elseif (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "14.1.0.0")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -openmp -assume byterecl")
else()
......
......@@ -54,7 +54,7 @@ then
fi
if [ "$CLI_FLAGS" ]
then
cmake_flags="$CMAKE_Fortran_FLAGS $cmake_flags"
cmake_flags="$CLI_FLAGS $cmake_flags"
fi
for lib in $FLEUR_INCLUDEDIR $CLI_INCLUDEDIR
do
......
......@@ -298,7 +298,7 @@ IMPLICIT NONE
!Simple driver to solve Generalized Eigenvalue Problem using the ChASE library
IMPLICIT NONE
TYPE(t_mpimat), INTENT(INOUT) :: hmat,smat
TYPE(t_mpimat), INTENT(INOUT) :: hmat,smat
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: iter
......@@ -310,7 +310,7 @@ IMPLICIT NONE
INTEGER :: info,myid,np
REAL :: scale !scaling of eigenvalues from scalapack
CLASS(t_mat), ALLOCATABLE :: zMatTemp
TYPE(t_mat) :: zMatTemp
TYPE(t_mpimat) :: chase_mat
REAL, ALLOCATABLE :: eigenvalues(:)
include 'mpif.h'
......@@ -356,9 +356,9 @@ IMPLICIT NONE
CALL chase_mat%generate_full_matrix()
ALLOCATE(eigenvalues(nev+nex))
eigenvalues = 0.0
ALLOCATE(t_mpimat::zmatTemp)
!ALLOCATE(t_mpimat::zmatTemp)
CALL zMatTemp%init(hmat%l_real,hmat%global_size1,nev+nex,MPI_COMM_SELF,.TRUE.) !Generate a pseudo-distributed matrix
IF (hmat%l_real) THEN
IF(iter.EQ.1) THEN
CALL mpi_chase_r(chase_mat%data_r, zMatTemp%data_r, eigenvalues, 25, 1e-10, 'R', 'S' )
......@@ -374,20 +374,20 @@ IMPLICIT NONE
CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, 1e-10, 'A', 'S' )
END IF
ENDIF
ne = nev
IF (myid==0) CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,&
eigenvalues(:(nev+nex)),zmat=zMatTemp)
CALL hmat%copy(zmatTemp,1,1) !Copy matrix into distributed form
CALL hmat%from_non_dist(zmattemp)
call zmatTemp%free()
! --> recover the generalized eigenvectors z by solving z' = l^t * z
IF (smat%l_real) THEN
CALL pdtrtrs('U','N','N',hmat%global_size1,nev,smat%data_r,1,1,smat%blacs_desc,&
CALL pdtrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_r,1,1,smat%blacs_desc,&
hmat%data_r,1,1,smat%blacs_desc,info)
ELSE
CALL pztrtrs('U','N','N',hmat%global_size1,nev,smat%data_c,1,1,smat%blacs_desc,&
CALL pztrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_c,1,1,smat%blacs_desc,&
hmat%data_c,1,1,smat%blacs_desc,info)
END IF
IF (info.NE.0) THEN
......
<!DOCTYPE HTML>
<html>
<head> <title> FLEUR DOKU PAGE </title> </head>
<body>
<h1>Documentation for FLEUR<o:p></o:p></h1>
<ul>
<li>The <a href="http://www.flapw.de/">FLEUR wiki</a> with information on how to use FLEUR.</li>
<li>The <a href="https://fleur.iffgit.fz-juelich.de/fleur/html/">documentation of the source code</a> and information useful for developers.</li>
<li>The <a href="https://fleur.iffgit.fz-juelich.de/fleur/coverage_html">coverage analysis</a> of the source code showing which part of the code are covered by the standard tests.</li>
</ul>
</body>
</html>
......@@ -6,7 +6,7 @@
module m_corespec
USE m_types
USE m_types_setup, ONLY: t_coreSpecInput
implicit none
......
......@@ -6,9 +6,11 @@
MODULE m_corespec_eval
USE m_corespec
USE m_types
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_constants
USE m_corespec
IMPLICIT NONE
......
......@@ -14,10 +14,12 @@ CONTAINS
!
!*********************************************************************
USE m_constants, ONLY : c_light
USE m_types_setup
USE m_types_mpi
USE m_types_enpara
USE m_xmlOutput
USE m_radsra
USE m_differ
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_enpara),INTENT(IN) :: enpara
......
......@@ -42,7 +42,7 @@ CONTAINS
DO jsp=1,input%jspins
!CALL tlmplm_cholesky(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi,vTot%mt(:,0,1,jsp),input,vTot%mmpMat, td,ud)
CALL tlmplm_cholesky(sphhar,atoms,noco,enpara,jsp,jsp,mpi,vTot,input,td,ud)
IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,1,jsp,input%jspins)
IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,jsp,jsp,input%jspins)
END DO
CALL timestop("tlmplm")
......
......@@ -23,10 +23,10 @@ CONTAINS
SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco,input,kpts,oneD,vTot,enpara,results)
USE m_types
USE m_eig66_io, ONLY : read_eig,write_eig
USE m_spnorb
USE m_alineso
USE m_types
USE m_judft
#ifdef CPP_MPI
USE m_mpi_bc_pot
......
......@@ -5,9 +5,6 @@ CONTAINS
SUBROUTINE ssomat(seigvso,theta,phi,eig_id,DIMENSION,atoms,kpts,sym,&
cell,noco, input,mpi, oneD,enpara,v,results )
USE m_eig66_io
USE m_spnorb
USE m_abcof
USE m_types_mat
USE m_types_setup
USE m_types_mpi
......@@ -19,6 +16,9 @@ CONTAINS
USE m_types_usdus
USE m_types_lapw
USE m_constants
USE m_eig66_io
USE m_spnorb
USE m_abcof
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
......
......@@ -2,7 +2,13 @@ hdf5_version=1.10.2
if [ ! -r CMake-hdf5-${hdf5_version} ]
then
#Get the file with the code
curl -LO "http://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-${hdf5_version}/src/CMake-hdf5-${hdf5_version}.tar.gz"
curl -LO "https://github.com/MRedies/hdf5-mirror/raw/master/CMake-hdf5-${hdf5_version}.tar.gz"
if [ ! -f CMake-hdf5-${hdf5_version}.tar.gz]; then
echo "No file found try source"
curl -LO "http://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-${hdf5_version}/src/CMake-hdf5-${hdf5_version}.tar.gz"
fi
tar xzf CMake-hdf5-${hdf5_version}.tar.gz
cd CMake-hdf5-${hdf5_version}
#copy options.cmake to adjust settings for compilation
......
......@@ -2,19 +2,18 @@ libxc_version=4.2.1
if [ ! -d libxc-${libxc_version} ]
then
#Get the file with the code
curl --speed-time 15 --speed-limit 1000 -LO "http://www.tddft.org/programs/octopus/download/libxc/${libxc_version}/libxc-${libxc_version}.tar.gz"
# tddft.org is always offline. Hence a backup:
curl --connect-timeout 10 -LO "https://github.com/MRedies/libxc-mirror/raw/master/libxc-${libxc_version}.tar.gz"
if [ ! -f libxc-${libxc_version}.tar.gz ]; then
echo "No file found, try mirror"
curl --connect-timeout 10 -LO "https://github.com/MRedies/libxc-mirror/raw/master/libxc-4.2.1.tar.gz"
echo "No file found try source"
curl --connect-timeout 10 -LO "http://www.tddft.org/programs/octopus/download/libxc/${libxc_version}/libxc-${libxc_version}.tar.gz"
fi
tar xzf libxc-${libxc_version}.tar.gz
cd libxc-${libxc_version}
#Compile&test (This will take a while)
./configure --prefix=$PWD/INSTALL_DIR
make
make -j
make install
else
cd libxc-${libxc_version}
......
......@@ -6,7 +6,7 @@ MODULE m_fergwt
! c.l.fu
!*****************************************************************
CONTAINS
SUBROUTINE fergwt(kpts,input,mpi, ne,eig, results)
SUBROUTINE fergwt(kpts,input,mpi, ne,eig, ef,w_iks,seigv)
USE m_constants
USE m_types
......@@ -15,7 +15,8 @@ CONTAINS
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_results),INTENT(INOUT):: results
REAL, INTENT(INOUT) :: ef,seigv
REAL,INTENT(INOUT) :: w_iks(:,:,:)
! ..
! ..
! .. Array Arguments ..
......@@ -45,7 +46,7 @@ CONTAINS
nbnd = ne(k,jspin)
DO i = 1,nbnd
en = eig(i,k,jspin)
de = (en-results%ef)/input%delgau
de = (en-ef)/input%delgau
wt = 2.0
IF (de.GT.eup) wt = 0.0
IF (de.GE.elow .AND. de.LE.eup) THEN
......@@ -56,7 +57,7 @@ CONTAINS
END IF
END IF
s = s + wt*wtk
results%w_iks(i,k,jspin) = wt/2.
w_iks(i,k,jspin) = wt/2.
ENDDO
ENDDO
ENDDO
......@@ -65,22 +66,22 @@ CONTAINS
IF (ABS(zcdiff).LT.eps) EXIT conv_loop
IF (ifl.EQ.0) THEN
ifl = 1
ef0 = results%ef
results%ef = results%ef + 0.003
ef0 = ef
ef = ef + 0.003
s0 = s
ELSE
fac = (s0-s)/ (input%zelec-s)
IF (ABS(fac).LT.1.0e-1) THEN
ef0 = results%ef
ef0 = ef
s0 = s
IF (zcdiff.GE.zero) THEN
results%ef = results%ef + 0.003
ef = ef + 0.003
ELSE
results%ef = results%ef - 0.003
ef = ef - 0.003
END IF
ELSE
ef1 = results%ef
results%ef = results%ef + (ef0-results%ef)/fac
ef1 = ef
ef = ef + (ef0-ef)/fac
ef0 = ef1
s0 = s
END IF
......@@ -90,10 +91,10 @@ CONTAINS
IF ( mpi%irank == 0 ) WRITE (6,FMT=8000) eps
8000 FORMAT (10x,'warning: eps has been increased to',e12.5)
ENDDO conv_loop
workf = -hartree_to_ev_const*results%ef
workf = -hartree_to_ev_const*ef
IF ( mpi%irank == 0 ) THEN
WRITE (16,FMT=8010) results%ef,workf,s
WRITE (6,FMT=8010) results%ef,workf,s
WRITE (16,FMT=8010) ef,workf,s
WRITE (6,FMT=8010) ef,workf,s
END IF
8010 FORMAT (/,10x,'fermi energy=',f10.5,' har',3x,'work function=',&
f10.5,' ev',/,10x,'number of valence electrons=',f10.5)
......@@ -108,22 +109,21 @@ CONTAINS
nbnd = ne(k,jspin)
IF ( mpi%irank == 0 ) WRITE (6,FMT=8030) k
8030 FORMAT (/,5x,'k-point=',i5,/)
results%w_iks(:,k,jspin) = kpts%wtkpt(k)*results%w_iks(:,k,jspin)
IF ( mpi%irank == 0) WRITE (6,FMT=8040) (results%w_iks(i,k,jspin),i=1,nbnd)
w_iks(:,k,jspin) = kpts%wtkpt(k)*w_iks(:,k,jspin)
IF ( mpi%irank == 0) WRITE (6,FMT=8040) (w_iks(i,k,jspin),i=1,nbnd)
8040 FORMAT (5x,16f6.3)
ENDDO
ENDDO
s1 = 0.
s2 = 0.
results%seigv = 0.
DO jspin = 1,input%jspins
s = 0.
DO k = 1,kpts%nkpt
DO i = 1,ne(k,jspin)
s = s + results%w_iks(i,k,jspin)
results%seigv = results%seigv + results%w_iks(i,k,jspin)*eig(i,k,jspin)
s = s + w_iks(i,k,jspin)
seigv = seigv + w_iks(i,k,jspin)*eig(i,k,jspin)
en = eig(i,k,jspin)
de = (en-results%ef)/input%delgau
de = (en-ef)/input%delgau
! ---> correction term
IF (ABS(de).LT.3.) THEN
de = de*de
......@@ -133,12 +133,12 @@ CONTAINS
ENDDO
s1 = s1 + s
ENDDO
results%seigv = (2/input%jspins)*results%seigv
seigv = (2/input%jspins)*seigv
seigv1 = (1/input%jspins)*fact1*s2
chmom = s1 - input%jspins*s
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8050) results%seigv - seigv1,s1,chmom
WRITE (16,FMT=8050) results%seigv - seigv1,s1,chmom
WRITE (6,FMT=8050) seigv - seigv1,s1,chmom
WRITE (16,FMT=8050) seigv - seigv1,s1,chmom
END IF
8050 FORMAT (/,10x,'sum of eigenvalues-correction=',f12.5,/,10x,&
'sum of weight =',f12.5,/,10x,&
......
......@@ -6,8 +6,8 @@
MODULE m_ferhis
CONTAINS
SUBROUTINE ferhis(input,kpts,mpi,results, index,idxeig,idxkpt,idxjsp,n,&
nstef,ws,spindg,weight, e,ne,we, noco,cell)
SUBROUTINE ferhis(input,kpts,mpi, index,idxeig,idxkpt,idxjsp,n,&
nstef,ws,spindg,weight, e,ne,we, noco,cell,ef,seigv,w_iks,results)
!***********************************************************************
!
! This subroutine determines the fermi energy and the sum of the
......@@ -65,6 +65,8 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: n ,nstef
REAL,INTENT(IN) :: spindg,ws,weight
REAL,INTENT(INOUT) :: ef,seigv
REAL,INTENT(OUT) :: w_iks(:,:,:)
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: idxeig(:)!(dimension%neigd*kpts%nkpt*dimension%jspd)
......@@ -124,9 +126,9 @@ CONTAINS
WRITE (6,FMT='(''FERHIS: Fermi-Energy by histogram:'')')
END IF
efermi = results%ef
efermi = ef
IF (nstef.LT.n) THEN
gap = e(INDEX(nstef+1)) - results%ef
gap = e(INDEX(nstef+1)) - ef
results%bandgap = gap*hartree_to_ev_const
IF ( mpi%irank == 0 ) THEN
attributes = ''
......@@ -156,9 +158,9 @@ CONTAINS
!
!---> STATES ABOVE EF AVAILABLE
!
results%ef = 0.5* (e(INDEX(nstef+1))+results%ef)
emax = results%ef + 8.0*tkb
emin = results%ef - 8.0*tkb
ef = 0.5* (e(INDEX(nstef+1))+ef)
emax = ef + 8.0*tkb
emin = ef - 8.0*tkb
w_near_ef = 0.0
w_below_emin = 0.0
inkem = 0
......@@ -187,11 +189,11 @@ CONTAINS
!---> ADJUST FERMI-ENERGY BY NEWTON-METHOD
!
nocst = ink - 1
CALL ef_newton(n,mpi%irank, inkem,nocst,index,tkb,e, w_near_ef,results%ef,we)
CALL ef_newton(n,mpi%irank, inkem,nocst,index,tkb,e, w_near_ef,ef,we)
!
IF ( mpi%irank == 0 ) THEN
WRITE (16,FMT=8030) results%ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
WRITE (6,FMT=8030) results%ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
WRITE (16,FMT=8030) ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
WRITE (6,FMT=8030) ef,spindg*weight, spindg*w_below_emin,spindg* (w_below_emin+w_near_ef)
END IF
ELSE
......@@ -201,7 +203,7 @@ CONTAINS
IF ( mpi%irank == 0 ) WRITE (6,FMT=8020)
nocst = nstef
we(INDEX(nocst)) = we(INDEX(nocst)) - wfermi
results%ef = efermi
ef = efermi
tkb = 0.0
END IF
ELSE
......@@ -231,11 +233,11 @@ CONTAINS
!=======> DETERMINE OCCUPATION NUMBER AND WEIGHT OF EIGENVALUES
! FOR EACH K_POINT
!
results%w_iks(:,:,:) = 0.0
w_iks(:,:,:) = 0.0
IF ( mpi%irank == 0 ) WRITE (6,FMT=8080) nocst
DO i=1,nocst
results%w_iks(idxeig(INDEX(i)),idxkpt(INDEX(i)),idxjsp(INDEX(i))) = we(INDEX(i))
w_iks(idxeig(INDEX(i)),idxkpt(INDEX(i)),idxjsp(INDEX(i))) = we(INDEX(i))
ENDDO
!
!======> CHECK SUM OF VALENCE WEIGHTS
......@@ -244,7 +246,7 @@ CONTAINS
wvals = 0.0
DO js = 1,nspins
DO k = 1,kpts%nkpt
wvals = wvals + SUM(results%w_iks(:ne(k,js),k,js))
wvals = wvals + SUM(w_iks(:ne(k,js),k,js))
ENDDO
ENDDO
......@@ -268,7 +270,7 @@ CONTAINS
DO js = 1,nspins
DO kpt = 1 , kpts%nkpt
DO nocc=1,ne(kpt,js)
fermikn = results%w_iks(nocc,kpt,js)/kpts%wtkpt(kpt)
fermikn = w_iks(nocc,kpt,js)/kpts%wtkpt(kpt)
IF ( fermikn .GT. 0.0 .AND. fermikn .LT. 1.0 ) &
entropy = entropy + kpts%wtkpt(kpt) * ( fermikn * LOG( fermikn) + ( 1.0 - fermikn) * LOG( 1.0 - fermikn) )
END DO
......@@ -285,13 +287,13 @@ CONTAINS
!
!
results%seigv = spindg*DOT_PRODUCT(e(INDEX(:nocst)),we(INDEX(:nocst)))
seigv = seigv+spindg*DOT_PRODUCT(e(INDEX(:nocst)),we(INDEX(:nocst)))
IF (mpi%irank == 0) THEN
attributes = ''
WRITE(attributes(1),'(f20.10)') results%seigv
WRITE(attributes(1),'(f20.10)') seigv
WRITE(attributes(2),'(a)') 'Htr'
CALL writeXMLElement('sumValenceSingleParticleEnergies',(/'value','units'/),attributes)
WRITE (6,FMT=8040) results%seigv
WRITE (6,FMT=8040) seigv
END IF
......
......@@ -55,9 +55,9 @@ CONTAINS
!REAL, INTENT (OUT):: w(:,:,:) !(dimension%neigd,kpts%nkpt,dimension%jspd)
! ..
! .. Local Scalars ..
REAL del ,spindg,ssc ,ws,zc,tkb_1,weight
REAL del ,spindg,ssc ,ws,zc,weight,efermi,seigv
INTEGER i,idummy,j,jsp,k,l,n,nbands,nstef,nv,nmat,nspins
INTEGER n_help
INTEGER n_help,m_spins,mspin,sslice(2)
! ..
! .. Local Arrays ..
!
......@@ -138,83 +138,121 @@ CONTAINS
WRITE(attributes(5),'(f15.8)') kpts%bk(3,k)
CALL writeXMLElementPoly('eigenvaluesAt',(/'spin','ikpt','k_x ','k_y ','k_z '/),attributes,eig(1:ne(k,jsp),k,jsp))
END IF
nv= -1
!
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE
!---> CONECTION TO THE ORIGINAL ARRAYS
!
DO j = 1,ne(k,jsp)
e(n+j) = eig(j,k,jsp)
we(n+j) = kpts%wtkpt(k)
idxeig(n+j) = j+n_help
idxkpt(n+j) = k
idxjsp(n+j) = jsp
END DO
!---> COUNT THE NUMBER OF EIGENVALUES
n = n + ne(k,jsp)
END DO
END DO
ENDDO
!finished reading of eigenvalues
IF (mpi%irank == 0) CALL closeXMLElement('eigenvalues')
CALL sort(n,e,index)
! Check if no deep eigenvalue is found
IF (e_min-MINVAL(e(1:n))>1.0) THEN
WRITE(6,*) 'WARNING: Too low eigenvalue detected:'
WRITE(6,*) 'min E=', MINVAL(e(1:n)),' min(enpara)=',&
& e_min
CALL juDFT_warn("Too low eigenvalue detected",calledby="fermi" &
& ,hint ="If the lowest eigenvalue is more than 1Htr below "//&
& "the lowest energy parameter, you probably have picked up"//&
& " a ghoststate")
IF (ABS(input%fixed_moment)<1E-6) THEN
!this is a standard calculation
m_spins=1
else
!total moment is fixed
m_spins=2
END IF
!
!---> DETERMINE EF BY SUMMING WEIGHTS
!
weight = input%zelec/spindg
results%seigv = 0.0e0
ws = 0.0e0
l = 0
DO WHILE ((ws+del).LT.weight)
l = l + 1
IF (l.GT.n) THEN
IF ( mpi%irank == 0 ) THEN
WRITE (16,FMT=8010) n,ws,weight
WRITE (6,FMT=8010) n,ws,weight
do mspin=1,m_spins
IF (m_spins == 1) THEN
sslice = (/1,nspins/)
ELSE
sslice = (/mspin,mspin/)
nspins = 1
ENDIF
n = 0
DO jsp = sslice(1),sslice(2)
!Generate a list of energies
DO k = 1,kpts%nkpt
!
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMOR