Commit 8c023a80 authored by Daniel Wortmann's avatar Daniel Wortmann

Split of dos into dos and vacdos, changes for IO

parent 5d7174fd
......@@ -11,7 +11,7 @@ USE m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,enpara,stars,&
vacuum,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,&
vacuum,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,vacdos,results,&
moments,gfinp,hub1inp,hub1data,coreSpecInput,mcd,slab,orbcomp,jDOS,greensfImagPart)
!************************************************************************************
......@@ -44,8 +44,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
USE m_greensfCalcImagPart
USE m_cdnmt ! calculate the density and orbital moments etc.
USE m_orbmom ! coeffd for orbital moments
USE m_qmtsl ! These subroutines divide the input%film into vacuum%layers
USE m_qintsl ! (slabs) and intergate the DOS in these vacuum%layers
USE m_qmtsl ! These subroutines divide the input%film into banddos%layers
USE m_qintsl ! (slabs) and intergate the DOS in these banddos%layers
USE m_orbcomp ! calculate orbital composition (like p_x,p_y,p_z)
USE m_jDOS
USE m_abcrot2
......@@ -54,7 +54,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
USE m_xmlOutput
USE m_tlmplm_cholesky
USE m_types_mcd
USE m_types_slab
USE m_types_jDOS
USE m_types_vacDOS
USE m_types_orbcomp
#ifdef CPP_MPI
USE m_mpi_col_den ! collect density data from parallel nodes
#endif
......@@ -84,6 +88,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_vacdos), INTENT(INOUT) :: vacdos
TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_hub1data), OPTIONAL, INTENT(INOUT) :: hub1data
TYPE(t_coreSpecInput), OPTIONAL, INTENT(IN) :: coreSpecInput
......@@ -104,7 +109,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
INTEGER :: ikpt,ikpt_i,jsp_start,jsp_end,ispin,jsp
INTEGER :: iErr,nbands,noccbd,iType
INTEGER :: skip_t,skip_tt,nbasfcn
LOGICAL :: l_orbcomprot, l_real, l_dosNdir, l_corespec, l_empty
LOGICAL :: l_orbcomprot, l_real, l_corespec, l_empty
! Local Arrays
REAL,ALLOCATABLE :: we(:),eig(:)
......@@ -293,16 +298,16 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
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,ev_list,lapw,slab,oneD,zMat)
IF (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,stars,oneD, kpts,input,sym,cell,atoms,noco,nococonv,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz,noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos)
gVacMap,we,ikpt,jspin,vTot%vacz,noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,vacdos)
END IF
END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
IF (input%film) CALL regCharges%sumBandsVac(vacuum,vacdos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
! since z is no longer an argument of cdninf sympsi has to be called here!
CALL sympsi(lapw,jspin,sym,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
END IF
......@@ -310,7 +315,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
#ifdef CPP_MPI
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,vacdos,&
results,denCoeffs,orb,denCoeffsOffdiag,den,mcd,slab,orbcomp,jDOS)
END DO
#endif
......
......@@ -27,6 +27,7 @@ CONTAINS
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
use m_types_dos
use m_types_mcd
IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus
TYPE(t_mpi), INTENT(IN) :: mpi
......
MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,ikpt,stars,atoms,sym,cell,ne,ev_list,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
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
! Yu.M. Koroteev
! From pwden_old.F and pwint.F by c.l.fu
......@@ -11,6 +11,7 @@ CONTAINS
#include"cpp_double.h"
USE m_pwintsl
USE m_types
USE m_types_slab
IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
......@@ -41,10 +42,10 @@ CONTAINS
!
! calculate the star function expansion coefficients of
! the plane wave charge density for each En(k)
!
!
! ----> g=0 star
!
ALLOCATE ( stfunint(stars%ng3,slab%nsl), z_z(stars%ng3) )
ALLOCATE ( stfunint(stars%ng3,slab%nsl), z_z(stars%ng3) )
!
! -----> calculate the integrals of star functions over
! the layer interstitial
......@@ -59,7 +60,7 @@ CONTAINS
volsli,volintsli,cell,slab%nmtsl(1,i),stars%kv3(1,j),x)
stfunint(j,i) = x*stars%nstr(j)
ENDDO ! over 3D stars
ENDDO ! over vacuum%layers
ENDDO ! over banddos%layers
!
! Here, I reordered the stuff to save memory
!
......@@ -108,12 +109,12 @@ CONTAINS
DO j = 1,stars%ng3
qi = qi + z_z(j)*stfunint(j,i)
ENDDO
slab%qintsl(i,ev_list(n),ikpt,isp) = qi
ENDDO ! over vacuum%layers
slab%qintsl(i,ev_list(n),ikpt,isp) = qi
ENDDO ! over banddos%layers
ENDDO ! over states
DEALLOCATE ( stfunint, z_z )
DEALLOCATE ( stfunint, z_z )
END SUBROUTINE q_int_sl
END MODULE m_qintsl
......@@ -11,7 +11,8 @@ CONTAINS
SUBROUTINE q_mt_sl(jsp,atoms,sym,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
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_types_slab
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
......
This diff is collapsed.
......@@ -20,6 +20,9 @@ CONTAINS
USE m_radfun
USE m_orbmom2
USE m_xmlOutput
use m_types_orbcomp
use m_types_jDOS
use m_types_mcd
IMPLICIT NONE
......
......@@ -11,6 +11,7 @@ MODULE m_jDOS
!--------------------------------------------------------------------
USE m_types
USE m_clebsch
use m_types_jDOS
IMPLICIT NONE
......@@ -189,4 +190,4 @@ MODULE m_jDOS
ENDDO
END SUBROUTINE jDOS_comp
END MODULE m_jDOS
\ No newline at end of file
END MODULE m_jDOS
This diff is collapsed.
......@@ -16,7 +16,8 @@ dos/ptdos.f90
dos/make_dos.F90
dos/types_jdos.F90
dos/types_mcd.F90
dos/types_orbcomp.f90
dos/types_orbcomp.F90
dos/types_slab.F90
dos/types_eigdos.F90
dos/types_vacdos.f90
)
......@@ -49,7 +49,7 @@ CONTAINS
! -----> write bandstructure to ek_orbcomp - file
!
WRITE (chntype,'(i2)') slab%nsl
chform = "('E',i3,'= ',f10.4,4x,'vac ( vacuum%layers ) vac = ',i3,' ('&
chform = "('E',i3,'= ',f10.4,4x,'vac ( banddos%layers ) vac = ',i3,' ('&
& ,"//chntype//"(i3,2x),')',i3))"
WRITE (130,FMT=901)
WRITE (130,FMT=902)
......
......@@ -70,10 +70,11 @@ CONTAINS
8020 FORMAT (1x,3e20.12,i6,e20.12)
DO iband = 1,count(dos%eig(:,ikpt,jspin)<1E99)
qvact = sum(dos%qvac(iband,:,ikpt,jspin))
IF (sym%invs .OR. sym%zrfs) qvact = 2.0*qvact
!qvact = sum(vacdos%qvac(iband,:,ikpt,jspin))
!IF (sym%invs .OR. sym%zrfs) qvact = 2.0*qvact
iqvacpc = NINT(qvact*100.0)
qvacmt = qvact
!qvacmt = qvact
QVACMT=0.0
iqalpc(0:3,:) = NINT(dos%qal(0:3,:,iband,ikpt,jspin)*100.0)
DO l=0,3
qvacmt=qvacmt+dot_product(dos%qal(l,:,iband,ikpt,jspin),atoms%neq)
......
......@@ -55,8 +55,8 @@ CONTAINS
WRITE(oUnit,*) "STOP DOS: only set banddos%vacdos = .true. if banddos%dos=.true."
CALL juDFT_error("DOS",calledby ="doswrite")
ENDIF
IF (banddos%vacdos.AND.(.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1)))THEN
WRITE(oUnit,*) "STOP DOS: if stars = f set vacuum%nstars=1"
IF (banddos%vacdos.AND.(.NOT.banddos%starcoeff.AND.(banddos%nstars.NE.1)))THEN
WRITE(oUnit,*) "STOP DOS: if stars = f set banddos%nstars=1"
CALL juDFT_error("DOS",calledby ="doswrite")
ENDIF
......@@ -83,8 +83,8 @@ CONTAINS
WRITE (85,FMT=8080) atoms%ntype, (atoms%neq(n),n=1,atoms%ntype)
IF (banddos%vacdos) THEN
WRITE (86,FMT=8080) vacuum%nvac,kpts%nkpt
WRITE (86,FMT=8080) vacuum%layers
WRITE (86,'(20(i3,1x))') (vacuum%izlay(i,1),i=1,vacuum%layers)
WRITE (86,FMT=8080) banddos%layers
WRITE (86,'(20(i3,1x))') (banddos%izlay(i,1),i=1,banddos%layers)
ENDIF
ENDIF
......@@ -122,11 +122,11 @@ CONTAINS
WRITE (87,'(i3,1x,f12.6)') ikpt,wk
i=0
DO n = 1, ne
IF (ABS(eig(n)-vacuum%tworkf).LE.banddos%e2_dos) i=i+1
IF (ABS(eig(n)-banddos%tworkf).LE.banddos%e2_dos) i=i+1
END DO
WRITE (87,FMT=990) bkpt(1), bkpt(2), i, n2max
DO n = 1, ne
IF (ABS(eig(n)-vacuum%tworkf).LE.banddos%e2_dos) THEN
IF (ABS(eig(n)-banddos%tworkf).LE.banddos%e2_dos) THEN
WRITE (87,FMT=1000) eig(n)
DO j=1,n2max
WRITE (87,FMT=1010) ac(j,n),bc(j,n)
......
......@@ -92,8 +92,8 @@
ENDIF
ALLOCATE( qal(qdim,input%neig,kpts%nkpt),&
& qval(vacuum%nstars*vacuum%layers*vacuum%nvac,input%neig,kpts%nkpt),&
& qlay(input%neig,vacuum%layerd,2))
& qval(banddos%nstars*banddos%layers*vacuum%nvac,input%neig,kpts%nkpt),&
& qlay(input%neig,banddos%layers,2))
IF (l_mcd) THEN
ALLOCATE(mcd_local(3*atoms%ntype*ncored,input%neig,kpts%nkpt) )
ELSE
......@@ -204,10 +204,10 @@
ELSEIF ( banddos%vacdos .and. input%film ) THEN
DO i = 1,results%neig(k,jsp)
DO v = 1,vacuum%nvac
DO l = 1,vacuum%layers
index = (l-1)*vacuum%nstars + (v-1)*(vacuum%nstars*vacuum%layers) + 1
DO l = 1,banddos%layers
index = (l-1)*banddos%nstars + (v-1)*(banddos%nstars*banddos%layers) + 1
qval(index,i,k) = qlay(i,l,v)
DO s = 1,vacuum%nstars - 1
DO s = 1,banddos%nstars - 1
qval(index+s,i,k) = real(dos%qstars(s,i,l,v,k,jspin))
ENDDO
ENDDO
......@@ -400,7 +400,7 @@
!------------------------------------------------------------------------------
IF ( banddos%vacdos .and. input%film ) THEN
ALLOCATE(g(ned,vacuum%nstars*vacuum%layers*vacuum%nvac))
ALLOCATE(g(ned,banddos%nstars*banddos%layers*vacuum%nvac))
IF(kpts%ntet.EQ.0) THEN
CALL juDFT_error("VACDOS requires a kpoint set with generated triangles",calledby="evaldos")
ENDIF
......@@ -408,12 +408,12 @@
! > emin,emax,jspins,ned,nstars*nvac*layers,neigd,
! > ntria,as,atr,2*nkpt,itria,nkptd,ev,qval,e,
! < g)
CALL ptdos(input%jspins,ned,vacuum%nstars*vacuum%nvac*vacuum%layers,&
CALL ptdos(input%jspins,ned,banddos%nstars*vacuum%nvac*banddos%layers,&
ntb,kpts,ev,qval,e,g)
!---- > smoothening
IF ( sigma.GT.0.0 ) THEN
DO ln = 1 , vacuum%nstars*vacuum%nvac*vacuum%layers
DO ln = 1 , banddos%nstars*vacuum%nvac*banddos%layers
CALL smooth(e,g(1,ln),sigma,ned)
ENDDO
ENDIF
......@@ -423,7 +423,7 @@
OPEN (18,FILE='VACDOS'//spin12(jspin))
! WRITE (18,'(i2,25(2x,i3))') Layers , (Zlay(l),l=1,Layers)
DO i = 1 , ned
WRITE (18,99001) e(i) , (g(i,l),l=1,vacuum%Layers*vacuum%Nstars*vacuum%Nvac)
WRITE (18,99001) e(i) , (g(i,l),l=1,banddos%layers*banddos%nstars*vacuum%Nvac)
ENDDO
CLOSE (18)
DEALLOCATE(g)
......
......@@ -4,7 +4,7 @@ MODULE m_nstm3
! included writing to vacwave!
! set up mapping array to general G_parallel(j)=(gvac1(j),gvac2(j))
! for vacuum density in order to write out information
! on electronic structure for calculation of tunneling current
! on electronic structure for calculation of tunneling current
! change by shz, Jan.99
!
!***********************************************************************
......@@ -29,8 +29,8 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ikpt
INTEGER, INTENT (IN) :: jspin
INTEGER, INTENT (IN) :: ikpt
INTEGER, INTENT (IN) :: jspin
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: evac(2)
......@@ -68,9 +68,9 @@ CONTAINS
gvac1d(j)=gvac1(gindex(j))
gvac2d(j)=gvac2(gindex(j))
END DO
!
!
IF (jspin.EQ.1) THEN
WRITE (87,'(f10.6,1x,i1,1x,f10.6)') vacuum%tworkf,input%jspins,cell%area
! WRITE (87,'(f10.6,1x,i1,1x,f10.6)') banddos%tworkf,input%jspins,cell%area
WRITE (87,'(2(f10.6,1x))') cell%amat(1,1), cell%amat(2,1)
WRITE (87,'(2(f10.6,1x))') cell%amat(1,2), cell%amat(2,2)
WRITE (87,'(2(f10.6,1x))') cell%bmat(1,1), cell%bmat(2,1)
......@@ -106,7 +106,7 @@ CONTAINS
IF (ABS(atoms%taual(3,i)).GT.dz0) dz0=ABS(atoms%taual(3,i))
END DO
dz0=cell%z1-dz0*cell%amat(3,3)
WRITE (87,'(i3,1x,f6.4,1x,f12.6)') vacuum%nmz,vacuum%delz,dz0
WRITE (87,'(i3,1x,f6.4,1x,f12.6)') vacuum%nmz,vacuum%delz,dz0
DO ivac=1,vacuum%nvac
DO i=1, vacuum%nmz
WRITE (87,'(e16.8)') vz(i,ivac)
......
......@@ -124,7 +124,6 @@ subroutine write_dos(eigdos,hdf_id)
use m_banddos_io
#endif
class(t_eigdos),INTENT(INOUT):: eigdos
character(len=*),OPTIONAL,intent(in)::filename
#ifdef CPP_HDF
integer(HID_T),intent(in) ::hdf_id
integer:: n
......
......@@ -129,7 +129,7 @@ end function
INTEGER :: ind,ntype,nc,n
ind=0
DO n=1,size(this%mcd,1)
ntype=n/3+1
ntype=(n-1)/3+1
select case(mod(n,3))
case(1)
c="pos"
......
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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_types_vacdos
USE m_juDFT
USE m_types_eigdos
IMPLICIT NONE
PRIVATE
PUBLIC:: t_vacdos
TYPE,extends(t_eigdos):: t_vacdos
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:,:,:)
CHARACTER(len=20),ALLOCATABLE:: weight_names(:)!This must be allocated in init of derived type
CONTAINS
PROCEDURE,PASS :: init => dos_init
PROCEDURE :: get_weight_eig
PROCEDURE :: get_num_spins
PROCEDURE :: get_num_weights
PROCEDURE :: get_weight_name
END TYPE t_vacdos
CONTAINS
integer function get_num_weights(this)
class(t_vacdos),intent(in):: this
get_num_weights=0
if (allocated(this%weight_names)) get_num_weights=size(this%weight_names)
end function
character(len=20) function get_weight_name(this,id)
class(t_vacdos),intent(in):: this
INTEGER,intent(in) :: id
if (.not.allocated(this%weight_names)) call judft_error("No weight names in t_eigdos")
if (id>size(this%weight_names)) call judft_error("Not enough weight names in t_eigdos")
get_weight_name=this%weight_names(id)
end function
integer function get_num_spins(this)
class(t_vacdos),intent(in):: this
get_num_spins= size(this%qvac,4)
end function
function get_weight_eig(this,id)
class(t_vacdos),intent(in):: this
INTEGER,intent(in) :: id
real,allocatable:: get_weight_eig(:,:,:)
INTEGER :: ind,l,ntype,i
allocate(get_weight_eig(size(this%qvac,1),size(this%qvac,3),size(this%qvac,4)))
ind=0
do i=1,2
ind=ind+1
if (ind==id) get_weight_eig=this%qvac(:,i,:,:)
end do
do i=1,size(this%qvlay,2)
ind=ind+1
if (ind==id) get_weight_eig=this%qvlay(:,i,1,:,:)
ind=ind+1
if (ind==id) get_weight_eig=this%qvlay(:,i,2,:,:)
end do
DO l=1,size(this%qstars,3)
do i=1,size(this%qstars,1)
ind=ind+1
if (ind==id) get_weight_eig=real(this%qstars(i,:,l,1,:,:))
ind=ind+1
if (ind==id) get_weight_eig=aimag(this%qstars(i,:,l,1,:,:))
ind=ind+1
if (ind==id) get_weight_eig=real(this%qstars(i,:,l,2,:,:))
ind=ind+1
if (ind==id) get_weight_eig=aimag(this%qstars(i,:,l,2,:,:))
end do
end do
end function
SUBROUTINE dos_init(thisDOS,input,atoms,kpts,banddos,eig)
USE m_types_input
USE m_types_atoms
USE m_types_banddos
USE m_types_kpts
IMPLICIT NONE
CLASS(t_vacdos), INTENT(INOUT) :: thisDOS
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_banddos), INTENT(IN) :: banddos
real,intent(in) :: eig(:,:,:)
INTEGER :: ntype,l,i,ind
character :: spdfg(0:4)=["s","p","d","f","g"]
thisDOS%name_of_dos="Vacuum"
thisDOS%eig=eig
ALLOCATE(thisDOS%qvac(input%neig,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvlay(input%neig,banddos%layers,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qstars(banddos%nstars,input%neig,banddos%layers,2,kpts%nkpt,input%jspins))
thisDOS%qvac = 0.0
thisDOS%qvlay = 0.0
thisDOS%qstars = CMPLX(0.0,0.0)
allocate(thisDOS%weight_names(2+banddos%layers*(banddos%nstars+1)))
ind=1
thisDOS%weight_names(ind)="VAC1"
ind=ind+1
thisDOS%weight_names(ind)="VAC2"
do i=1,banddos%layers
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0)") "LAYER1-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0)") "LAYER2-",i
end do
DO l=1,banddos%layers
do i=1,banddos%nstars
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC1)-",l,"-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC1)-",l,"-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC2)-",l,"-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC2)-",l,"-",i
end do
end do
END SUBROUTINE dos_init
END MODULE m_types_vacdos
hdf5-git @ d818edb1
Subproject commit 9abbdeaa66c70a00b6a7bedee9c76d2493a8e947
Subproject commit d818edb110b668489d5c33ebc5c94dd9ef767121
Subproject commit c4f185b21974474acb84a51c9c10dd889ba39e42
Subproject commit ca6f7114b9fffe0964ca9e8d24e09ef15b300316
......@@ -12,13 +12,23 @@ MODULE m_types_banddos
PUBLIC:: t_banddos
TYPE,EXTENDS(t_fleurinput_base):: t_banddos
LOGICAL :: dos =.FALSE.
LOGICAL :: vacdos =.FALSE.
REAL :: e1_dos=0.5
REAL :: e2_dos=-0.5
REAL :: sig_dos=0.015
INTEGER :: ndos_points=1301
LOGICAL :: vacdos =.FALSE.
INTEGER :: layers=0
INTEGER :: nstars=0
INTEGER :: nstm=0
REAL :: tworkf=0.0
REAL :: locx(2)=[0.,0.]
REAL :: locy(2)=[0.,0.]
LOGICAL :: starcoeff=.FALSE.
INTEGER, ALLOCATABLE :: izlay(:, :)
LOGICAL :: band =.FALSE.
LOGICAL :: unfoldband =.FALSE.
INTEGER :: s_cell_x=1
......@@ -29,8 +39,10 @@ MODULE m_types_banddos
LOGICAL :: l_mcd =.FALSE.
REAL :: e_mcd_lo =-10.0
REAL :: e_mcd_up= 0.0
LOGICAL :: l_orb =.FALSE.
REAL :: alpha,beta,gamma !For orbital decomp. (was orbcomprot)
LOGICAL :: l_jDOS = .FALSE.
LOGICAL :: l_slab=.false.
......@@ -77,7 +89,16 @@ CONTAINS
CALL mpi_bc(this%dos_atom,rank,mpi_comm)
CALL mpi_bc(this%l_slab,rank,mpi_comm)
CALL mpi_bc(this%ndos_points,rank,mpi_comm)
CALL mpi_bc(this%layers,rank,mpi_comm)
CALL mpi_bc(this%nstars,rank,mpi_comm)
CALL mpi_bc(this%nstm,rank,mpi_comm)
CALL mpi_bc(this%tworkf,rank,mpi_comm)
CALL mpi_bc(this%locx(1),rank,mpi_comm)
CALL mpi_bc(this%locy(1),rank,mpi_comm)
CALL mpi_bc(this%locx(2),rank,mpi_comm)
CALL mpi_bc(this%locy(2),rank,mpi_comm)
CALL mpi_bc(this%starcoeff,rank,mpi_comm)
CALL mpi_bc(this%izlay,rank,mpi_comm)
END SUBROUTINE mpi_bc_banddos
SUBROUTINE read_xml_banddos(this,xml)
......@@ -85,79 +106,79 @@ CONTAINS
CLASS(t_banddos),INTENT(INOUT)::this
TYPE(t_xml),INTENT(INOUT)::xml
CHARACTER(len=300) :: xPathA, xPathB
INTEGER::numberNodes,iType,i,na
LOGICAL::l_orbcomp,l_jDOS
CHARACTER(len=300) :: xPathA, xPathB,str
INTEGER::numberNodes,iType,i,na,n
LOGICAL::l_orbcomp,l_jDOS,all_atoms
this%band = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@band'))
this%dos = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@dos'))
!this%l_slab = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@slab'))
!this%vacdos = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@vacdos'))
this%l_mcd = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@mcd'))
numberNodes = xml%GetNumberOfNodes('/fleurInput/output/densityOfStates')
IF ((this%dos).AND.(numberNodes.EQ.0)) THEN
CALL juDFT_error("dos is true but densityOfStates parameters are not set!")
END IF
numberNodes = xml%GetNumberOfNodes('/fleurInput/output/bandDOS')
IF (numberNodes.EQ.1) THEN
this%e2_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@minEnergy'))
this%e1_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@maxEnergy'))
this%sig_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@sigma'))
all_atoms=evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/bandDOS/@all_atoms'))
this%e2_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/bandDOS/@minEnergy'))
this%e1_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/bandDOS/@maxEnergy'))
this%sig_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/bandDOS/@sigma'))
this%ndos_points=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/output/bandDOS/@numberPoints'))
END IF
IF (this%band) THEN
this%dos=.TRUE.
ENDIF
! Read in optional magnetic cir