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_orbcomp
       7             :   use m_judft
       8             :   use m_types_eigdos
       9             :   implicit none
      10             :   PRIVATE
      11             :   public t_orbcomp
      12             :    TYPE,extends(t_eigdos):: t_orbcomp
      13             : 
      14             :       REAL, ALLOCATABLE    :: comp(:,:,:,:,:)
      15             :       REAL, ALLOCATABLE    :: qmtp(:,:,:,:)
      16             :       INTEGER,ALLOCATABLE  :: n_dos_to_na(:)
      17             :       CONTAINS
      18             :          PROCEDURE,PASS :: init => orbcomp_init
      19             :          PROCEDURE      :: get_num_weights
      20             :          PROCEDURE      :: get_weight_eig
      21             :          PROCEDURE      :: get_weight_name
      22             :          PROCEDURE      :: sym_weights
      23             :    END TYPE t_orbcomp
      24             : CONTAINS
      25             : 
      26           1 :   subroutine sym_weights(this)
      27             :     class(t_orbcomp),intent(inout):: this
      28             :     integer:: i,j
      29           1 :     return !This is done later in get_weights
      30             :     end subroutine
      31             : 
      32             : 
      33          97 :   integer function get_num_weights(this)
      34             :     class(t_orbcomp),intent(in):: this
      35          97 :     get_num_weights=23*size(this%comp,3)
      36          97 :   END function
      37             : 
      38          92 :   character(len=20) function get_weight_name(this,id)
      39             :     class(t_orbcomp),intent(in):: this
      40             :     INTEGER,intent(in)         :: id
      41             : 
      42             :     INTEGER :: ind,na,nc
      43          92 :     ind=0
      44         138 :     DO na=1,size(this%comp,3)
      45        2208 :       DO nc=1,23
      46        2162 :         ind=ind+1
      47        2208 :         if (ind==id) THEN
      48          92 :           write(get_weight_name,"(a,i0,a,i0)") "ORB:",this%n_dos_to_na(na),",ind:",nc
      49          92 :           RETURN
      50        2070 :         ELSE IF(ind>id) then
      51           0 :           CALL judft_error("Types_mcd: data not found")
      52             :         ENDIF
      53             :       ENDDO
      54             :     ENDDO
      55             :   end function
      56             : 
      57          92 :   function get_weight_eig(this,id)
      58             :     class(t_orbcomp),intent(in):: this
      59             :     INTEGER,intent(in)      :: id
      60             :     real,allocatable:: get_weight_eig(:,:,:)
      61             : 
      62             :     integer :: i,ind,na
      63             : 
      64          92 :     ind = 0
      65         138 :     DO na=1,size(this%comp,3)
      66        2208 :       DO i= 1, 23
      67        2162 :         ind = ind+1
      68        2208 :         if (ind==id) THEN
      69       35236 :             get_weight_eig=this%comp(:,i,na,:,:)*this%qmtp(:,na,:,:)/10000.
      70          92 :             call this%sym_weights_eigdos(get_weight_eig)
      71          92 :             return
      72             :         ENDIF
      73             :       ENDDO
      74             :     ENDDO
      75             :   end function
      76             : 
      77             : 
      78         672 : SUBROUTINE orbcomp_init(thisOrbcomp,input,banddos,atoms,kpts,eig)
      79             : 
      80             :    USE m_types_setup
      81             :    USE m_types_kpts
      82             : 
      83             :    IMPLICIT NONE
      84             : 
      85             :    CLASS(t_orbcomp),      INTENT(INOUT) :: thisOrbcomp
      86             :    TYPE(t_input),         INTENT(IN)    :: input
      87             :    TYPE(t_banddos),       INTENT(IN)    :: banddos
      88             : 
      89             :    TYPE(t_atoms),         INTENT(IN)    :: atoms
      90             :    TYPE(t_kpts),          INTENT(IN)    :: kpts
      91             :    REAL,INTENT(IN)                      :: eig(:,:,:)
      92        1382 :    thisOrbcomp%n_dos_to_na=banddos%dos_atomlist
      93         672 :    IF ((banddos%l_orb).AND.banddos%dos) THEN
      94          12 :       ALLOCATE(thisOrbcomp%comp(input%neig,23,size(banddos%dos_atomlist),kpts%nkpt,input%jspins))
      95          12 :       ALLOCATE(thisOrbcomp%qmtp(input%neig,size(banddos%dos_atomlist),kpts%nkpt,input%jspins))
      96         766 :       thisOrbcomp%eig=eig
      97             :    ELSE
      98         670 :       ALLOCATE(thisOrbcomp%dos(0,0,0))
      99        1340 :       ALLOCATE(thisOrbcomp%comp(1,1,0,1,input%jspins))
     100        1340 :       ALLOCATE(thisOrbcomp%qmtp(1,0,1,input%jspins))
     101             :    END IF
     102             : 
     103       37886 :    thisOrbcomp%comp = 0.0
     104        4366 :    thisOrbcomp%qmtp = 0.0
     105         672 :    thisOrbcomp%name_of_dos="Orbcomp"
     106         672 : END SUBROUTINE orbcomp_init
     107             : 
     108           0 : end module m_types_orbcomp