doswrite.f90 5.43 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
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
14
  SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,&
15
                      sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD)
16 17 18 19
    USE m_evaldos
    USE m_cdninf
    USE m_types
    IMPLICIT NONE
20
  
21 22 23 24 25 26 27 28 29
    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
30
    TYPE(t_dos),INTENT(IN)       :: dos
31
    TYPE(t_slab),INTENT(IN)      :: slab
32
    TYPE(t_orbcomp),INTENT(IN)   :: orbcomp
33 34
    TYPE(t_kpts),INTENT(IN)      :: kpts
    TYPE(t_atoms),INTENT(IN)     :: atoms
35 36
    TYPE(t_mcd),INTENT(IN)       :: mcd
    TYPE(t_results),INTENT(IN)   :: results
37 38 39

    !     .. Scalar Arguments ..
    INTEGER,PARAMETER :: n2max=13 
40
    INTEGER, INTENT (IN) :: eig_id
41 42 43

    !    locals
    REAL    :: wk,bkpt(3)
44
    REAL    :: eig(DIMENSION%neigd)
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
    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
70

71 72 73
       !      write bandstructure or cdn-info to output-file
       DO kspin = 1,input%jspins
          IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
74
             ! write header information to vacdos & dosinp
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
             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
90
             CALL cdninf(input,sym,noco,kspin,atoms,vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
91 92 93
                         kpts%wtkpt(ikpt),cell,kpts,results%neig(ikpt,kspin),results%eig(:,ikpt,kspin),dos%qal(0:,:,:,ikpt,kspin),dos%qis,dos%qvac,&
                         dos%qvlay(:,:,:,ikpt,kspin),dos%qstars(:,:,:,:,ikpt,kspin),dos%ksym(:,ikpt,kspin),dos%jsym(:,ikpt,kspin))
          END DO
94

95
       END DO ! end spin loop (kspin = 1,input%jspins)
96

97
    END IF
98 99 100 101 102

    IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
       CLOSE(85)
       RETURN
       !     ok, all done in the bandstructure/cdninf case
103 104 105
    END IF

    !     write DOS/VACDOS     
106
    IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
107
       CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
108
                    DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,slab,orbcomp)
109 110 111 112
    END IF

    !     Now write to vacwave if nstm=3 
    !     all data has been written to tmp_vacwave and must be written now by PE=0 only!
113 114
    IF (vacuum%nstm.EQ.3) THEN
       call juDFT_error("nstm=3 not implemented in doswrite")
115
       !OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw)
116 117 118
       ALLOCATE ( ac(n2max,DIMENSION%neigd),bc(n2max,DIMENSION%neigd) )
       DO ikpt = 1,kpts%nkpt
          WRITE(*,*) 'Read rec',ikpt,'from vacwave'
119
          READ(89,rec=ikpt) wk,ne,bkpt(1),bkpt(2),eig,ac,bc
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 145
          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