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

  END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl