Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2018 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_dos
       7             :   USE m_juDFT
       8             :   USE m_types_eigdos
       9             :   IMPLICIT NONE
      10             :   PRIVATE
      11             :   PUBLIC:: t_dos
      12             :   TYPE,extends(t_eigdos):: t_dos
      13             :      INTEGER,ALLOCATABLE :: neq(:)
      14             :      INTEGER, ALLOCATABLE :: jsym(:,:,:)
      15             :      REAL,    ALLOCATABLE :: qis(:,:,:)
      16             :      REAL,    ALLOCATABLE :: qal(:,:,:,:,:)
      17             :      REAL,    ALLOCATABLE :: qTot(:,:,:)
      18             :      CHARACTER(len=20),ALLOCATABLE:: weight_names(:)!This must be allocated in init of derived type
      19             : 
      20             :    CONTAINS
      21             :      PROCEDURE,PASS :: init => dos_init
      22             :      PROCEDURE      :: get_weight_eig
      23             :      PROCEDURE      :: get_num_spins
      24             :      PROCEDURE      :: get_num_weights
      25             :      PROCEDURE      :: get_weight_name
      26             :      PROCEDURE      :: sym_weights
      27             :   END TYPE t_dos
      28             : 
      29             : CONTAINS
      30             : 
      31           5 : subroutine sym_weights(this)
      32             :   class(t_dos),intent(inout):: this
      33             : 
      34             :   integer:: i,j
      35             : 
      36          25 :   DO i=0,size(this%qal,1)-1
      37          65 :     DO j=1,size(this%qal,2)
      38          60 :       call this%sym_weights_eigdos(this%qal(i,j,:,:,:))
      39             :     enddo
      40             :   ENDDO  
      41           5 :   call this%sym_weights_eigdos(this%qis(:,:,:))
      42           5 :   call this%sym_weights_eigdos(this%qtot(:,:,:))
      43           5 : end subroutine
      44             : 
      45        5367 :   integer function get_num_weights(this)
      46             :     class(t_dos),intent(in):: this
      47        5367 :     get_num_weights=0
      48        5367 :     if (allocated(this%weight_names)) get_num_weights=size(this%weight_names)
      49        5367 :   end function
      50             : 
      51         156 :   character(len=20) function get_weight_name(this,id)
      52             :     class(t_dos),intent(in):: this
      53             :     INTEGER,intent(in)         :: id
      54         156 :     if (.not.allocated(this%weight_names)) call judft_error("No weight names in t_eigdos")
      55         156 :     if (id>size(this%weight_names)) call judft_error("Not enough weight names in t_eigdos")
      56         156 :     get_weight_name=this%weight_names(id)
      57         156 :   end function
      58             : 
      59             : 
      60             : 
      61             : 
      62           0 :   integer function get_num_spins(this)
      63             :     class(t_dos),intent(in):: this
      64           0 :     get_num_spins= size(this%qis,3)
      65           0 :   end function
      66             : 
      67         168 :   function get_weight_eig(this,id)
      68             :     class(t_dos),intent(in):: this
      69             :     INTEGER,intent(in)     :: id
      70             :     real,allocatable:: get_weight_eig(:,:,:)
      71             : 
      72             :     INTEGER :: ind,l,ntype,i
      73         420 :     allocate(get_weight_eig,mold=this%qis)
      74             : 
      75          84 :     if (id==1) THEN
      76        3971 :        get_weight_eig=this%qTot
      77        3859 :        if (all(this%qis==0.0))  then
      78        3857 :           get_weight_eig= 1.0
      79             :        END IF
      80             :     END IF
      81          84 :     if (id==2) THEN
      82        3971 :       get_weight_eig=this%qis
      83        3859 :       if (all(get_weight_eig==0.0))  then
      84             :         !No INT dos calculated so far...
      85        3857 :         get_weight_eig=1.0
      86          19 :         DO ntype=1,size(this%qal,2)
      87          71 :           DO l=0,3
      88       38709 :             get_weight_eig=get_weight_eig-this%qal(l,ntype,:,:,:)*this%neq(ntype)
      89             :           ENDDO
      90             :         ENDDO
      91             :       endif
      92             :     endif
      93        4047 :     if (id==3) get_weight_eig=1.*this%jsym
      94          84 :     ind=3
      95         253 :     DO ntype=1,size(this%qal,2)
      96         929 :       DO l=0,3
      97         676 :         ind=ind+1
      98       39913 :         if (ind==id) get_weight_eig=this%qal(l,ntype,:,:,:)
      99             :       ENDDO
     100             :     ENDDO
     101             :   end function
     102             : 
     103         682 : SUBROUTINE dos_init(thisDOS,input,atoms,kpts,banddos,eig)
     104             :   USE m_types_input
     105             :   USE m_types_atoms
     106             :   USE m_types_banddos
     107             :   USE m_types_kpts
     108             :   IMPLICIT NONE
     109             :   CLASS(t_dos),           INTENT(INOUT) :: thisDOS
     110             :   TYPE(t_input),          INTENT(IN)    :: input
     111             :   TYPE(t_atoms),          INTENT(IN)    :: atoms
     112             :   TYPE(t_kpts),           INTENT(IN)    :: kpts
     113             :   TYPE(t_banddos),         INTENT(IN)    :: banddos
     114             :   real,intent(in)                       :: eig(:,:,:)
     115             : 
     116             :   INTEGER :: ntype,l,i,ind
     117             :   character :: spdfg(0:4)=["s","p","d","f","g"]
     118         682 :   thisDOS%name_of_dos="Local"
     119        1414 :   thisDOS%neq=atoms%neq(banddos%dos_typelist)
     120      406634 :   thisDOS%eig=eig
     121        3410 :   ALLOCATE(thisDOS%jsym(input%neig,kpts%nkpt,input%jspins))
     122        3410 :   ALLOCATE(thisDOS%qis(input%neig,kpts%nkpt,input%jspins))
     123        4092 :   ALLOCATE(thisDOS%qal(0:3,size(banddos%dos_typelist),input%neig,kpts%nkpt,input%jspins))
     124        2728 :   ALLOCATE(thisDOS%qTot(input%neig,kpts%nkpt,input%jspins))
     125             : 
     126      405952 :   thisDOS%jsym = 0
     127      405952 :   thisDOS%qis = 0.0
     128      485632 :   thisDOS%qal = 0.0
     129      405952 :   thisDOS%qTot = 0.0
     130             : 
     131        2046 :   allocate(thisDOS%weight_names(3+4*size(banddos%dos_typelist)))
     132         682 :   thisDOS%weight_names(1)="Total"
     133         682 :   thisDOS%weight_names(2)="INT"
     134         682 :   thisDOS%weight_names(3)="Sym"
     135         682 :   ind=3
     136         702 :   DO ntype=1,size(banddos%dos_typelist)
     137         782 :     DO l=0,3
     138          80 :       ind=ind+1
     139         100 :       write(thisDOS%weight_names(ind),"(a,i0,a)") "MT:",banddos%dos_typelist(ntype),spdfg(l)
     140             :     ENDDO
     141             :   ENDDO
     142             : 
     143             : 
     144         682 : END SUBROUTINE dos_init
     145             : 
     146             : 
     147             : 
     148           0 : END MODULE m_types_dos