doswrite.f90 6.63 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14
MODULE m_doswrite
  USE m_juDFT
  !
  !-- now write cdninf for all kpts if on T3E
  !-- now read data from tmp_dos and write to vacdos&dosinp .. dw
  !
CONTAINS
  SUBROUTINE doswrite(&
15
       &                   eig_id,DIMENSION,kpts,atoms,vacuum,&
16 17 18 19
       &                   input,banddos,&
       &                   sliceplot,noco,sym,&
       &                   cell,&
       &                   l_mcd,ncored,ncore,e_mcd,&
20
       &                   efermi,bandgap,nsld,oneD)
Daniel Wortmann's avatar
Daniel Wortmann committed
21
    USE m_eig66_io,ONLY:read_dos,read_eig
22 23 24 25
    USE m_evaldos
    USE m_cdninf
    USE m_types
    IMPLICIT NONE
26
  
27 28 29 30 31 32 33 34 35 36 37 38 39 40
    TYPE(t_dimension),INTENT(IN) :: DIMENSION
    TYPE(t_oneD),INTENT(IN)      :: oneD
    TYPE(t_banddos),INTENT(IN)   :: banddos
    TYPE(t_sliceplot),INTENT(IN) :: sliceplot
    TYPE(t_input),INTENT(IN)     :: input
    TYPE(t_vacuum),INTENT(IN)    :: vacuum
    TYPE(t_noco),INTENT(IN)      :: noco
    TYPE(t_sym),INTENT(IN)       :: sym
    TYPE(t_cell),INTENT(IN)      :: cell
    TYPE(t_kpts),INTENT(IN)      :: kpts
    TYPE(t_atoms),INTENT(IN)     :: atoms

    !     .. Scalar Arguments ..
    INTEGER,PARAMETER :: n2max=13 
41
    INTEGER, INTENT (IN) :: nsld,eig_id 
42
    INTEGER, INTENT (IN) :: ncored
43
    REAL,    INTENT (IN) :: efermi, bandgap
44 45 46
    LOGICAL, INTENT (IN) :: l_mcd
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
47 48
    INTEGER, INTENT (IN)  :: ncore(atoms%ntype)
    REAL, INTENT(IN)      :: e_mcd(atoms%ntype,input%jspins,ncored)
49 50 51 52 53 54 55
    !-odim
    !+odim

    !    locals
    INTEGER :: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd)
    REAL    :: wk,bkpt(3)
    REAL   :: eig(DIMENSION%neigd)
Daniel Wortmann's avatar
Daniel Wortmann committed
56 57 58
    REAL   :: qal(0:3,atoms%ntype,DIMENSION%neigd,DIMENSION%jspd)
    REAL   :: qis(DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd)
    REAL   :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
    REAL   :: qvlay(DIMENSION%neigd,vacuum%layerd,2)
    COMPLEX :: qstars(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
    INTEGER :: ne,ikpt,kspin,j,i,n
    COMPLEX, ALLOCATABLE :: ac(:,:),bc(:,:)


    !     check if there is anything todo here
    IF (.NOT.(banddos%dos.OR.input%cdinf.OR.banddos%vacdos.OR.(vacuum%nstm.EQ.3))) RETURN
    !     check if settings in inp-file make any sense
    IF (banddos%vacdos.AND..NOT.banddos%dos) THEN
       WRITE(6,*) "STOP DOS: only set banddos%vacdos = .true. if banddos%dos=.true."
       CALL juDFT_error("DOS",calledby ="doswrite")
    ENDIF
    IF (banddos%vacdos.AND.(.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1)))THEN
       WRITE(6,*) "STOP DOS: if stars = f set vacuum%nstars=1"
       CALL juDFT_error("DOS",calledby ="doswrite")
    ENDIF

    IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
       !---  >    open files for bandstucture+ old style vacdos
       OPEN (85,file='dosinp')
       IF (banddos%vacdos) THEN
          OPEN (86,file='vacDOS')
       ENDIF
    ENDIF

    IF ((banddos%dos.AND.(banddos%ndir.GE.0)).OR.input%cdinf) THEN
       !
       !      write bandstructure or cdn-info to output-file
       !         
       DO kspin = 1,input%jspins
          IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
             !---  >       write header information to vacdos & dosinp
             !     
             IF (input%film) THEN
                WRITE (85,FMT=8080) vacuum%nvac,kpts%nkpt
             ELSE
                WRITE (85,FMT=8080) input%jspins,kpts%nkpt
             ENDIF
8080         FORMAT (12i6)
             WRITE (85,FMT=8080) atoms%ntype, (atoms%neq(n),n=1,atoms%ntype)
             IF (banddos%vacdos) THEN
                WRITE (86,FMT=8080) vacuum%nvac,kpts%nkpt
                WRITE (86,FMT=8080) vacuum%layers
                WRITE (86,'(20(i3,1x))') (vacuum%izlay(i,1),i=1,vacuum%layers)
             ENDIF
          ENDIF

          DO ikpt=1,kpts%nkpt
Daniel Wortmann's avatar
Daniel Wortmann committed
108
             call read_eig(eig_id,ikpt,kspin,&
109
                                 neig=ne,eig=eig)
110
             call read_dos(eig_id,ikpt,kspin,&
111 112
                  &              qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
                  &              qis(:,ikpt,kspin),&
113
                  &              qvlay(:,:,:),qstars,ksym,jsym)
114 115 116

             CALL cdninf(&
                  &              input,sym,noco,kspin,atoms,&
117 118
                  &              vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
                  &              kpts%wtkpt(ikpt),cell,kpts,&
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
                  &              ne,eig,qal(0:,:,:,kspin),qis,qvac,&
                  &              qvlay(:,:,:),&
                  &              qstars,ksym,jsym)
          ENDDO

       ENDDO                  ! end spin loop (kspin = 1,input%jspins)

    ENDIF

    IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
       CLOSE(85)
       RETURN
       !     ok, all done in the bandstructure/cdninf case
    ENDIF
    !
    !     write DOS/VACDOS
    !
    !     
    IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
       CALL evaldos(&
139
            &                eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
140
            &                DIMENSION,efermi,bandgap,&
141 142 143 144 145 146 147 148 149 150
            &                l_mcd,ncored,ncore,e_mcd,nsld)
    ENDIF
    !
    !      Now write to vacwave if nstm=3 
    !     all data
    !     has been written to tmp_vacwave and must be written now
    !     by PE=0 only!
    !
    IF (vacuum%nstm.EQ.3) THEN
       call juDFT_error("nstm=3 not implemented in doswrite")
151
       !OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw)
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
       ALLOCATE ( ac(n2max,DIMENSION%neigd),bc(n2max,DIMENSION%neigd) )
       DO ikpt = 1,kpts%nkpt
          WRITE(*,*) 'Read rec',ikpt,'from vacwave'
          READ(89,rec=ikpt) wk,ne,bkpt(1),bkpt(2),&
               &                 eig,ac,bc
          WRITE (87,'(i3,1x,f12.6)') ikpt,wk
          i=0
          DO n = 1, ne
             IF (ABS(eig(n)-vacuum%tworkf).LE.banddos%e2_dos) i=i+1
          END DO
          WRITE (87,FMT=990) bkpt(1), bkpt(2), i, n2max
          DO n = 1, ne
             IF (ABS(eig(n)-vacuum%tworkf).LE.banddos%e2_dos) THEN
                WRITE (87,FMT=1000) eig(n)
                DO j=1,n2max
                   WRITE (87,FMT=1010) ac(j,n),bc(j,n)
                END DO
             END IF
          END DO
990       FORMAT(2(f8.4,1x),i3,1x,i3)
1000      FORMAT(e10.4)
1010      FORMAT(2(2e20.8,1x))
       END DO
       DEALLOCATE ( ac,bc )
       !
       CLOSE(89)

    ENDIF
    RETURN
  END SUBROUTINE doswrite
END MODULE m_doswrite