Skip to content

GitLab

fleur
fleur
Commit ee533762 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

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

parents c3137481 c9a840fc
Hide whitespace changes
Inline Side-by-side
Showing with 114 additions and 80 deletions
cdn/cdnval.F90
View file @ ee533762
......@@ -11,7 +11,7 @@ USE m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,den,regCharges,results,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,den,regCharges,dos,results,&
moments,mcd,slab)
!************************************************************************************
......@@ -76,6 +76,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
TYPE(t_cdnvalKLoop), INTENT(IN) :: cdnvalKLoop
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_mcd), INTENT(INOUT) :: mcd
TYPE(t_slab), INTENT(INOUT) :: slab
......@@ -212,7 +213,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
IF (noccbd.LE.0) GO TO 199 ! Note: This jump has to be after the MPI_BARRIER is called
IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called
CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
......@@ -220,17 +221,17 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
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,regCharges%qis,results,force%f_b8,zMat)
jspin,lapw,noccbd,we,eig,den,dos%qis,results,force%f_b8,zMat)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF (l_dosNdir) CALL q_int_sl(jspin,stars,atoms,sym,cell,noccbd,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%evac0,eig,&
den,regCharges%qvac,regCharges%qvlay,regCharges%qstars,zMat)
den,dos%qvac,dos%qvlay,dos%qstars,zMat)
END IF
END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,noccbd,ikpt,jsp_start,jsp_end,eig,we)
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
! valence density in the atomic spheres
CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd)
......@@ -244,9 +245,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
! 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,&
skip_t,cdnvalKLoop%l_evp,eigVecCoeffs,usdus,regCharges,mcd,banddos%l_mcd)
skip_t,cdnvalKLoop%l_evp,eigVecCoeffs,usdus,regCharges,dos,mcd,banddos%l_mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,regCharges)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,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
......@@ -268,12 +269,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
END DO ! end loop over ispin
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
199 CONTINUE
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!
IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,ksym,jsym,zMat)
CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd)
CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,ksym,jsym,mcd%mcd)
END IF
END DO ! end of k-point loop
......
cdn/eparas.f90
View file @ ee533762
......@@ -24,7 +24,7 @@ MODULE m_eparas
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,mcd,l_mcd)
usdus,regCharges,dos,mcd,l_mcd)
USE m_types
IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus
......@@ -32,6 +32,7 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_mcd), INTENT(INOUT) :: mcd
! ..
! .. Scalar Arguments ..
......@@ -64,9 +65,9 @@ CONTAINS
ENDIF
regCharges%ener(:,:,jsp) = 0.0
regCharges%sqal(:,:,jsp) = 0.0
regCharges%qal(:,:,:,jsp) = 0.0
regCharges%enerlo(:,:,jsp) = 0.0
regCharges%sqlo(:,:,jsp) = 0.0
dos%qal(:,:,:,ikpt,jsp) = 0.0
END IF
!
!---> l-decomposed density for each occupied state
......@@ -109,7 +110,7 @@ CONTAINS
ENDDO
ENDIF ! end MCD
ENDDO
regCharges%qal(l,n,i,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO
nt1 = nt1 + atoms%neq(n)
ENDDO
......@@ -122,8 +123,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) + regCharges%qal(l,n,i,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + regCharges%qal(l,n,i,jsp)*we(i)
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)
ENDDO
ENDDO
ENDDO
......@@ -176,7 +177,7 @@ CONTAINS
! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE
DO i = 1,ne
regCharges%qal(l,ntyp,i,jsp)= regCharges%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,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)
......@@ -184,7 +185,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)
regCharges%qal(l,ntyp,i,jsp)= regCharges%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
ENDDO
ENDIF
......
cdn/qal_21.f90
View file @ ee533762
......@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,regCharges)
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_rotdenmat
USE m_types
......@@ -16,10 +16,10 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd
INTEGER, INTENT (IN) :: noccbd,ikpt
! .. Local Scalars ..
INTEGER i,l,lo,lop ,natom,nn,ntyp
......@@ -149,11 +149,10 @@ CONTAINS
state : DO i = 1, noccbd
lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),&
regCharges%qal(l,n,i,1),regCharges%qal(l,n,i,2),qal21(l,n,i))
dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
IF (.FALSE.) THEN
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),&
regCharges%qal(l,n,i,:)
q_loc(1,1) = regCharges%qal(l,n,i,1); q_loc(2,2) = regCharges%qal(l,n,i,2)
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)
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)
......
cdn/vacden.F90
View file @ ee533762
......@@ -70,14 +70,14 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments ..
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
! STM-Arguments
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
COMPLEX, INTENT (OUT):: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
COMPLEX, INTENT (INOUT) :: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins)
!
! local STM variables
INTEGER nv2(DIMENSION%jspd)
......@@ -170,8 +170,6 @@ CONTAINS
! ------------------
! WRITE (16,'(a,i2)') 'nstars=',nstars
stcoeff(:,:,:,:) = CMPLX(0.0,0.0)
! -----> set up mapping arrays
IF (noco%l_ss) THEN
jsp_start = 1
......@@ -1198,7 +1196,7 @@ CONTAINS
!=============================================================
!
! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue
! to stcoeff(ne,layer,ivac) if starcoeff=T (the star coefficient values are written to vacdos)
! to stcoeff(ne,layer,ivac,ikpt) if starcoeff=T (the star coefficient values are written to vacdos)
!
IF (vacuum%starcoeff .AND. banddos%vacdos) THEN
DO n=1,ne
......@@ -1229,9 +1227,9 @@ CONTAINS
uej = ue(vacuum%izlay(jj,1),l1,jspin)
t1 = aa*ui*uj + bb*uei*uej +ba*ui*uej + ab*uei*uj
IF (ind2.GE.2.AND.ind2.LE.vacuum%nstars) &
stcoeff(ind2-1,n,jj,ivac) = stcoeff(ind2-1,n,jj,ivac)+ t1*phs/stars%nstr2(ind2)
stcoeff(ind2-1,n,jj,ivac,ikpt,jspin) = stcoeff(ind2-1,n,jj,ivac,ikpt,jspin)+ t1*phs/stars%nstr2(ind2)
IF (ind2p.GE.2.AND.ind2p.LE.vacuum%nstars) &
stcoeff(ind2p-1,n,jj,ivac) = stcoeff(ind2p-1,n,jj,ivac) +CONJG(t1)*phs/stars%nstr2(ind2p)
stcoeff(ind2p-1,n,jj,ivac,ikpt,jspin) = stcoeff(ind2p-1,n,jj,ivac,ikpt,jspin) +CONJG(t1)*phs/stars%nstr2(ind2p)
END DO
END IF
ENDDO
......
io/eig66_io.F90
View file @ ee533762
......@@ -167,7 +167,7 @@ CONTAINS
CALL timestop("IO (write)")
END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd)
SUBROUTINE write_dos(id,nk,jspin,dos,slab,orbcomp,ksym,jsym,mcd)
USE m_eig66_hdf,ONLY:write_dos_hdf=>write_dos
USE m_eig66_DA ,ONLY:write_dos_DA=>write_dos
USE m_eig66_mem,ONLY:write_dos_MEM=>write_dos
......@@ -175,28 +175,28 @@ CONTAINS
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
TYPE(t_regionCharges), INTENT(IN) :: regCharges
TYPE(t_orbcomp), INTENT(IN) :: orbcomp
TYPE(t_slab), INTENT(IN) :: slab
TYPE(t_dos), INTENT(IN) :: dos
TYPE(t_orbcomp), INTENT(IN) :: orbcomp
TYPE(t_slab), INTENT(IN) :: slab
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
CALL write_dos_DA(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
CALL write_dos_HDF(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (mem_mode)
CALL write_dos_Mem(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
CALL write_dos_Mem(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (MPI_mode)
CALL write_dos_MPI(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
CALL write_dos_MPI(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (-1)
CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io")
......
main/cdngen.F90
View file @ ee533762
......@@ -70,6 +70,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
! Local type instances
TYPE(t_noco) :: noco_new
TYPE(t_regionCharges) :: regCharges
TYPE(t_dos) :: dos
TYPE(t_moments) :: moments
TYPE(t_mcd) :: mcd
TYPE(t_slab) :: slab
......@@ -80,7 +81,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
REAL :: fix, qtot, dummy
INTEGER :: jspin, jspmax
CALL regCharges%init(input,atoms,dimension,kpts,vacuum)
CALL regCharges%init(input,atoms)
CALL dos%init(input,atoms,dimension,kpts,vacuum)
CALL moments%init(input,atoms)
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
......@@ -94,7 +96,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DO jspin = 1,jspmax
CALL cdnvalKLoop%init(mpi,input,kpts,banddos,noco,results,jspin,sliceplot)
CALL cdnval(eig_id,mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,outDen,regCharges,results,moments,mcd,slab)
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,outDen,regCharges,dos,results,moments,mcd,slab)
END DO
IF (mpi%irank.EQ.0) THEN
......
types/CMakeLists.txt
View file @ ee533762
......@@ -18,6 +18,7 @@ types/types_usdus.F90
types/types_cdnval.f90
types/types_field.F90
types/types_regionCharges.f90
types/types_dos.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
......@@ -40,6 +41,7 @@ types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
types/types_regionCharges.f90
types/types_dos.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
types/types.F90
View file @ ee533762
......@@ -22,6 +22,7 @@ MODULE m_types
USE m_types_cdnval
USE m_types_field
USE m_types_regionCharges
USE m_types_dos
USE m_types_denCoeffsOffdiag
USE m_types_force
END MODULE m_types
......
types/types_dos.f90 0 → 100644
View file @ ee533762
!--------------------------------------------------------------------------------
! 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_dos
IMPLICIT NONE
PRIVATE
TYPE t_dos
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => dos_init
END TYPE t_dos
PUBLIC t_dos
CONTAINS
SUBROUTINE dos_init(thisDOS,input,atoms,dimension,kpts,vacuum)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
CLASS(t_dos), INTENT(INOUT) :: thisDOS
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_vacuum), INTENT(IN) :: vacuum
ALLOCATE(thisDOS%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qal(0:3,atoms%ntype,dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
thisDOS%qis = 0.0
thisDOS%qal = 0.0
thisDOS%qvac = 0.0
thisDOS%qvlay = 0.0
thisDOS%qstars = CMPLX(0.0,0.0)
END SUBROUTINE dos_init
END MODULE m_types_dos
types/types_regionCharges.f90
View file @ ee533762
......@@ -12,20 +12,12 @@ PRIVATE
TYPE t_regionCharges
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:)
REAL, ALLOCATABLE :: sqal(:,:,:)
REAL, ALLOCATABLE :: ener(:,:,:)
REAL, ALLOCATABLE :: sqlo(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: svac(:,:)
REAL, ALLOCATABLE :: pvac(:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => regionCharges_init
......@@ -36,60 +28,43 @@ PUBLIC t_regionCharges
CONTAINS
SUBROUTINE regionCharges_init(thisRegCharges,input,atoms,dimension,kpts,vacuum)
SUBROUTINE regionCharges_init(thisRegCharges,input,atoms)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
CLASS(t_regionCharges), INTENT(INOUT) :: thisRegCharges
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_vacuum), INTENT(IN) :: vacuum
ALLOCATE(thisRegCharges%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%qal(0:3,atoms%ntype,dimension%neigd,input%jspins))
ALLOCATE(thisRegCharges%sqal(0:3,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%ener(0:3,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%sqlo(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%enerlo(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%svac(2,input%jspins))
ALLOCATE(thisRegCharges%pvac(2,input%jspins))
ALLOCATE(thisRegCharges%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
thisRegCharges%qis = 0.0
thisRegCharges%qal = 0.0
thisRegCharges%sqal = 0.0
thisRegCharges%ener = 0.0
thisRegCharges%sqlo = 0.0
thisRegCharges%enerlo = 0.0
thisRegCharges%qvac = 0.0
thisRegCharges%svac = 0.0
thisRegCharges%pvac = 0.0
thisRegCharges%qvlay = 0.0
thisRegCharges%qstars = CMPLX(0.0,0.0)
END SUBROUTINE regionCharges_init
SUBROUTINE sumBandsVac(thisRegCharges,vacuum,noccbd,ikpt,jsp_start,jsp_end,eig,we)
SUBROUTINE sumBandsVac(thisRegCharges,vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
USE m_types_setup
USE m_types_dos
IMPLICIT NONE
CLASS(t_regionCharges), INTENT(INOUT) :: thisRegCharges
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_dos), INTENT(IN) :: dos
INTEGER, INTENT(IN) :: noccbd
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp_start, jsp_end
......@@ -102,9 +77,9 @@ SUBROUTINE sumBandsVac(thisRegCharges,vacuum,noccbd,ikpt,jsp_start,jsp_end,eig,w
DO ispin = jsp_start, jsp_end
DO ivac = 1,vacuum%nvac
thisRegCharges%pvac(ivac,ispin) = thisRegCharges%pvac(ivac,ispin)+&
dot_product(eig(:noccbd)*thisRegCharges%qvac(:noccbd,ivac,ikpt,ispin),we(:noccbd))
dot_product(eig(:noccbd)*dos%qvac(:noccbd,ivac,ikpt,ispin),we(:noccbd))
thisRegCharges%svac(ivac,ispin)=thisRegCharges%svac(ivac,ispin)+&
dot_product(thisRegCharges%qvac(:noccbd,ivac,ikpt,ispin),we(:noccbd))
dot_product(dos%qvac(:noccbd,ivac,ikpt,ispin),we(:noccbd))
END DO
END DO
......
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