Commit dacfd00b authored by Daniel Wortmann's avatar Daniel Wortmann

First suggestion to refactor DOS part

parent d9f83ad7
module m_eig2dos
implicit none
CONTAINS
function generate_grid(emin_arg,emax_arg,efermi_arg)result(e)
REAL,INTENT(IN):: emin_arg,emax_arg,efermi_arg
REAL,ALLOCATABLE :: e(:)
INTEGER, PARAMETER :: ned = 1301
REAL :: emin,emax,efermi,de
INTEGER :: i
! scale energies
emin =emin_arg*hartree_to_ev_const
emax =emax_arg*hartree_to_ev_const
efermi = efermiarg*hartree_to_ev_const
!
! create energy grid
!
emax = max(emin,emax) - efermi
emin = min(emax,emin) - efermi
de = (emax-emin)/(ned-1)
ALLOCATE(e(ned+1))
DO i=1,ned+1
e(i) = emin + (i-1)*de
ENDDO
end function
subroutine transform_to_dos(eigdesc,banddos,kpts,ev,e,dos_data)
class(t_eigdesc),INTENT(IN):: eigdesc(:) !These are e.g. of t_dos,t_orbcomp...
real,intent(in):: e(:) ! The grid
real,intent(in):: ev(:,:,:) !eigenvalues
type(t_dos_data),INTENT(OUT):: dos_data(:) !the dos generated for each weight in eigdesc
DO i=1,size(eigdesc)
DO n=1,eigdesc(n)%num_weights()
select case(banddos%dos_mode)
case ("hist")
CALL dos_bin(e,results%neig,kpts%wtkpt,ev,eigdesc(i)%get_weights(n), dos_data(i)%dos(:,:,n))
case ("tetra")
IF ( input%film ) THEN
CALL ptdos..
ELSE
CALL tetra_dos...
ENDIF
end subroutine
end module
......@@ -3,19 +3,16 @@
! Density of states calculated by linear triangular method
!-------------------------------------------------------------------------
CONTAINS
SUBROUTINE ptdos(
> emin,emax,jspins,ne,ndos,ntb,ntria,as,atr,ntriad,
> itria,nkpt,ev,qal,e,
SUBROUTINE ptdos(as,atr,itria,ev,qal,e,
< g)
IMPLICIT NONE
c
c .. Arguments
INTEGER, INTENT (IN) :: ne,ntria,jspins,ntriad,ndos,ntb,nkpt
INTEGER, INTENT (IN) :: itria(3,ntriad)
REAL, INTENT (IN) :: emax,emin,as
REAL, INTENT (IN) :: atr(ntriad),qal(ndos,ntb,nkpt)
REAL, INTENT (IN) :: e(ne),ev(ntb,nkpt)
REAL, INTENT (OUT):: g(ne,ndos)
INTEGER, INTENT (IN) :: itria(:,:) !(3,ntriad)
REAL, INTENT (IN) :: as
REAL, INTENT (IN) :: atr(:),qal(:,:,:)
REAL, INTENT (IN) :: e(:),ev(:,:,:)
REAL, INTENT (OUT):: g(:,:)
c
c .. Locals
INTEGER :: i, j, nl, nb, n, nt(3), nc(4)
......@@ -23,15 +20,16 @@ c .. Locals
c
c calculate partial densities of states
c
f = 2*(3-jspins)/as
f = 1./as
c
g = 0.
c
DO n = 1 , ntria
fa = f*atr(n)
nt(:) = itria(:,n)
DO nb = 1 , ntb
ec(1:3) = ev(nb,nt(:))
DO js=1,size(qal,3)
DO n = 1 , size(itria,2)
fa = f*atr(n)
nt(:) = itria(:,n)
DO nb = 1 , size(ev,1)
ec(1:3) = ev(nb,nt(:),js)
nc(1:3) = nt(:)
DO i = 1, 2
DO j = i+1, 3
......@@ -42,16 +40,14 @@ c
ENDDO
ENDDO
DO nl = 1 , ndos
DO i = 1 , ne
g(i,nl) = g(i,nl) + fa* dostet( e(i),ec(1),ec(2),ec(3),
+ qal(nl,nb,nc(1)),qal(nl,nb,nc(2)),qal(nl,nb,nc(3)) )
ENDDO
DO i = 1 , size(e)
g(i,js) = g(i,js) + fa* dostet( e(i),ec(1),ec(2),ec(3),
+ qal(nb,nc(1),js),qal(nb,nc(2),js),qal(nb,nc(3),js) )
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
END SUBROUTINE ptdos
!-------------------------------------------------------------------------
REAL FUNCTION dostet(e,e1,e2,e3,q1,q2,q3)
......@@ -65,7 +61,7 @@ c
REAL :: e21 , e31 , e32 , ee
REAL, PARAMETER :: tol = 1.e-6
dostet = 0.
IF ( e.LT.e1 ) RETURN
IF ( e.LE.e2 ) THEN
......
......@@ -20,8 +20,42 @@ MODULE m_types_dos
PROCEDURE,PASS :: init => dos_init
END TYPE t_dos
TYPE,ABSTRACT:: t_eigdesc
!each eigenvalue might be described by weights
CHARACTER(len=20),ALLOCATABLE:: weight_names(:)
CONTAINS
procedure :: get_weight_name
procedure,DEFERRED :: get_weight
procedure :: get_num_weights
procedure :: write_hdf5
procedure :: read_hdf5
procedure :: write
procedure :: read
END TYPE
CONTAINS
function get_weight(this,id)
class(t_eigdesc),intent(in):: this
INTEGER,intent(in) :: id
real,allocatable:: get_weight(:,:,:)
end function
integer function get_num_weights(this)
class(t_eigdesc),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_eigdesc),intent(in):: this
INTEGER,intent(in) :: id
if (.not.allocated(this%weight_names)) call judft_error("No weight names in t_eigdesc")
if (id>size(this%weight_names)) call judft_error("Not enough weight names in t_eigdesc")
get_weight_name=this%weight_names(id)
end function
SUBROUTINE dos_init(thisDOS,input,atoms,kpts,vacuum)
USE m_types_input
USE m_types_atoms
......
!--------------------------------------------------------------------------------
! 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
USE m_juDFT
IMPLICIT NONE
PRIVATE
PUBLIC:: t_eigdesc
TYPE,ABSTRACT:: t_eigdesc
!each eigenvalue might be described by weights
CHARACTER(len=20),ALLOCATABLE:: weight_names(:)
CONTAINS
procedure :: get_weight_name
procedure,DEFERRED :: get_weight !This must be allocated in derived type
procedure :: get_num_weights
!procedure :: write_hdf5 TODO!!
!procedure :: read_hdf5
!procedure :: write
!procedure :: read
END TYPE
CONTAINS
function get_weight(this,id)
class(t_eigdesc),intent(in):: this
INTEGER,intent(in) :: id
real,allocatable:: get_weight(:,:,:)
end function
integer function get_num_weights(this)
class(t_eigdesc),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_eigdesc),intent(in):: this
INTEGER,intent(in) :: id
if (.not.allocated(this%weight_names)) call judft_error("No weight names in t_eigdesc")
if (id>size(this%weight_names)) call judft_error("Not enough weight names in t_eigdesc")
get_weight_name=this%weight_names(id)
end function
END MODULE m_types_eigdesc
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