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

          Line data    Source code
       1             : MODULE m_Ekwritesl
       2             :   use m_juDFT
       3             : CONTAINS
       4           0 :   SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,dos,slab,orbcomp,results)
       5             :     !-----------------------------------------------------------------
       6             :     !-- now write E(k) for all kpts if on T3E
       7             :     !-- now read data from tmp_dos and write of E(k) in  ek_orbcomp
       8             :     !-----------------------------------------------------------------
       9             :     USE m_types
      10             :     IMPLICIT NONE
      11             :     TYPE(t_dimension),INTENT(IN)   :: dimension
      12             :     TYPE(t_input),INTENT(IN)       :: input
      13             :     TYPE(t_vacuum),INTENT(IN)      :: vacuum
      14             :     TYPE(t_sym),INTENT(IN)         :: sym
      15             :     TYPE(t_cell),INTENT(IN)        :: cell
      16             :     TYPE(t_dos),INTENT(IN)         :: dos
      17             :     TYPE(t_kpts),INTENT(IN)        :: kpts
      18             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      19             :     TYPE(t_slab),INTENT(IN)        :: slab
      20             :     TYPE(t_orbcomp),INTENT(IN)     :: orbcomp
      21             :     TYPE(t_results),INTENT(IN)     :: results
      22             :     !   ..
      23             :     !     .. Scalar Arguments ..
      24             :     INTEGER, INTENT (IN) :: eig_id
      25             :     INTEGER, INTENT (IN) :: jspin
      26             :     !     ..
      27             :     !     .. Local Scalars
      28             :     INTEGER :: nbands,ikpt,kspin,j,i,n,it ,na,iband,mt,l
      29             :     INTEGER :: ivac,m
      30             :     REAL    :: wk
      31             :     !     ..
      32             :     !     .. Local Arrays
      33           0 :     INTEGER  norb(23),iqsl(slab%nsld),iqvacpc(2)
      34             :     REAL     qvact(2)
      35           0 :     REAL, ALLOCATABLE :: eig(:)
      36             :     CHARACTER (len=2) :: chntype
      37             :     CHARACTER (len=99) :: chform
      38             :     !     ..
      39           0 :     IF (slab%nsl.GT.slab%nsld)  THEN
      40           0 :        CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
      41             :     ENDIF
      42           0 :     ALLOCATE(eig(dimension%neigd))
      43             :     !  --->     open files for a bandstucture with an orbital composition
      44             :     !  --->     in the case of the film geometry
      45             :     !
      46           0 :     IF (jspin.EQ.1)  OPEN (130,file='ek_orco_11') 
      47           0 :     IF (jspin.EQ.2)  OPEN (130,file='ek_orco_12')
      48             :     !
      49             :     ! ----->       write bandstructure to ek_orbcomp - file
      50             :     ! 
      51           0 :     WRITE (chntype,'(i2)') slab%nsl
      52             :     chform = "('E',i3,'= ',f10.4,4x,'vac ( vacuum%layers ) vac = ',i3,' ('&
      53           0 :          &        ,"//chntype//"(i3,2x),')',i3))"
      54           0 :     WRITE (130,FMT=901) 
      55           0 :     WRITE (130,FMT=902) 
      56           0 :     WRITE (130,FMT=901) 
      57           0 :     WRITE (130,FMT=903) slab%nsl,vacuum%nvac,kpts%nkpt
      58           0 :     WRITE (130,FMT=904) atoms%ntype,(atoms%neq(n),n=1,atoms%ntype) 
      59           0 :     WRITE (130,FMT=805)  
      60           0 :     DO j=1,slab%nsl
      61           0 :        WRITE (130,FMT=806) j,(slab%nslat(i,j),i=1,atoms%nat)
      62             :     ENDDO
      63           0 :     DO kspin = 1,input%jspins
      64           0 :        WRITE (130,FMT=907)  kspin,input%jspins
      65             :        !============================================================== 
      66             : 901    FORMAT (5X,'--------------------------------------')
      67             : 902    FORMAT (5X,'-------- E(k) for a input%film  ------------')
      68             : 903    FORMAT (5X,' nsl =',i3,'   vacuum%nvac =',i2,'   kpts%nkpt =',i4,/)
      69             : 904    FORMAT (5X,' atoms%ntype = ',i3,' atoms%neq(n) = ',50i3)
      70             : 907    FORMAT (/,5X,' kspin = ',i4,' input%jspins = ',i4)
      71             : 805    FORMAT (5X,'  nsl   nslat(1:nate,nsli)  ')
      72             : 806    FORMAT (5X,51i4)
      73             :        !==============================================================
      74           0 :        DO ikpt=1,kpts%nkpt
      75             : 
      76           0 :           WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3)
      77             : 8000      FORMAT (/,3x,'  k =',3f10.5,/)
      78             :           !
      79           0 :           DO iband = 1,results%neig(ikpt,kspin)
      80           0 :              qvact = 0.0
      81           0 :              DO ivac = 1,vacuum%nvac
      82           0 :                 qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin)
      83             :              ENDDO
      84           0 :              IF (sym%invs .OR. sym%zrfs)    qvact(2) = qvact(1)
      85           0 :              iqvacpc(:) = nint(qvact(:)*100.0)
      86           0 :              DO j = 1,slab%nsl
      87           0 :                 iqsl(j) = nint((slab%qintsl(j,iband,ikpt,kspin) + slab%qmtsl(j,iband,ikpt,kspin))*100.0) 
      88             :              ENDDO
      89           0 :              WRITE(130,FMT=chform) iband,results%eig(iband,ikpt,kspin),iqvacpc(2),(iqsl(l),l=1,slab%nsl),iqvacpc(1)
      90           0 :              WRITE(130,FMT=9) 
      91           0 :              WRITE(130,FMT=8)
      92           0 :              WRITE(130,FMT=9) 
      93           0 :              DO n = 1,slab%nsl
      94           0 :                 mt=0 
      95           0 :                 DO  it=1,atoms%ntype
      96           0 :                    DO  m=1,atoms%neq(it)
      97           0 :                       mt=mt+1   
      98           0 :                       na = slab%nslat(mt,n) 
      99           0 :                       IF (na.EQ.1) THEN
     100           0 :                          DO  j=1,23
     101           0 :                             norb(j) = nint ( orbcomp%comp(iband,j,mt,ikpt,kspin) )
     102             :                          ENDDO
     103           0 :                          WRITE (130,FMT=5) n,it,m,(norb(l),l=1,23),orbcomp%qmtp(iband,mt,ikpt,kspin)
     104             :                       ENDIF
     105             :                    ENDDO
     106             :                 enddo
     107             :              ENDDO              ! over ( n = 1,nsl ) 
     108           0 :              WRITE(130,FMT=9) 
     109             :           ENDDO           ! over ( iband = 1,results%neig(ikpt,kspin) ) 
     110             :        ENDDO        ! over ( ikpt=1,kpts%nkpt )
     111             :     ENDDO         ! over ( kspin = 1,input%jspins )  
     112           0 :     CLOSE (130)
     113             :     !
     114             :     ! 8040 FORMAT ('E',i3,'= ',f10.4,4x,'vac | layers | vac = ',i3,' | ',50(i3,2x),' | ',i3)
     115             : 8   FORMAT('|lyr,tp,at| S | Px  Py  Pz | Dxy  Dyz  Dzx  Dx-y Dz2 |',&
     116             :          &  ' Fx3  Fy3  Fz3  Fx2y Fy2z Fz2x Fxyz| Fz2x Fz2y Fz3  Fxyz Fx2z',&
     117             :          &  ' Fx3  Fy3 |  mt  |') 
     118             : 5   FORMAT('|',i3,',',i2,',',i2,'|',i3,'|',3(i3,1x),'|',&
     119             :          &        5(1x,i3,1x),'|',&
     120             :          &        7(1x,i3,1x),'|',7(1x,i3,1x),'|',f6.1,'|')
     121             : 9   FORMAT(133('-'))
     122             :     !
     123           0 :     DEALLOCATE ( eig )
     124             : 
     125           0 :   END SUBROUTINE Ek_write_sl
     126             : END MODULE m_Ekwritesl

Generated by: LCOV version 1.13