LCOV - code coverage report
Current view: top level - dos - cdninf.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 69 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          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(&
      10             :        &                  input,sym,noco,jspin,atoms,vacuum,&
      11             :        &                  sliceplot,banddos,ikpt,bkpt,wk,&
      12             :        &                  cell,kpts,&
      13           0 :        &                  nbands,eig,qal,qis,qvac,qvlay,&
      14           0 :        &                  qstars,jsym,ksym)
      15             :     !***********************************************************************
      16             :     !     this subroutine calculates the charge distribution of each state
      17             :     !     and writes this information to the out file. If dos or vacdos
      18             :     !     are .true. it also write the necessary information for dos or
      19             :     !     bandstructure plots to the file dosinp and vacdos respectivly
      20             :     !***********************************************************************
      21             :     !       changed this subroutine slightly for parallisation of dosinp&
      22             :     !       vacdos output (argument z replaced by ksym,jsym, removed sympsi
      23             :     !       call)                                        d.wortmann 5.99
      24             :     !
      25             :     !******** ABBREVIATIONS ************************************************
      26             :     !     qal      : l-like charge of each state
      27             :     !     qvac     : vacuum charge of each state
      28             :     !     qvlay    : charge in layers (z-ranges) in the vacuum of each state
      29             :     !     starcoeff: T if star coefficients have been calculated
      30             :     !     qstars   : star coefficients for layers (z-ranges) in vacuum
      31             :     !
      32             :     !***********************************************************************
      33             :     USE m_types
      34             :     IMPLICIT NONE
      35             :     TYPE(t_banddos),INTENT(IN)     :: banddos
      36             :     TYPE(t_sliceplot),INTENT(IN)   :: sliceplot
      37             :     TYPE(t_input),INTENT(IN)       :: input
      38             :     TYPE(t_vacuum),INTENT(IN)      :: vacuum
      39             :     TYPE(t_noco),INTENT(IN)        :: noco
      40             :     TYPE(t_sym),INTENT(IN)         :: sym
      41             :     TYPE(t_cell),INTENT(IN)        :: cell
      42             :     TYPE(t_kpts),INTENT(IN)        :: kpts
      43             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      44             : 
      45             :     !     .. Scalar Arguments ..
      46             :     REAL,INTENT(IN):: wk
      47             :     INTEGER,INTENT(IN):: ikpt,jspin ,nbands 
      48             :     !
      49             :     !     STM Arguments
      50             :     COMPLEX, INTENT (IN) ::qstars(:,:,:,:) !(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
      51             :     !     ..
      52             :     !     .. Array Arguments ..
      53             :     REAL,    INTENT (IN) :: qvlay(:,:,:) !DIMENSION%neigd,vacuum%layerd,2)
      54             :     REAL,    INTENT (IN) :: qis(:,:,:)!(DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd) 
      55             :     REAL,    INTENT (IN) :: qvac(:,:,:,:) !(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
      56             :     REAL,    INTENT (IN) :: bkpt(3)
      57             :     REAL,    INTENT (IN) :: eig(:)!(DIMENSION%neigd)
      58             :     REAL,    INTENT (IN) :: qal(0:,:,:)!(0:3,atoms%ntype,neigd)
      59             :     INTEGER, INTENT (IN) :: jsym(:)!(DIMENSION%neigd)
      60             :     INTEGER, INTENT (IN) :: ksym(:)!(neigd)
      61             :     !     ..
      62             :     !     .. Local Scalars ..
      63             :     REAL qalmax,qishlp,qvacmt,qvact
      64             :     INTEGER i,iband,ilay,iqispc,iqvacpc,ityp,itypqmax,ivac,l,lqmax
      65             :     INTEGER istar
      66             :     !     ..
      67             :     !     .. Local Arrays ..
      68             :     REAL cartk(3)
      69           0 :     INTEGER iqalpc(0:3,atoms%ntype)
      70             :     CHARACTER chstat(0:3)
      71             :     !     ..
      72             :     !     .. Data statements ..
      73             :     DATA chstat/'s','p','d','f'/
      74             :     !     ..
      75             : 
      76             : 
      77           0 :     IF (input%film) THEN
      78           0 :        WRITE (6,FMT=8000) (bkpt(i),i=1,3)
      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           0 :        IF (banddos%dos) THEN
      82           0 :           cartk=MATMUL(bkpt,cell%bmat)
      83           0 :           WRITE (85,FMT=8020) cartk(1),cartk(2),cartk(3),nbands,wk
      84             :           !     *************** for vacdos shz Jan.96
      85           0 :           IF (banddos%vacdos) THEN
      86           0 :              WRITE (86,FMT=8020) cartk(1),cartk(2),cartk(3),nbands,wk
      87             :           END IF
      88             :        END IF
      89             :     ELSE
      90           0 :        WRITE (6,FMT=8010) (bkpt(i),i=1,3)
      91             : 8010   FORMAT (/,3x,'q(atom,l): k=',3f10.5,/,/,t8,'e',t13,'max',t18,&
      92             :             &          'int',t24,'spheres(s,p,d,f)')
      93           0 :        IF (banddos%dos) THEN
      94           0 :           cartk=MATMUL(bkpt,cell%bmat)
      95           0 :           WRITE (85,FMT=8020) cartk(1),cartk(2),cartk(3),nbands,wk
      96             :        END IF
      97             :     END IF
      98             : 8020 FORMAT (1x,3e20.12,i6,e20.12)
      99             : 
     100           0 :     DO iband = 1,nbands
     101           0 :        IF (sliceplot%slice) THEN
     102           0 :           WRITE (6,FMT=8030) iband,eig(iband)
     103             : 8030      FORMAT (' cdnval: slice for i=',i4,'  and energy',1e12.4)
     104             :        END IF
     105             : 
     106           0 :        qvacmt = 0.0
     107           0 :        qvact = 0.0
     108           0 :        IF (input%film) THEN
     109           0 :           DO ivac = 1,vacuum%nvac
     110           0 :              qvact = qvact + qvac(iband,ivac,ikpt,jspin)
     111             :           END DO
     112           0 :           IF (sym%invs .OR. sym%zrfs) qvact = 2.0*qvact
     113           0 :           iqvacpc = NINT(qvact*100.0)
     114           0 :           qvacmt = qvact
     115             :        END IF
     116           0 :        qalmax = 0.0
     117           0 :        lqmax = 0
     118           0 :        itypqmax = 0
     119           0 :        DO ityp = 1,atoms%ntype
     120           0 :           DO l = 0,3
     121           0 :              iqalpc(l,ityp) = NINT(qal(l,ityp,iband)*100.0)
     122           0 :              qvacmt = qvacmt + qal(l,ityp,iband)*atoms%neq(ityp)
     123           0 :              IF (qalmax.LT.qal(l,ityp,iband)) THEN
     124           0 :                 qalmax = qal(l,ityp,iband)
     125           0 :                 lqmax = l
     126           0 :                 itypqmax = ityp
     127             :              END IF
     128             :           END DO
     129             :        END DO
     130           0 :        qishlp = 1.0 - qvacmt
     131           0 :        IF (noco%l_noco) qishlp = qis(iband,ikpt,jspin)
     132           0 :        iqispc = NINT(qishlp*100.0)
     133           0 :        IF (input%film) THEN
     134           0 :           WRITE (6,FMT=8040) eig(iband),chstat(lqmax),itypqmax,&
     135           0 :                &        iqispc,iqvacpc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
     136             : 8040      FORMAT (f10.4,2x,a1,i2,2x,2i3, (t26,6 (4i3,1x)))
     137           0 :           IF (banddos%dos) THEN
     138           0 :              IF (banddos%ndir.NE.0) THEN
     139           0 :                 WRITE (85,FMT=8050) eig(iband),ksym(iband),&
     140           0 :                      &              jsym(iband),qvact, ((qal(l,ityp,iband),l=0,3),&
     141           0 :                      &              ityp=1,atoms%ntype)
     142             : 8050            FORMAT (f12.5,2i2,f12.5,/, (4f12.5))
     143             :              ELSE
     144           0 :                 WRITE (85,FMT=8060) eig(iband),&
     145           0 :                      &              ((qal(l,ityp,iband),l=0,3),ityp=1,atoms%ntype),qvact
     146             : 8060            FORMAT (10f12.7)
     147             :              END IF
     148             :           END IF
     149             :           !     ***************** for vacdos shz Jan.96
     150           0 :           IF (banddos%vacdos) THEN
     151           0 :              IF (.NOT.vacuum%starcoeff) THEN
     152           0 :                 WRITE (86,FMT=8070) eig(iband),&
     153           0 :                      &               ((qvlay(iband,ilay,ivac),ilay=1,vacuum%layers),&
     154           0 :                      &                               ivac=1,vacuum%nvac)
     155             :              ELSE
     156           0 :                 WRITE (86,FMT=8070) eig(iband),&
     157           0 :                      &                 ((qvlay(iband,ilay,ivac),&
     158           0 :                      &                 (REAL(qstars(istar,iband,ilay,ivac)),&
     159           0 :                      &                 istar=1,vacuum%nstars-1),ilay=1,vacuum%layers),ivac=1,vacuum%nvac)
     160             :              END IF
     161             : 8070         FORMAT (f10.4,2x,20(e16.8,1x))
     162             : 
     163             :           END IF
     164             :           !     **************************************
     165             :        ELSE
     166           0 :           WRITE (6,FMT=8080) eig(iband),chstat(lqmax),itypqmax,&
     167           0 :                &        iqispc, ((iqalpc(l,ityp),l=0,3),ityp=1,atoms%ntype)
     168             : 8080      FORMAT (f10.4,2x,a1,i2,2x,i3, (t26,6 (4i3,1x)))
     169           0 :           IF (banddos%dos) THEN
     170           0 :              IF (banddos%ndir.NE.0) THEN
     171           0 :                 WRITE (85,FMT=8050) eig(iband),ksym(iband),&
     172           0 :                      &              jsym(iband),0.0, ((qal(l,ityp,iband),l=0,3),ityp=1,&
     173           0 :                      &              atoms%ntype)
     174             :              ELSE
     175           0 :                 WRITE (85,FMT=8060) eig(iband),&
     176           0 :                      &              ((qal(l,ityp,iband),l=0,3),ityp=1,atoms%ntype),0.0
     177             :              END IF
     178             :           END IF
     179             :        END IF
     180             :     END DO
     181           0 :   END SUBROUTINE cdninf
     182             : END MODULE m_cdninf

Generated by: LCOV version 1.13