Ek_write_sl.f90 5.83 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 36 37 38
    REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:),qmtp(:,:,:,:)
    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(qintsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
44
    ALLOCATE(qmtsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd),qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
45 46 47 48 49 50 51 52 53
    !
    !  --->     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
    ! 
54
    WRITE (chntype,'(i2)') slab%nsl
55 56 57 58 59
    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) 
60
    WRITE (130,FMT=903) slab%nsl,vacuum%nvac,kpts%nkpt
61 62
    WRITE (130,FMT=904) atoms%ntype,(atoms%neq(n),n=1,atoms%ntype) 
    WRITE (130,FMT=805)  
63 64
    DO j=1,slab%nsl
       WRITE (130,FMT=806) j,(slab%nslat(i,j),i=1,atoms%nat)
65 66 67 68 69 70 71 72 73 74 75 76 77 78
    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
          !                
79
          call read_eig(eig_id,ikpt,kspin,neig=nbands,eig=eig)
80
          call read_dos(eig_id,ikpt,kspin,&
81
               qintsl=qintsl(:,:,ikpt,kspin),qmtsl= qmtsl(:,:,ikpt,kspin),qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
82 83
          !            write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
          !
84
          WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3)
85 86 87 88 89
8000      FORMAT (/,3x,'  k =',3f10.5,/)
          !
          DO iband = 1,nbands
             qvact = 0.0
             DO ivac = 1,vacuum%nvac
90
                qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin)
91 92 93
             ENDDO
             IF (sym%invs .OR. sym%zrfs)    qvact(2) = qvact(1)
             iqvacpc(:) = nint(qvact(:)*100.0)
94
             DO j = 1,slab%nsl
95 96 97 98
                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),&
99
                  &                               (iqsl(l),l=1,slab%nsl),iqvacpc(1)
100 101 102
             WRITE(130,FMT=9) 
             WRITE(130,FMT=8)
             WRITE(130,FMT=9) 
103
             DO n = 1,slab%nsl
104 105 106 107
                mt=0 
                DO  it=1,atoms%ntype
                   DO  m=1,atoms%neq(it)
                      mt=mt+1	
108
                      na = slab%nslat(mt,n) 
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
                      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('-'))
    !
136
    DEALLOCATE ( eig,orbcomp,qintsl,qmtsl,qmtp )
137 138 139

  END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl