Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2020 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : MODULE m_types_jdos
       7             :    use m_judft
       8             :    use m_types_eigdos
       9             :    implicit none
      10             :    PRIVATE
      11             :    public t_jdos
      12             :    TYPE,extends(t_eigdos):: t_jDOS
      13             : 
      14             :       REAL, ALLOCATABLE    :: comp(:,:,:,:,:)  !decomposition in percent
      15             :       REAL, ALLOCATABLE    :: qmtp(:,:,:)      !How much of the state is in the muffin-tin sphere
      16             :       REAL, ALLOCATABLE    :: occ(:,:,:)       !Occupation of the j-states
      17             :       INTEGER,ALLOCATABLE  :: n_dos_to_na(:)
      18             : 
      19             :       CONTAINS
      20             :          PROCEDURE,PASS :: init => jDOS_init
      21             :          PROCEDURE      :: get_weight_eig
      22             :          PROCEDURE      :: get_num_weights
      23             :          PROCEDURE      :: get_weight_name
      24             :          PROCEDURE      :: get_spins
      25             :    END TYPE t_jDOS
      26             :    CONTAINS
      27             : 
      28           9 :    pure integer function get_spins(this)
      29             :       CLASS(t_jdos),INTENT(IN)::this
      30           9 :       get_spins=1
      31           9 :    END function
      32             : 
      33          14 :    function get_weight_eig(this,id)
      34             :       class(t_jdos),intent(in):: this
      35             :       INTEGER,intent(in)      :: id
      36             :       real,allocatable:: get_weight_eig(:,:,:)
      37             : 
      38             :       integer :: i,l,jj,na
      39             : 
      40          56 :       ALLOCATE(get_weight_eig(size(this%comp,1),size(this%comp,5),1))
      41             : 
      42          14 :       i = 0
      43          16 :       DO na=1,size(this%comp,4)
      44          48 :          DO l= 0, 3
      45         132 :             DO jj = 1, MERGE(1,2,l==0)
      46          68 :                i = i+1
      47         418 :                if (i==id) get_weight_eig(:,:,1)=this%comp(:,l,jj,na,:)*this%qmtp(:,na,:)/10000.
      48         100 :                if (i>id) RETURN
      49             :             ENDDO
      50             :          ENDDO
      51             :       ENDDO
      52             :    end function
      53             : 
      54        1342 :    integer function get_num_weights(this)
      55             :       class(t_jdos),intent(in):: this
      56        1342 :       get_num_weights = 7*size(this%comp,4)
      57        1342 :    end function
      58             : 
      59             : 
      60          28 :    character(len=20) function get_weight_name(this,id)
      61             :       class(t_jdos),intent(in):: this
      62             :       INTEGER,intent(in)         :: id
      63             :       integer :: i,l,jj,na
      64             :       character :: spdfg(0:4)=["s","p","d","f","g"]
      65             :       character(len=3) :: jname
      66             : 
      67          28 :       i = 0
      68          32 :       DO na=1,size(this%comp,4)
      69          96 :          DO l= 0, 3
      70         264 :             DO jj = -1, MERGE(-1,1,l==0), 2
      71         136 :                i = i+1
      72         136 :                WRITE(jname,'(i1,a,i1)') INT(2*l+jj),'-',2
      73         136 :                if (i==id) THEN
      74          28 :                   IF(l.EQ.0) write(get_weight_name,"(a,i0,a)") "jDOS:",this%n_dos_to_na(na),spdfg(l)
      75          24 :                   IF(l.NE.0) write(get_weight_name,"(a,i0,a,a)") "jDOS:",this%n_dos_to_na(na),spdfg(l),jname
      76             :                endif
      77         200 :                if (i>id) RETURN
      78             :             ENDDO
      79             :          ENDDO
      80             :       ENDDO
      81             : 
      82             :    end function
      83             : 
      84             : 
      85         672 :   SUBROUTINE jDOS_init(thisjDOS,input,banddos,atoms,kpts,eig)
      86             : 
      87             :       USE m_types_setup
      88             :       USE m_types_kpts
      89             : 
      90             :       IMPLICIT NONE
      91             : 
      92             :       CLASS(t_jDOS),         INTENT(INOUT) :: thisjDOS
      93             :       TYPE(t_input),         INTENT(IN)    :: input
      94             :       TYPE(t_banddos),       INTENT(IN)    :: banddos
      95             : 
      96             :       TYPE(t_atoms),         INTENT(IN)    :: atoms
      97             :       TYPE(t_kpts),          INTENT(IN)    :: kpts
      98             :       REAL,INTENT(IN)                      :: eig(:,:,:)
      99             : 
     100        1382 :       thisjDOS%n_dos_to_na=banddos%dos_atomlist
     101         672 :       IF (banddos%l_jdos.AND.banddos%dos) THEN
     102         420 :          ALLOCATE(thisjDOS%comp(input%neig,0:3,2,size(banddos%dos_atomlist),kpts%nkpt),source = 0.0)
     103          62 :          ALLOCATE(thisjDOS%qmtp(input%neig,size(banddos%dos_atomlist),kpts%nkpt),source = 0.0)
     104          28 :          ALLOCATE(thisjDOS%occ(0:3,2,size(banddos%dos_atomlist)),source=0.0)
     105         108 :          thisjDOS%eig = eig
     106             :       ELSE
     107         670 :          ALLOCATE(thisjDOS%dos(0,0,0))
     108        1340 :          ALLOCATE(thisjDOS%comp(1,1,1,0,1),source = 0.0)
     109        1340 :          ALLOCATE(thisjDOS%qmtp(1,0,1),source = 0.0)
     110         670 :          ALLOCATE(thisjDOS%occ(1,1,0),source=0.0)
     111             :       END IF
     112             : 
     113         672 :       thisjDOS%name_of_dos="jDOS"
     114             : 
     115         672 :    END SUBROUTINE jDOS_init
     116           0 : end module m_types_jDOS