Ek_write_sl.f90 5 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,orbcomp,results)
5 6 7 8 9 10 11 12 13 14 15
    !-----------------------------------------------------------------
    !-- 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
    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
16
    TYPE(t_dos),INTENT(IN)         :: dos
17 18
    TYPE(t_kpts),INTENT(IN)        :: kpts
    TYPE(t_atoms),INTENT(IN)       :: atoms
19
    TYPE(t_slab),INTENT(IN)        :: slab
20 21
    TYPE(t_orbcomp),INTENT(IN)     :: orbcomp
    TYPE(t_results),INTENT(IN)     :: results
22 23
    !	..
    !     .. Scalar Arguments ..
24 25
    INTEGER, INTENT (IN) :: eig_id
    INTEGER, INTENT (IN) :: jspin
26 27 28 29 30 31 32
    !     ..
    !     .. Local Scalars
    INTEGER :: nbands,ikpt,kspin,j,i,n,it ,na,iband,mt,l
    INTEGER :: ivac,m
    REAL    :: wk
    !     ..
    !     .. Local Arrays
33
    INTEGER  norb(23),iqsl(slab%nsld),iqvacpc(2)
34
    REAL     qvact(2)
35
    REAL, ALLOCATABLE :: eig(:)
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
42
    ALLOCATE(eig(dimension%neigd))
43 44 45 46 47 48 49 50
    !  --->     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
    ! 
51
    WRITE (chntype,'(i2)') slab%nsl
52 53 54 55 56
    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) 
57
    WRITE (130,FMT=903) slab%nsl,vacuum%nvac,kpts%nkpt
58 59
    WRITE (130,FMT=904) atoms%ntype,(atoms%neq(n),n=1,atoms%ntype) 
    WRITE (130,FMT=805)  
60 61
    DO j=1,slab%nsl
       WRITE (130,FMT=806) j,(slab%nslat(i,j),i=1,atoms%nat)
62 63 64 65 66 67 68 69 70 71 72 73 74
    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
75

76
          WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3)
77 78
8000      FORMAT (/,3x,'  k =',3f10.5,/)
          !
79
          DO iband = 1,results%neig(ikpt,kspin)
80 81
             qvact = 0.0
             DO ivac = 1,vacuum%nvac
82
                qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin)
83 84 85
             ENDDO
             IF (sym%invs .OR. sym%zrfs)    qvact(2) = qvact(1)
             iqvacpc(:) = nint(qvact(:)*100.0)
86
             DO j = 1,slab%nsl
87
                iqsl(j) = nint((slab%qintsl(j,iband,ikpt,kspin) + slab%qmtsl(j,iband,ikpt,kspin))*100.0) 
88
             ENDDO
89
             WRITE(130,FMT=chform) iband,results%eig(iband,ikpt,kspin),iqvacpc(2),(iqsl(l),l=1,slab%nsl),iqvacpc(1)
90 91 92
             WRITE(130,FMT=9) 
             WRITE(130,FMT=8)
             WRITE(130,FMT=9) 
93
             DO n = 1,slab%nsl
94 95 96 97
                mt=0 
                DO  it=1,atoms%ntype
                   DO  m=1,atoms%neq(it)
                      mt=mt+1	
98
                      na = slab%nslat(mt,n) 
99 100
                      IF (na.EQ.1) THEN
                         DO  j=1,23
101
                            norb(j) = nint ( orbcomp%comp(iband,j,mt,ikpt,kspin) )
102
                         ENDDO
103
                         WRITE (130,FMT=5) n,it,m,(norb(l),l=1,23),orbcomp%qmtp(iband,mt,ikpt,kspin)
104 105 106 107 108
                      ENDIF
                   ENDDO
                enddo
             ENDDO              ! over ( n = 1,nsl ) 
             WRITE(130,FMT=9) 
109
          ENDDO           ! over ( iband = 1,results%neig(ikpt,kspin) ) 
110 111 112 113 114 115 116 117 118 119 120 121 122
       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('-'))
    !
123
    DEALLOCATE ( eig )
124 125 126

  END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl