...
 
Commits (1167)
docs/mkdocs/site
init/compileinfo.h
io/xml/inputSchema.h
Testing/*
*~
\#*
build
build.*
*.o
*.mod
*.x
*.swp
tags
.DS_Store
.vscode
stages:
- build
- test
- coverage
- html
- deploy
- build-pgi
- test-pgi
- build-intel
- test-intel
build-gfortran-hdf5:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: build
cache:
artifacts:
paths:
- build
expire_in: 1h
script:
- cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make
- cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make -j 4
# only:
# - schedules
# - triggers
......@@ -25,9 +22,6 @@ build-gfortran-hdf5:
test-gfortran-hdf5:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: test
cache:
paths:
- build
script:
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";export OMP_NUM_THREADS=4;cd /builds/fleur/fleur/build;ctest
artifacts:
......@@ -43,64 +37,99 @@ test-gfortran-hdf5:
pages:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: deploy
cache:
script:
- echo "HTML should be ready from cache..."
- mv /builds/fleur/fleur/docs/Docu_main.html /builds/fleur/fleur/public/index.html
environment:
name: HTML-Pages
url: https://fleur.iffgit.fz-juelich.de/fleur
artifacts:
paths:
- build
- public
only:
- web
doxygen:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: html
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
- mkdir ../public
- mv docs/html/ ../public/doxygen
artifacts:
paths:
- public
- build/fleur
- build/fleur_MPI
- build/inpgen
only:
- web
build-pgi:
image: iffregistry.fz-juelich.de/fleur/fleur:pgi
stage: build
artifacts:
paths:
- build.pgi
expire_in: 1h
script:
- cd /builds/fleur/fleur; ./configure.sh -l pgi ; cd build.pgi; make
allow_failure: true
only:
- schedules
- triggers
- web
#build-pgi:
# image: iffregistry.fz-juelich.de/fleur/fleur:pgi
# stage: build-pgi
# cache:
# paths:
# - build.debug
# script:
# - cd /builds/fleur/fleur; ./configure.sh -d AUTO ; cd build.debug; make
# only:
# - schedules
# - triggers
# - web
test-pgi:
image: iffregistry.fz-juelich.de/fleur/fleur:pgi
stage: test
dependencies:
- build-pgi
script:
- cd /builds/fleur/fleur/build.pgi;ctest
allow_failure: true
only:
- schedules
- web
- triggers
build-intel-static:
image: iffregistry.fz-juelich.de/fleur/fleur:intel-static
stage: build
artifacts:
paths:
- build.intel-static
expire_in: 1h
script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; ./configure.sh -l intel-static INTEL_DOCKER_STATIC ; cd build.intel-static; make -j 4
artifacts:
when: on_success
paths:
- build.intel-static/fleur
- build.intel-static/fleur_MPI
- build.intel-static/inpgen
allow_failure: true
only:
- schedules
- triggers
- web
#test-pgi:
# image: iffregistry.fz-juelich.de/fleur/fleur:pgi
# stage: test-pgi
# cache:
# paths:
# - build.debug
# script:
# - cd /builds/fleur/fleur/build.debug;ctest
# only:
# - schedules
# - web
# - triggers
build-intel:
image: iffregistry.fz-juelich.de/docker-images/centos7-intel-compilers/extended
stage: build-intel
cache:
image: iffregistry.fz-juelich.de/fleur/fleur:intel-static
stage: build
artifacts:
paths:
- build.intel
- build.intel.debug
expire_in: 1h
script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -l intel INTEL_MPI ; cd build.intel; make
- cd /builds/fleur/fleur; CC=gcc FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -d -l intel INTEL_MPI ; cd build.intel.debug; make -j 4
allow_failure: true
only:
- schedules
- triggers
......@@ -108,19 +137,19 @@ build-intel:
test-intel:
image: iffregistry.fz-juelich.de/docker-images/centos7-intel-compilers/extended
stage: test-intel
cache:
paths:
- build.intel
image: iffregistry.fz-juelich.de/fleur/fleur:intel-static
stage: test
dependencies:
- build-intel
script:
- set +e && source compilervars.sh intel64 && set -e; ulimit -s unlimited
- cd /builds/fleur/fleur/build.intel;ctest
- cd /builds/fleur/fleur/build.intel.debug;ctest
allow_failure: true
artifacts:
when: on_failure
paths:
- build/Testing/failed
- build/Testing/test.oldlogs
- build.intel.debug/Testing/failed
- build.intel.debug/Testing/test.oldlogs
only:
- schedules
- web
......@@ -128,18 +157,16 @@ test-intel:
gfortran-coverage:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: coverage
cache:
paths:
- build
stage: html
script:
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make -j 4
- 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
allow_failure: true
artifacts:
paths:
- public
......@@ -148,4 +175,4 @@ gfortran-coverage:
url: https://fleur.iffgit.fz-juelich.de/fleur/coverage_html
only:
- web
- schedules
\ No newline at end of file
# Summary
<!-- Summarize the bug encountered concisely. -->
## Input and output file:
<!--Please provide at least the inp.xml and the out files produced. -->
## Compute environment
<!-- Please shortly describe the machine&compiler you use. -->
## This is BUG because:
<!-- Please indicate the correct behaviour you expect. -->
## The problem only occurs if:
<!-- Please indicate if you checked if the bug only occurs if, e.g. you run on a specific machine,
in MPI mode, with several OpenMP task, you use LOs or SOC or ... -->
## Console output and other logs
<!-- Paste any relevant logs - please use code blocks (```) to format console output,
logs, and code as it's very hard to read otherwise. -->
## Ideas for fixes
<!-- If you can, give hints that that might help fixing the problem. -->
<!-- Please choose an appropriate label like: ~Bug ~"Critial Bug" . -->
/label ~Bug
# Summary
<!-- Summarize the problem encountered concisely. -->
## Machine
<!-- Please describe the machine you use. -->
## Compiler
<!-- Please describe the compiler you use. -->
## Libraries
<!-- Please describe any specific libraries you use. -->
## Version you try to compile
<!-- Best is to use 'git describe' on the source code and paste the output here. -->
## Command line
<!-- Please give the command line of the configure script you use and of any corresponding environment variables you set -->
## Console output and other logs
<!-- Paste any relevant logs - please use code blocks (```) to format console output,
logs, and code as it's very hard to read otherwise. -->
## Further comments
\label ~"Compilation related"
\ No newline at end of file
# Summary
<!-- Summarize the feature concisely. -->
## Why is this feature needed?
<!-- Please describe the usecase. -->
## Implementation ideas
<!-- If yoy have ideas how the feature should be realized share them. -->
\label ~"Feature Request"
\ No newline at end of file
[submodule "external/hdf5-git"]
path = external/hdf5-git
url = https://bitbucket.hdfgroup.org/scm/hdffv/hdf5.git
[submodule "external/libxc-git"]
path = external/libxc-git
url = https://gitlab.com/libxc/libxc.git
[submodule "docs/katacoda-tutorials"]
path = docs/katacoda-tutorials
url = gitlab@iffgit.fz-juelich.de:fleur/katacoda-tutorials.git
[submodule "external/wannier90"]
path = external/wannier90
url = https://github.com/wannier-developers/wannier90.git
......@@ -10,12 +10,17 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${tmp}")
include("cmake/CompilerConfig.txt")
include("cmake/ReportConfig.txt")
include("cmake/Generate_Schema.cmake")
include("cmake/Files_and_Targets.txt")
include("cmake/filespecific.cmake")
include("cmake/ReportConfig.txt")
#install(TARGETS fleur inpgen DESTINATION bin)
install(PROGRAMS ${CMAKE_BINARY_DIR}/fleur
CONFIGURATIONS Debug
......
This diff is collapsed.
......@@ -88,14 +88,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#endif
! Local Scalars
INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp
INTEGER :: ikpt,ikpt_i,jsp_start,jsp_end,ispin,jsp
INTEGER :: iErr,nbands,noccbd,iType
INTEGER :: skip_t,skip_tt,nStart,nEnd,nbasfcn
INTEGER :: skip_t,skip_tt,nbasfcn
LOGICAL :: l_orbcomprot, l_real, l_dosNdir, l_corespec
! Local Arrays
REAL, ALLOCATABLE :: we(:)
REAL, ALLOCATABLE :: eig(:)
REAL,ALLOCATABLE :: we(:),eig(:)
INTEGER,ALLOCATABLE :: ev_list(:)
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
TYPE (t_lapw) :: lapw
......@@ -134,7 +134,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end)
! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet.
! density without the atomic sphere approximation for the magnet. density. It is not completely implemented (lo's missing).
CALL denCoeffsOffdiag%init(atoms,noco,sphhar,.FALSE.)
CALL denCoeffsOffdiag%init(atoms,noco,sphhar,noco%l_mtnocopot)
CALL force%init1(input,atoms)
CALL orb%init(atoms,noco,jsp_start,jsp_end)
......@@ -154,7 +154,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin
WRITE (16,FMT=8000) jspin
CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
END IF
8000 FORMAT (/,/,10x,'valence density: spin=',i2)
......@@ -172,36 +171,28 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
ALLOCATE (we(MAXVAL(cdnvalJob%noccbd(:))))
ALLOCATE (eig(MAXVAL(cdnvalJob%noccbd(:))))
jsp = MERGE(1,jspin,noco%l_noco)
DO ikpt = cdnvalJob%ikptStart, cdnvalJob%nkptExtended, cdnvalJob%ikptIncrement
jsp = MERGE(1,jspin,noco%l_noco)
IF (ikpt.GT.kpts%nkpt) THEN
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
EXIT
END IF
DO ikpt_i = 1,size(cdnvalJob%k_list)
ikpt=cdnvalJob%k_list(ikpt_i)
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt
noccbd = cdnvalJob%noccbd(ikpt)
nStart = cdnvalJob%nStart(ikpt)
nEnd = cdnvalJob%nEnd(ikpt)
we(1:noccbd) = cdnvalJob%weights(1:noccbd,ikpt)
eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp)
ev_list=cdnvaljob%compact_ev_list(ikpt_i,banddos%dos)
noccbd = SIZE(ev_list)
we = cdnvalJob%weights(ev_list,ikpt)
eig = results%eig(ev_list,ikpt,jsp)
IF (cdnvalJob%l_evp) THEN
IF (nStart > skip_tt) skip_t = 0
IF (nEnd <= skip_tt) skip_t = noccbd
IF ((nStart <= skip_tt).AND.(nEnd > skip_tt)) skip_t = mod(skip_tt,noccbd)
IF (minval(ev_list) > skip_tt) skip_t = 0
IF (maxval(ev_list) <= skip_tt) skip_t = noccbd
IF ((minval(ev_list) <= skip_tt).AND.(maxval(ev_list) > skip_tt)) skip_t = mod(skip_tt,noccbd)
END IF
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
CALL zMat%init(l_real,nbasfcn,noccbd)
CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat)
CALL read_eig(eig_id,ikpt,jsp,list=ev_list,neig=nbands,zmat=zMat)
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
......@@ -214,13 +205,13 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
! valence density in the interstitial region
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,den,results,force%f_b8,zMat,dos)
jspin,lapw,noccbd,ev_list,we,eig,den,results,force%f_b8,zMat,dos)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab,oneD,zMat)
! valence density in the vacuum region
IF (input%film) THEN
CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac,eig,den,zMat,dos)
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos)
END IF
END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
......@@ -236,21 +227,20 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
! perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF (l_dosNdir) THEN
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ev_list,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
IF (PRESENT(orbcomp)) CALL orb_comp(ispin,ikpt,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
IF (banddos%l_orb.AND.ANY((/banddos%alpha,banddos%beta,banddos%gamma/).NE.0.0)) THEN
CALL abcrot2(atoms,banddos,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
IF (PRESENT(orbcomp)) CALL orb_comp(ispin,ikpt,noccbd,ev_list,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END IF
ENDIF
CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
......@@ -274,9 +264,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO
#endif
IF (mpi%irank==0) THEN
CALL cdnmt(input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
CALL cdnmt(mpi,input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF (mpi%irank==0) THEN
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
DO ispin = jsp_start,jsp_end
IF (input%cdinf) THEN
......
......@@ -23,7 +23,7 @@ MODULE m_eparas
!***********************************************************************
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
IMPLICIT NONE
......@@ -39,6 +39,7 @@ CONTAINS
INTEGER, INTENT (IN) :: noccbd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t
LOGICAL, INTENT (IN) :: l_mcd,l_evp
INTEGER, INTENT (IN) :: ev_list(noccbd)
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: eig(:)!(dimension%neigd),
......@@ -98,7 +99,7 @@ CONTAINS
DO icore = 1, mcd%ncore(n)
DO ipol = 1, 3
index = 3*(n-1) + ipol
mcd%mcd(index,icore,i,ikpt,jsp)=mcd%mcd(index,icore,i,ikpt,jsp) + fac*(&
mcd%mcd(index,icore,ev_list(i),ikpt,jsp)=mcd%mcd(index,icore,ev_list(i),ikpt,jsp) + fac*(&
suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +&
......@@ -107,7 +108,7 @@ CONTAINS
ENDDO
ENDIF ! end MCD
ENDDO
dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
dos%qal(l,n,ev_list(i),ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO
nt1 = nt1 + atoms%neq(n)
ENDDO
......@@ -120,8 +121,8 @@ CONTAINS
DO l = 0,3
DO n = 1,atoms%ntype
DO i = (skip_t+1),noccbd
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)
ENDDO
ENDDO
ENDDO
......@@ -174,7 +175,7 @@ CONTAINS
! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE
DO i = 1,ne
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) )
END DO
DO lop = 1,atoms%nlo(ntyp)
......@@ -182,7 +183,7 @@ CONTAINS
DO i = 1,ne
regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
ENDDO
ENDIF
......
......@@ -34,7 +34,7 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iAtom) + &
noco%qss(2)*atoms%taual(2,iAtom) + &
noco%qss(3)*atoms%taual(3,iAtom) )
noco_new%alph(iType) = noco%alph(iType) - alphdiff
noco_new%alph(iType) = noco_new%alph(iType) - alphdiff
DO WHILE (noco_new%alph(iType) > +pi_const)
noco_new%alph(iType)= noco_new%alph(iType) - 2.0*pi_const
END DO
......@@ -42,12 +42,12 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
noco_new%alph(iType)= noco_new%alph(iType) + 2.0*pi_const
END DO
ELSE
noco_new%alph(iType) = noco%alph(iType)
noco_new%alph(iType) = noco_new%alph(iType)
END IF
iatom= iatom + atoms%neq(iType)
END DO
OPEN (24,file='nocoinp',form='formatted', status='old')
OPEN (24,file='nocoinp',form='formatted', status='unknown')
REWIND (24)
CALL rw_noco_write(atoms,noco_new, input)
CLOSE (24)
......
......@@ -57,11 +57,9 @@ CONTAINS
my = 2*AIMAG(qa21(itype))
mz = chmom(itype,1) - chmom(itype,2)
WRITE (6,8025) mx,my
WRITE (16,8025) mx,my
!---> determine the polar angles of the moment vector in the local frame
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8026) betah,alphh
WRITE (16,8026) betah,alphh
8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5)
8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,&
& ' delta alpha=',f9.5)
......@@ -79,9 +77,7 @@ CONTAINS
mz = rho11 - rho22
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (16,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (6,8028) betah,alphh-alphdiff
WRITE (16,8028) betah,alphh-alphdiff
8027 FORMAT(2x,'-->',10x,' input noco%beta=',f9.5, ' input noco%alpha=',f9.5)
8028 FORMAT(2x,'-->',10x,'output noco%beta=',f9.5, ' output noco%alpha=',f9.5)
......@@ -96,7 +92,6 @@ CONTAINS
my_mix = 2*AIMAG(rho21)
mz_mix = rho11 - rho22
WRITE (6,8031) mx_mix,my_mix
WRITE (16,8031) mx_mix,my_mix
8031 FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5)
! if magnetic moment (in local frame!) is negative, direction of quantization
! has to be antiparallel!
......@@ -109,7 +104,6 @@ CONTAINS
! calculate angles alpha and beta in global frame
CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh)
WRITE (6,8029) betah,alphh-alphdiff
WRITE (16,8029) betah,alphh-alphdiff
8029 FORMAT(2x,'-->',10x,' new noco%beta =',f9.5, ' new noco%alpha =',f9.5)
noco%alph(itype) = alphh
noco%beta(itype) = betah
......@@ -129,9 +123,7 @@ CONTAINS
b_con_outy = scale*my
!---> mix input and output constraint fields
WRITE (6,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (16,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (6,8200) b_con_outx,b_con_outy
WRITE (16,8200) b_con_outx,b_con_outy
noco%b_con(1,itype) = noco%b_con(1,itype) + noco%mix_b*b_con_outx
noco%b_con(2,itype) = noco%b_con(2,itype) + noco%mix_b*b_con_outy
ENDIF
......
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne,we,eig,den,results,f_b8,zMat,dos)
ikpt,jspin,lapw,ne,ev_list,we,eig,den,results,f_b8,zMat,dos)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -98,6 +98,7 @@ CONTAINS
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
INTEGER, INTENT(IN) :: ev_list(ne)
!-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne
!-----> CHARGE DENSITY INFORMATION
......@@ -494,7 +495,7 @@ CONTAINS
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell,istr,x)
dos%qis(nu,ikpt,1) = dos%qis(nu,ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
dos%qis(ev_list(nu),ikpt,1) = dos%qis(ev_list(nu),ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
cwk=0.0
......@@ -504,7 +505,7 @@ CONTAINS
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell, istr, x)
dos%qis(nu,ikpt,input%jspins) = dos%qis(nu,ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
dos%qis(ev_list(nu),ikpt,input%jspins) = dos%qis(ev_list(nu),ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
ENDIF
ELSE
......@@ -677,7 +678,6 @@ CONTAINS
ENDDO
ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
WRITE (16,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
CALL juDFT_warn('pwden: bad quality of charge')
ENDIF
ENDIF
......
......@@ -122,7 +122,7 @@
END SUBROUTINE pwint
SUBROUTINE pwint_all(&
& stars,atoms,sym,oneD,&
& cell,&
& cell,x_start,x_end,&
& x)
USE m_spgrot
......@@ -138,6 +138,7 @@
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
INTEGER, INTENT (IN) :: x_start,x_end
COMPLEX, INTENT (OUT):: x(:)
! ..
!-odim
......@@ -159,7 +160,7 @@
!$OMP PARALLEL DO default(shared) &
!$OMP PRIVATE(ng,ig3d,g,gr,fj,ig2d,s,na,kr,ph,n)&
!$OMP PRIVATE(srmt,nn,sfs,arg,s1,ii)
starloop:DO ng=1,size(x)
starloop:DO ng=x_start,x_end
ig3d = stars%ig(stars%kv3(1,ng),stars%kv3(2,ng),stars%kv3(3,ng))
IF (ig3d.EQ.0) THEN
x(ng) = (0.,0.)
......
MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,ikpt,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)
SUBROUTINE q_int_sl(isp,ikpt,stars,atoms,sym,cell,ne,ev_list,lapw,slab,oneD,zMat)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
......@@ -24,6 +24,9 @@ CONTAINS
!
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,isp,ikpt
INTEGER, INTENT (IN) :: ev_list(ne)
! ..
! .. Local Scalars ..
REAL q1,zsl1,zsl2,qi,volsli,volintsli
......@@ -105,7 +108,7 @@ CONTAINS
DO j = 1,stars%ng3
qi = qi + z_z(j)*stfunint(j,i)
ENDDO
slab%qintsl(i,n,ikpt,isp) = qi
slab%qintsl(i,ev_list(n),ikpt,isp) = qi
ENDDO ! over vacuum%layers
ENDDO ! over states
......
......@@ -8,7 +8,7 @@ CONTAINS
!
!***********************************************************************
!
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ev_list,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab
......@@ -21,6 +21,9 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd
INTEGER, INTENT (IN) :: ev_list(nobd)
! ..
! .. Local Scalars ..
INTEGER i,l,lo ,natom,nn,ntyp,nt1,nt2,m
......@@ -136,7 +139,7 @@ CONTAINS
DO ntyp = 1,atoms%ntype
qq = qq + qmttot(ntyp,i)*slab%nmtsl(ntyp,nl)
ENDDO
slab%qmtsl(nl,i,ikpt,jsp) = qq
slab%qmtsl(nl,ev_list(i),ikpt,jsp) = qq
ENDDO
ENDDO
! DO ntyp = 1,ntype
......
......@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
SUBROUTINE qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_types_setup
USE m_types_dos
......@@ -25,6 +25,8 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,ikpt
INTEGER, INTENT (IN) :: ev_list(noccbd)
! .. Local Scalars ..
INTEGER i,l,lo,lop ,natom,nn,ntyp
INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
......@@ -41,7 +43,7 @@ CONTAINS
! .. Intrinsic Functions ..
INTRINSIC conjg
qal21=0.0
!---> l-decomposed density for each occupied state
states : DO i = 1, noccbd
nt1 = 1
......@@ -152,10 +154,10 @@ CONTAINS
state : DO i = 1, noccbd
lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),&
dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
dos%qal(l,n,ev_list(i),ikpt,1),dos%qal(l,n,ev_list(i),ikpt,2),qal21(l,n,i))
IF (.FALSE.) THEN
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,i,ikpt,:)
q_loc(1,1) = dos%qal(l,n,i,ikpt,1); q_loc(2,2) = dos%qal(l,n,i,ikpt,2)
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,ev_list(i),ikpt,:)
q_loc(1,1) = dos%qal(l,n,ev_list(i),ikpt,1); q_loc(2,2) = dos%qal(l,n,ev_list(i),ikpt,2)
q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
q_loc = MATMUL(q_hlp,chi)
......
......@@ -133,6 +133,8 @@ CONTAINS
n1 = 1
DO in = 1 , nrm
n2 = mr(in)
bsl_r = 0.0
bsl_i = 0.0
DO j = 1,atoms%jri(n1)
cprr2 = cp*atoms%rmsh(j,n1)*atoms%rmsh(j,n1)
gr = stars%sk3(k)*atoms%rmsh(j,n1)
......
......@@ -15,6 +15,7 @@ c This subroutine rotates the direction of the magnetization of the
c density matrix by multiplying with the unitary 2x2 spin rotation
c matrix. --> U*rho*U^dagger
c Philipp Kurz 2000-02-03
c new method for improved stability (l_new=t) gb'19
c***********************************************************************
use m_constants
......@@ -28,11 +29,29 @@ C .. Scalar Arguments ..
C ..
C .. Local Scalars ..
INTEGER ispin
REAL eps
REAL eps,r11n,r22n
COMPLEX r21n
LOGICAL l_new
C ..
C .. Local Arrays ..
COMPLEX u2(2,2),rho(2,2),rhoh(2,2)
C ..
l_new = .true.
IF (l_new) THEN
r11n = 0.5*(1.0+cos(beta))*rho11 - sin(beta)*real(rho21) +
+ 0.5*(1.0-cos(beta))*rho22
r22n = 0.5*(1.0-cos(beta))*rho11 + sin(beta)*real(rho21) +
+ 0.5*(1.0+cos(beta))*rho22
r21n = CMPLX(cos(alph),-sin(alph))*(sin(beta)*(rho11-rho22) +
+ 2.0*(cos(beta)*real(rho21)-cmplx(0.0,aimag(rho21))))*0.5
rho11 = r11n
rho22 = r22n
rho21 = r21n
ELSE
eps = 1.0e-10
......@@ -66,21 +85,21 @@ c---> check wether the diagonal elements of the rotated density
c---> are real.
DO ispin = 1,2
IF (aimag(rho(ispin,ispin)).GT.eps) THEN
WRITE(16,8000)
WRITE( 6,8000)
CALL juDFT_error("rotation of mag. failed",calledby
+ ="rot_den_mat")
+ ="rot_den_mat",hint=
+ 'After the rotation of the density matrix in the '//
+ 'muffin-tin sphere one diagonal element of the '//
+ '(hermitian) density matrix is not real. That means '//
+ 'that the density matrix was probably damaged.')
ENDIF
ENDDO
8000 FORMAT('After the rotation of the density matrix in the'/
+ 'muffin-tin sphere one diagonal element of the'/
+ '(hermitian) density matrix is not real. That means'/
+ 'that the density matrix was probably damaged.')
rho11 = real(rho(1,1))
rho22 = real(rho(2,2))
rho21 = rho(2,1)
ENDIF
END SUBROUTINE rot_den_mat
END MODULE m_rotdenmat
......@@ -6,7 +6,7 @@ MODULE m_vacden
! *************************************************************
CONTAINS
SUBROUTINE vacden(vacuum,DIMENSION,stars,oneD,kpts,input,sym,cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vz,ne,lapw,evac,eig,den,zMat,dos)
gVacMap,we,ikpt,jspin,vz,ne,ev_list,lapw,evac,eig,den,zMat,dos)
!***********************************************************************
! ****** change vacden(....,q) for vacuum density of states shz Jan.96
......@@ -70,6 +70,7 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments ..
INTEGER, INTENT(IN) :: ev_list(ne)