Ek_write_sl.f90 6.27 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,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 17 18
    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
    TYPE(t_kpts),INTENT(IN)        :: kpts
    TYPE(t_atoms),INTENT(IN)       :: atoms
19
    TYPE(t_slab),INTENT(IN)        :: slab
20 21
    !	..
    !     .. Scalar Arguments ..
22 23
    INTEGER, INTENT (IN) :: eig_id
    INTEGER, INTENT (IN) :: jspin
24 25 26 27 28 29 30
    !     ..
    !     .. Local Scalars
    INTEGER :: nbands,ikpt,kspin,j,i,n,it ,na,iband,mt,l
    INTEGER :: ivac,m
    REAL    :: wk
    !     ..
    !     .. Local Arrays
31
    INTEGER  norb(23),iqsl(slab%nsld),iqvacpc(2)
32
    REAL     qvact(2)
33
    REAL, ALLOCATABLE :: eig(:),qvac(:,:,:,:),orbcomp(:,:,:,:,:)
34 35 36
    REAL, ALLOCATABLE :: qal(:,:,:),qis(:),qvlay(:,:,:)
    COMPLEX,ALLOCATABLE::qstars(:,:,:,:)
    INTEGER,ALLOCATABLE::ksym(:),jsym(:)
37 38 39 40
    REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:),qmtp(:,:,:,:)
    CHARACTER (len=2) :: chntype
    CHARACTER (len=99) :: chform
    !     ..
41
    IF (slab%nsl.GT.slab%nsld)  THEN
42 43
       CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
44
    ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%nat,kpts%nkpt,dimension%jspd))
45 46
    ALLOCATE(qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd),qintsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
    ALLOCATE(qmtsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd),qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
47 48 49
    ALLOCATE(qal(4,atoms%ntype,dimension%neigd),qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
    ALLOCATE(qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
    ALLOCATE(ksym(dimension%neigd),jsym(dimension%neigd))
50 51 52 53 54 55 56 57 58
    !
    !  --->     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
    ! 
59
    WRITE (chntype,'(i2)') slab%nsl
60 61 62 63 64
    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) 
65
    WRITE (130,FMT=903) slab%nsl,vacuum%nvac,kpts%nkpt
66 67
    WRITE (130,FMT=904) atoms%ntype,(atoms%neq(n),n=1,atoms%ntype) 
    WRITE (130,FMT=805)  
68 69
    DO j=1,slab%nsl
       WRITE (130,FMT=806) j,(slab%nslat(i,j),i=1,atoms%nat)
70 71 72 73 74 75 76 77 78 79 80 81 82 83
    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
          !                
84
          call read_eig(eig_id,ikpt,kspin,neig=nbands,eig=eig)
85 86
          call read_dos(eig_id,ikpt,kspin,qal,qvac(:,:,ikpt,kspin),qis,qvlay,qstars,ksym,jsym,&
               qintsl=qintsl(:,:,ikpt,kspin),qmtsl= qmtsl(:,:,ikpt,kspin),qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
87 88
          !            write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
          !
89
          WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3)
90 91 92 93 94 95 96 97 98
8000      FORMAT (/,3x,'  k =',3f10.5,/)
          !
          DO iband = 1,nbands
             qvact = 0.0
             DO ivac = 1,vacuum%nvac
                qvact(ivac) = qvac(iband,ivac,ikpt,kspin)
             ENDDO
             IF (sym%invs .OR. sym%zrfs)    qvact(2) = qvact(1)
             iqvacpc(:) = nint(qvact(:)*100.0)
99
             DO j = 1,slab%nsl
100 101 102 103
                iqsl(j) = nint( ( qintsl(j,iband,ikpt,kspin) + &
                     &                               qmtsl(j,iband,ikpt,kspin) )*100.0 ) 
             ENDDO
             WRITE (130,FMT=chform) iband,eig(iband),iqvacpc(2),&
104
                  &                               (iqsl(l),l=1,slab%nsl),iqvacpc(1)
105 106 107
             WRITE(130,FMT=9) 
             WRITE(130,FMT=8)
             WRITE(130,FMT=9) 
108
             DO n = 1,slab%nsl
109 110 111 112
                mt=0 
                DO  it=1,atoms%ntype
                   DO  m=1,atoms%neq(it)
                      mt=mt+1	
113
                      na = slab%nslat(mt,n) 
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
                      IF (na.EQ.1) THEN
                         DO  j=1,23
                            norb(j) = &
                                 &                nint ( orbcomp(iband,j,mt,ikpt,kspin) )
                         ENDDO
                         WRITE (130,FMT=5) n,it,m,&
                              &	   		                  (norb(l),l=1,23),&
                              &                                    qmtp(iband,mt,ikpt,kspin)
                      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('-'))
    !
    DEALLOCATE ( eig,qvac,orbcomp,qintsl,qmtsl,qmtp )

  END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl