Commit e3f1e60e authored by S.Rost's avatar S.Rost

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents f021ac12 c3bdffca
......@@ -91,7 +91,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp
INTEGER :: iErr,nbands,noccbd,iType
INTEGER :: skip_t,skip_tt,nStart,nEnd,nbasfcn
LOGICAL :: l_orbcomprot, l_real, l_write, l_dosNdir, l_corespec
LOGICAL :: l_orbcomprot, l_real, l_dosNdir, l_corespec
! Local Arrays
REAL, ALLOCATABLE :: we(:)
......@@ -159,10 +159,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END IF
8000 FORMAT (/,/,10x,'valence density: spin=',i2)
l_write = input%cdinf.AND.mpi%irank==0
DO iType = 1, atoms%ntype
DO ispin = jsp_start, jsp_end
CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,l_write,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin))
CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin))
END DO
IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
......
......@@ -24,6 +24,7 @@ eigen/rad_ovlp.f90
eigen/setabc1lo.f90
eigen/slomat.F90
eigen/tlmplm_cholesky.F90
eigen/tlmplm.F90
eigen/tlmplm_store.F90
eigen/tlo.f90
eigen/vacfun.f90
......
......@@ -376,8 +376,10 @@ CONTAINS
fl2p1(l) = REAL(l+l+1)/fpi_const
fl2p1bt(l) = fl2p1(l)*0.5
END DO
!$OMP PARALLEL DEFAULT(SHARED)&
!$OMP PRIVATE(kii,ki,ski,kj,plegend,l,kj_end)&
!$OMP PARALLEL DEFAULT(NONE)&
!$OMP SHARED(lapw,atoms,noco,mpi,input,usdus,smat,hmat)&
!$OMP SHARED(jintsp,iintsp,n,fleg1,fleg2,fj,gj,isp,fl2p1,el,e_shift,fl2p1bt,chi)&
!$OMP PRIVATE(kii,ki,ski,kj,plegend,l,kj_end,qssbti,qssbtj,fct2)&
!$OMP PRIVATE(cph,nn,tnn,fjkiln,gjkiln)&
!$OMP PRIVATE(w1,apw_lo1,apw_lo2,ddnln,elall,fct,apw1)&
!$OMP PRIVATE(capw1,VecHelpS,VecHelpH)
......
MODULE m_tlmplm
IMPLICIT NONE
!*********************************************************************
! sets up the local Hamiltonian, i.e. the Hamiltonian in the
! l',m',l,m,u- basis which is independent from k!
!*********************************************************************
CONTAINS
SUBROUTINE tlmplm(n,sphhar,atoms,enpara,&
jspin,jsp,mpi,v,input,td,ud)
USE m_constants
USE m_intgr, ONLY : intgr3
USE m_genMTBasis
USE m_tlo
USE m_gaunt, ONLY: gaunt1
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_tlmplm),INTENT(INOUT) :: td
TYPE(t_usdus),INTENT(INOUT) :: ud
INTEGER, INTENT (IN) :: n,jspin,jsp !atom index,physical spin&spin index for data
REAL dvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL dvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL f(atoms%jmtd,2,0:atoms%lmaxd),g(atoms%jmtd,2,0:atoms%lmaxd),x(atoms%jmtd)
REAL flo(atoms%jmtd,2,atoms%nlod)
INTEGER:: indt(0:SIZE(td%tuu,1)-1)
REAL vr0(SIZE(v%mt,1),0:SIZE(v%mt,2)-1)
COMPLEX :: cil
REAL :: temp
INTEGER i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl,lmplm,lmx,lmxx,lp,info,in
INTEGER lp1,lpl ,mem,mems,mp,mu,nh,na,m,nsym,s,i_u
vr0=v%mt(:,:,n,jsp)
IF (jsp<3) vr0(:,0)=0.0
CALL genMTBasis(atoms,enpara,v,mpi,n,jspin,ud,f,g,flo)
nsym = atoms%ntypsy(na)
nh = sphhar%nlh(nsym)
!
!---> generate the irreducible integrals (u(l'):v(lamda,nu:u(l))
!---> for l' .ge. l, but only those that will contribute
!
DO lp = 0,atoms%lmax(n)
lp1 = (lp* (lp+1))/2
DO l = 0,lp
lpl = lp1 + l
!---> loop over non-spherical components of the potential: must
!---> satisfy the triangular conditions and that l'+l+lamda even
!---> (conditions from the gaunt coefficient)
DO lh = 1, nh
lamda = sphhar%llh(lh,nsym)
lmin = lp - l
lmx = lp + l
IF ((mod(lamda+lmx,2).EQ.1) .OR. (lamda.LT.lmin) .OR. (lamda.GT.lmx)) THEN
uvu(lpl,lh) = 0.0
dvd(lpl,lh) = 0.0
uvd(lpl,lh) = 0.0
dvu(lpl,lh) = 0.0
ELSE
DO i = 1,atoms%jri(n)
x(i) = (f(i,1,lp)*f(i,1,l)+f(i,2,lp)*f(i,2,l))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
uvu(lpl,lh) = temp
DO i = 1,atoms%jri(n)
x(i) = (g(i,1,lp)*f(i,1,l)+g(i,2,lp)*f(i,2,l))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
dvu(lpl,lh) = temp
DO i = 1,atoms%jri(n)
x(i) = (f(i,1,lp)*g(i,1,l)+f(i,2,lp)*g(i,2,l))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
uvd(lpl,lh) = temp
DO i = 1,atoms%jri(n)
x(i) = (g(i,1,lp)*g(i,1,l)+g(i,2,lp)*g(i,2,l))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
dvd(lpl,lh) = temp
END IF
END DO
END DO
END DO
td%tuu(0:,n,jsp) = cmplx(0.0,0.0)
td%tdd(0:,n,jsp) = cmplx(0.0,0.0)
td%tud(0:,n,jsp) = cmplx(0.0,0.0)
td%tdu(0:,n,jsp) = cmplx(0.0,0.0)
indt=0
!---> generate the various t(l'm',lm) matrices for l'm'.ge.lm
!---> loop over l'm'
DO lp = 0,atoms%lmax(n)
lp1 = (lp* (lp+1))/2
DO mp = -lp,lp
lmp = lp* (lp+1) + mp
lmpl = (lmp* (lmp+1))/2
!---> loop over lattice harmonics
DO lh = 1, nh
lamda = sphhar%llh(lh,nsym)
lmin0 = abs(lp-lamda)
IF (lmin0.GT.lp) CYCLE
!--> ensure l+l'+lamda even
lmxx = lp - mod(lamda,2)
mems = sphhar%nmem(lh,nsym)
DO mem = 1,mems
mu = sphhar%mlh(mem,lh,nsym)
m = mp - mu
lmin = max(lmin0,abs(m))
l2 = abs(lmxx-lmin)
lmin = lmin + mod(l2,2)
DO l = lmin,lmxx,2
lm = l* (l+1) + m
IF (lm.GT.lmp) CYCLE
lpl = lp1 + l
lmplm = lmpl + lm
cil = ((ImagUnit** (l-lp))*sphhar%clnu(mem,lh,nsym))*&
gaunt1(lp,lamda,l,mp,mu,m,atoms%lmaxd)
td%tuu(lmplm,n,jsp) = td%tuu(lmplm,n,jsp) + cil*uvu(lpl,lh)
td%tdd(lmplm,n,jsp) = td%tdd(lmplm,n,jsp) + cil*dvd(lpl,lh)
td%tud(lmplm,n,jsp) = td%tud(lmplm,n,jsp) + cil*uvd(lpl,lh)
td%tdu(lmplm,n,jsp) = td%tdu(lmplm,n,jsp) + cil*dvu(lpl,lh)
indt(lmplm) = 1
END DO
END DO
END DO
END DO
END DO
!---> set up mapping array
DO lp = 0,atoms%lmax(n)
DO mp = -lp,lp
lmp = lp* (lp+1) + mp
DO l = 0,atoms%lmax(n)
DO m = -l,l
lm = l* (l+1) + m
IF (lmp.GE.lm) THEN
lmplm = (lmp* (lmp+1))/2 + lm
IF (indt(lmplm).NE.0) THEN
td%ind(lmp,lm,n,jsp) = lmplm
ELSE
td%ind(lmp,lm,n,jsp) = -9999
END IF
ELSE
lmplm = (lm* (lm+1))/2 + lmp
IF (indt(lmplm).NE.0) THEN
td%ind(lmp,lm,n,jsp) = -lmplm
ELSE
td%ind(lmp,lm,n,jsp) = -9999
END IF
END IF
END DO
END DO
END DO
ENDDO
!
!---> set up the t-matrices for the local orbitals,
!---> if there are any
IF (atoms%nlo(n).GE.1) THEN
CALL tlo(atoms,sphhar,jspin,jsp,n,enpara,1,input,v%mt(1,0,n,jsp),&
na,flo,f,g,ud, ud%uuilon(:,:,jspin),ud%duilon(:,:,jspin),ud%ulouilopn(:,:,:,jspin), td)
ENDIF
END SUBROUTINE tlmplm
END MODULE m_tlmplm
This diff is collapsed.
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_genMTBasis
CONTAINS
SUBROUTINE genMTBasis(atoms,enpara,vTot,mpi,iType,jspin,l_write,usdus,f,g,flo)
SUBROUTINE genMTBasis(atoms,enpara,vTot,mpi,iType,jspin,usdus,f,g,flo)
USE m_types
USE m_radfun
USE m_radflo
!$ use omp_lib
USE m_types
USE m_radfun
USE m_radflo
IMPLICIT NONE
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_usdus), INTENT(INOUT) :: usdus
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_usdus), INTENT(INOUT) :: usdus
INTEGER, INTENT(IN) :: iType
INTEGER, INTENT(IN) :: jspin
INTEGER, INTENT(IN) :: iType
INTEGER, INTENT(IN) :: jspin
LOGICAL, INTENT(IN) :: l_write
REAL, INTENT(INOUT) :: f(atoms%jmtd,2,0:atoms%lmaxd)
REAL, INTENT(INOUT) :: g(atoms%jmtd,2,0:atoms%lmaxd)
REAL, INTENT(INOUT) :: flo(atoms%jmtd,2,atoms%nlod)
REAL, INTENT(INOUT) :: f(atoms%jmtd,2,0:atoms%lmaxd)
REAL, INTENT(INOUT) :: g(atoms%jmtd,2,0:atoms%lmaxd)
REAL, INTENT(INOUT) :: flo(atoms%jmtd,2,atoms%nlod)
INTEGER :: l,nodeu,noded
REAL :: wronk
INTEGER :: l,nodeu,noded
REAL :: wronk
IF (l_write) WRITE (6,FMT=8000) iType
LOGICAL :: l_write
l_write=mpi%irank==0 &
!$ .and.omp_get_num_threads()==1
DO l = 0,atoms%lmax(iType)
CALL radfun(l,iType,jspin,enpara%el0(l,iType,jspin),vTot%mt(:,0,iType,jspin),atoms,&
f(1,1,l),g(1,1,l),usdus,nodeu,noded,wronk)
IF (l_write) THEN
WRITE (6,FMT=8010) l,enpara%el0(l,iType,jspin),usdus%us(l,iType,jspin),usdus%dus(l,iType,jspin),&
nodeu,usdus%uds(l,iType,jspin),usdus%duds(l,iType,jspin),noded,usdus%ddn(l,iType,jspin),wronk
END IF
END DO
! Generate the extra wavefunctions for the local orbitals, if there are any.
IF (atoms%nlo(iType).GE.1) THEN
CALL radflo(atoms,iType,jspin,enpara%ello0(1,1,jspin),vTot%mt(:,0,iType,jspin),f,g,mpi,&
usdus,usdus%uuilon(1,1,jspin),usdus%duilon(1,1,jspin),usdus%ulouilopn(1,1,1,jspin),flo)
END IF
IF (l_write) WRITE (6,FMT=8000) iType
8000 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',&
/,t32,'radial function',t79,'energy derivative',/,t3,&
'l',t8,'energy',t26,'value',t39,'derivative',t53,&
'nodes',t68,'value',t81,'derivative',t95,'nodes',t107,&
'norm',t119,'wronskian')
8010 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
DO l = 0,atoms%lmax(iType)
CALL radfun(l,iType,jspin,enpara%el0(l,iType,jspin),vTot%mt(:,0,iType,jspin),atoms,&
f(1,1,l),g(1,1,l),usdus,nodeu,noded,wronk)
IF (l_write) THEN
WRITE (6,FMT=8010) l,enpara%el0(l,iType,jspin),usdus%us(l,iType,jspin),usdus%dus(l,iType,jspin),&
nodeu,usdus%uds(l,iType,jspin),usdus%duds(l,iType,jspin),noded,usdus%ddn(l,iType,jspin),wronk
END IF
END DO
END SUBROUTINE genMTBasis
! Generate the extra wavefunctions for the local orbitals, if there are any.
IF (atoms%nlo(iType).GE.1) THEN
CALL radflo(atoms,iType,jspin,enpara%ello0(1,1,jspin),vTot%mt(:,0,iType,jspin),f,g,mpi,&
usdus,usdus%uuilon(1,1,jspin),usdus%duilon(1,1,jspin),usdus%ulouilopn(1,1,1,jspin),flo)
END IF
8000 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',&
/,t32,'radial function',t79,'energy derivative',/,t3,&
'l',t8,'energy',t26,'value',t39,'derivative',t53,&
'nodes',t68,'value',t81,'derivative',t95,'nodes',t107,&
'norm',t119,'wronskian')
8010 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
END SUBROUTINE genMTBasis
END MODULE m_genMTBasis
......@@ -328,7 +328,7 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,mpi,DIMENSION,r
write(itype_name , '(2a,i0)') TRIM(ADJUSTL(jsp_name)),'/itype_',itype
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(itype_name)), itypeGroupID, hdfError)
CALL genMTBasis(atoms,enpara,vTot,mpi,itype,jsp,.FALSE.,usdus,f(:,:,0:,jsp),g(:,:,0:,jsp),flo)
CALL genMTBasis(atoms,enpara,vTot,mpi,itype,jsp,usdus,f(:,:,0:,jsp),g(:,:,0:,jsp),flo)
dims(:3)=(/atoms%jmtd,2,atoms%lmaxd+1/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),itypeSpaceID,hdfError)
......
......@@ -17,6 +17,8 @@
#include <libxml/xmlschemas.h>
#include <libxml/xpath.h>
#include <libxml/xpathInternals.h>
#include <libxml/xinclude.h>
static xmlDocPtr xmlDocument;
static xmlDocPtr schemaDoc;
......@@ -78,7 +80,8 @@ int parseXMLSchema(const char* schemaFilename)
int parseXMLDocument(const char* docFilename)
{
xmlDocument = xmlReadFile(docFilename, NULL, 0);
xmlDocument = xmlReadFile(docFilename, NULL,0);
xmlXIncludeProcess(xmlDocument) ;
if (xmlDocument == NULL)
{
fprintf(stderr, "Failed to parse xml file %s\n", docFilename);
......
......@@ -68,6 +68,8 @@ MODULE m_xmlOutput
CHARACTER(LEN=20) :: structureSpecifiers(11)
CHARACTER(:), ALLOCATABLE :: gitdesc,githash,gitbranch,compile_date,compile_user,compile_host
CHARACTER(:), ALLOCATABLE :: compile_flags,link_flags
CHARACTER(LEN=1000) :: gitdescTemp,githashTemp,gitbranchTemp,compile_dateTemp,compile_userTemp,compile_hostTemp
CHARACTER(LEN=1000) :: compile_flagsTemp,link_flagsTemp
CHARACTER(LEN=20) :: attributes(7)
maxNumElements = 10
......@@ -87,8 +89,16 @@ MODULE m_xmlOutput
WRITE (xmlOutputUnit,'(a)') '<fleurOutput fleurOutputVersion="0.27">'
CALL openXMLElement('programVersion',(/'version'/),(/version_const/))
CALL get_compile_desc(gitdesc,githash,gitbranch,compile_date,compile_user,compile_host,compile_flags,link_flags)
CALL writeXMLElement('compilationInfo',(/'date','user','host','flag','link'/),(/compile_date,compile_user,compile_host,compile_flags,link_flags/))
CALL writeXMLElement('gitInfo',(/'version ','branch ','lastCommitHash'/),(/gitdesc,gitbranch,githash/))
gitdescTemp = gitdesc
githashTemp = githash
gitbranchTemp = gitbranch
compile_dateTemp = compile_date
compile_userTemp = compile_user
compile_hostTemp = compile_host
compile_flagsTemp = compile_flags
link_flagsTemp = link_flags
CALL writeXMLElement('compilationInfo',(/'date','user','host','flag','link'/),(/compile_dateTemp,compile_userTemp,compile_hostTemp,compile_flagsTemp,link_flagsTemp/))
CALL writeXMLElement('gitInfo',(/'version ','branch ','lastCommitHash'/),(/gitdescTemp,gitbranchTemp,githashTemp/))
CALL getComputerArchitectures(flags, numFlags)
IF (numFlags.EQ.0) THEN
numFlags = 1
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment