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_vacdos
       7             :   USE m_juDFT
       8             :   USE m_types_eigdos
       9             :   IMPLICIT NONE
      10             :   PRIVATE
      11             :   PUBLIC:: t_vacdos
      12             :   TYPE,extends(t_eigdos):: t_vacdos
      13             :      REAL,    ALLOCATABLE :: qvac(:,:,:,:)
      14             :      REAL,    ALLOCATABLE :: qvlay(:,:,:,:,:)
      15             :      COMPLEX, ALLOCATABLE :: qstars(:,:,:,:,:,:)
      16             :      CHARACTER(len=20),ALLOCATABLE:: weight_names(:)!This must be allocated in init of derived type
      17             : 
      18             :    CONTAINS
      19             :      PROCEDURE,PASS :: init => dos_init
      20             :      PROCEDURE      :: get_weight_eig
      21             :      PROCEDURE      :: get_num_spins
      22             :      PROCEDURE      :: get_num_weights
      23             :      PROCEDURE      :: get_weight_name
      24             :   END TYPE t_vacdos
      25             : 
      26             : CONTAINS
      27             : 
      28           0 :   integer function get_num_weights(this)
      29             :     class(t_vacdos),intent(in):: this
      30           0 :     get_num_weights=0
      31           0 :     if (allocated(this%weight_names)) get_num_weights=size(this%weight_names)
      32           0 :   end function
      33             : 
      34           0 :   character(len=20) function get_weight_name(this,id)
      35             :     class(t_vacdos),intent(in):: this
      36             :     INTEGER,intent(in)         :: id
      37           0 :     if (.not.allocated(this%weight_names)) call judft_error("No weight names in t_eigdos")
      38           0 :     if (id>size(this%weight_names)) call judft_error("Not enough weight names in t_eigdos")
      39           0 :     get_weight_name=this%weight_names(id)
      40           0 :   end function
      41             : 
      42             : 
      43           0 :   integer function get_num_spins(this)
      44             :     class(t_vacdos),intent(in):: this
      45           0 :     get_num_spins= size(this%qvac,4)
      46           0 :   end function
      47             : 
      48           0 :   function get_weight_eig(this,id)
      49             :     class(t_vacdos),intent(in):: this
      50             :     INTEGER,intent(in)     :: id
      51             :     real,allocatable:: get_weight_eig(:,:,:)
      52             : 
      53             :     INTEGER :: ind,l,ntype,i
      54           0 :     allocate(get_weight_eig(size(this%qvac,1),size(this%qvac,3),size(this%qvac,4)))
      55             : 
      56           0 :     ind=0
      57           0 :     do i=1,2
      58           0 :       ind=ind+1
      59           0 :       if (ind==id) get_weight_eig=this%qvac(:,i,:,:)
      60             :     end do
      61           0 :     do i=1,size(this%qvlay,2)
      62           0 :       ind=ind+1
      63           0 :       if (ind==id) get_weight_eig=this%qvlay(:,i,1,:,:)
      64           0 :       ind=ind+1
      65           0 :       if (ind==id) get_weight_eig=this%qvlay(:,i,2,:,:)
      66             :     end do
      67           0 :     DO l=1,size(this%qstars,3)
      68           0 :       do i=1,size(this%qstars,1)
      69           0 :         ind=ind+1
      70           0 :         if (ind==id) get_weight_eig=real(this%qstars(i,:,l,1,:,:))
      71           0 :         ind=ind+1
      72           0 :         if (ind==id) get_weight_eig=aimag(this%qstars(i,:,l,1,:,:))
      73           0 :         ind=ind+1
      74           0 :         if (ind==id) get_weight_eig=real(this%qstars(i,:,l,2,:,:))
      75           0 :         ind=ind+1
      76           0 :         if (ind==id) get_weight_eig=aimag(this%qstars(i,:,l,2,:,:))
      77             :       end do
      78             :     end do
      79             :   end function
      80             : 
      81         672 : SUBROUTINE dos_init(thisDOS,input,atoms,kpts,banddos,eig)
      82             :   USE m_types_input
      83             :   USE m_types_atoms
      84             :   USE m_types_banddos
      85             :   USE m_types_kpts
      86             :   IMPLICIT NONE
      87             :   CLASS(t_vacdos),           INTENT(INOUT) :: thisDOS
      88             :   TYPE(t_input),          INTENT(IN)    :: input
      89             :   TYPE(t_atoms),          INTENT(IN)    :: atoms
      90             :   TYPE(t_kpts),           INTENT(IN)    :: kpts
      91             :   TYPE(t_banddos),         INTENT(IN)    :: banddos
      92             :   real,intent(in)                       :: eig(:,:,:)
      93             : 
      94             :   INTEGER :: ntype,l,i,ind
      95             :   character :: spdfg(0:4)=["s","p","d","f","g"]
      96         672 :   thisDOS%name_of_dos="Vacuum"
      97      406524 :   thisDOS%eig=eig
      98        3360 :   ALLOCATE(thisDOS%qvac(input%neig,2,kpts%nkpt,input%jspins))
      99        4704 :   ALLOCATE(thisDOS%qvlay(input%neig,banddos%layers,2,kpts%nkpt,input%jspins))
     100        5376 :   ALLOCATE(thisDOS%qstars(banddos%nstars,input%neig,banddos%layers,2,kpts%nkpt,input%jspins))
     101             : 
     102      820518 :   thisDOS%qvac = 0.0
     103       33858 :   thisDOS%qvlay = 0.0
     104       33858 :   thisDOS%qstars = CMPLX(0.0,0.0)
     105             : 
     106         672 :   if (.not.banddos%vacdos) THEN
     107         672 :     allocate(thisDOS%weight_names(0))
     108         672 :     RETURN
     109             :   endif
     110           0 :   allocate(thisDOS%weight_names(2+banddos%layers*(4*banddos%nstars+2)))
     111           0 :   ind=1
     112           0 :   thisDOS%weight_names(ind)="VAC1"
     113           0 :   ind=ind+1
     114           0 :   thisDOS%weight_names(ind)="VAC2"
     115           0 :   do i=1,banddos%layers
     116           0 :     ind=ind+1
     117           0 :     write(thisDOS%weight_names(ind),"(a,i0)") "LAYER1-",i
     118           0 :     ind=ind+1
     119           0 :     write(thisDOS%weight_names(ind),"(a,i0)") "LAYER2-",i
     120             :   end do
     121           0 :   DO l=1,banddos%layers
     122           0 :     do i=1,banddos%nstars
     123           0 :       ind=ind+1
     124           0 :       write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC1)-",l,"-",i
     125           0 :       ind=ind+1
     126           0 :       write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC1)-",l,"-",i
     127           0 :       ind=ind+1
     128           0 :       write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC2)-",l,"-",i
     129           0 :       ind=ind+1
     130           0 :       write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC2)-",l,"-",i
     131             :     end do
     132             :   end do
     133             : 
     134             : 
     135             : END SUBROUTINE dos_init
     136             : 
     137             : 
     138             : 
     139           0 : END MODULE m_types_vacdos