Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 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             : 
       7             : MODULE m_cdninf
       8             : CONTAINS
       9           0 :   SUBROUTINE cdninf(input,sym,noco,atoms,vacuum,&
      10           0 :                     cell,kpts,eigdos)
      11             :     !***********************************************************************
      12             :     !     this subroutine calculates the charge distribution of each state
      13             :     !     and writes this information to the out file. If dos or vacdos
      14             :     !     are .true. it also write the necessary information for dos or
      15             :     !     bandstructure plots to the file dosinp and vacdos respectivly
      16             :     !***********************************************************************
      17             :     !       changed this subroutine slightly for parallisation of dosinp&
      18             :     !       vacdos output (argument z replaced by ksym,jsym, removed sympsi
      19             :     !       call)                                        d.wortmann 5.99
      20             :     !
      21             :     !******** ABBREVIATIONS ************************************************
      22             :     !     qal      : l-like charge of each state
      23             :     !     qvac     : vacuum charge of each state
      24             :     !     qvlay    : charge in layers (z-ranges) in the vacuum of each state
      25             :     !     starcoeff: T if star coefficients have been calculated
      26             :     !     qstars   : star coefficients for layers (z-ranges) in vacuum
      27             :     !
      28             :     !***********************************************************************
      29             :     USE m_types
      30             :     USE m_types_dos
      31             :     USE m_types_vacdos
      32             :     USE m_types_eigdos
      33             :     USE m_constants
      34             :     IMPLICIT NONE
      35             :     TYPE(t_input),INTENT(IN)       :: input
      36             :     TYPE(t_vacuum),INTENT(IN)      :: vacuum
      37             :     TYPE(t_noco),INTENT(IN)        :: noco
      38             :     TYPE(t_sym),INTENT(IN)         :: sym
      39             :     TYPE(t_cell),INTENT(IN)        :: cell
      40             :     TYPE(t_kpts),INTENT(IN)        :: kpts
      41             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      42             :     CLASS(t_eigdos_list),INTENT(IN)   :: eigdos(:)
      43             :     CLASS(t_eigdos),pointer :: dos
      44             :     Type(t_vacdos),pointer  :: vacdos
      45             :     !     ..
      46             :     !     .. Local Scalars ..
      47             :     REAL qalmax,qishlp,qvacmt,qvact
      48             :     INTEGER i,iband,ilay,iqispc,iqvacpc,ityp,itypqmax,ivac,l,lqmax
      49             :     INTEGER ikpt,jspin
      50             :     !     ..
      51             :     !     .. Local Arrays ..
      52           0 :     INTEGER iqalpc(0:3,atoms%ntype),max_l_type(2)
      53             :     CHARACTER chstat(1:4)
      54             :     !     ..
      55             :     !     .. Data statements ..
      56             :     DATA chstat/'s','p','d','f'/
      57             :     !     ..
      58             : 
      59           0 :     dos=>eigdos(1)%p
      60             : 
      61           0 :     vacdos=>null()
      62           0 :     if (size(eigdos)>1) THEN
      63             :       associate(vd=>eigdos(2)%p)
      64           0 :       select type(vd)
      65             :       type is (t_vacdos)
      66           0 :         vacdos=>vd
      67             :       end select  
      68             :       end associate
      69             :     endif  
      70             : 
      71             :     select type(dos)
      72             :     type is (t_dos)
      73             : 
      74           0 :     DO jspin=1,input%jspins
      75           0 :       DO ikpt=1,kpts%nkpt
      76             : 
      77           0 :     IF (input%film) THEN
      78           0 :        WRITE (oUnit,FMT=8000) (kpts%bk(i,ikpt),i=1,2)
      79             : 8000   FORMAT (/,3x,'q(atom,l): k=',3f10.5,/,/,t8,'e',t13,'max',t18,&
      80             :             &          'int',t22,'vac',t28,'spheres(s,p,d,f)')
      81             :     ELSE
      82           0 :        WRITE (oUnit,FMT=8010) (kpts%bk(i,ikpt),i=1,3)
      83             : 8010   FORMAT (/,3x,'q(atom,l): k=',3f10.5,/,/,t8,'e',t13,'max',t18,&
      84             :             &          'int',t24,'spheres(s,p,d,f)')
      85             :     END IF
      86             : 8020 FORMAT (1x,3e20.12,i6,e20.12)
      87             : 
      88           0 :     DO iband = 1,count(dos%eig(:,ikpt,jspin)<1E99)
      89           0 :       if (associated(vacdos)) THEN
      90           0 :         qvact=sum(vacdos%qvac(iband,:,ikpt,jspin))
      91             :       else
      92             :         qvact = 0
      93             :       endif
      94           0 :        iqvacpc = NINT(qvact*100.0)
      95             :        !qvacmt = qvact
      96           0 :        QVACMT=0.0
      97           0 :        iqalpc(0:3,:) = NINT(dos%qal(0:3,:,iband,ikpt,jspin)*100.0)
      98           0 :        DO l=0,3
      99           0 :          qvacmt=qvacmt+dot_product(dos%qal(l,:,iband,ikpt,jspin),atoms%neq)
     100             :        ENDDO
     101           0 :        max_l_type=maxloc(dos%qal(0:3,:,iband,ikpt,jspin))
     102           0 :        qishlp = 1.0 - qvacmt
     103           0 :        IF (noco%l_noco) qishlp = dos%qis(iband,ikpt,jspin)
     104           0 :        iqispc = NINT(qishlp*100.0)
     105             : 
     106           0 :        IF (input%film) THEN
     107           0 :           WRITE (oUnit,FMT=8040) dos%eig(iband,ikpt,jspin),chstat(max_l_type(1)),max_l_type(2),&
     108           0 :                &        iqispc,iqvacpc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
     109             : 8040      FORMAT (f10.4,2x,a1,i2,2x,2i3, (t26,6 (4i3,1x)))
     110             :        ELSE
     111           0 :           WRITE (oUnit,FMT=8080) dos%eig(iband,ikpt,jspin),chstat(max_l_type(1)),max_l_type(2),&
     112           0 :                &        iqispc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
     113             : 8080      FORMAT (f10.4,2x,a1,i2,2x,i3, (t26,6 (4i3,1x)))
     114             :        END IF
     115             :     END DO
     116             :   ENDDO
     117             : ENDDO
     118             : end select
     119           0 :   END SUBROUTINE cdninf
     120           0 : END MODULE m_cdninf