Commit bd99a389 authored by Gregor Michalicek's avatar Gregor Michalicek

Remove requirement for read_dos, write_dos subroutines (part 1)

(at the moment this is broken)
parent 9ffd69d4
......@@ -95,7 +95,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
LOGICAL :: l_orbcomprot, l_real, l_write, l_dosNdir
! Local Arrays
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: we(:)
REAL, ALLOCATABLE :: eig(:)
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
......@@ -131,7 +130,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end)) ! Deallocation before mpi_col_den
ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end))
ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,dimension%jspd))
ALLOCATE (jsym(dimension%neigd),ksym(dimension%neigd))
! Initializations
CALL usdus%init(atoms,input%jspins)
......@@ -271,15 +269,15 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
! since z is no longer an argument of cdninf sympsi has to be called here!
IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,ksym,jsym,zMat)
IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,ksym,jsym,mcd%mcd)
CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),mcd%mcd)
END IF
END DO ! end of k-point loop
#ifdef CPP_MPI
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO
#endif
......
......@@ -12,7 +12,7 @@ MODULE m_doswrite
!
CONTAINS
SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,&
sliceplot,noco,sym,cell,mcd,results,nsld,oneD)
sliceplot,noco,sym,cell,dos,mcd,results,nsld,oneD)
USE m_eig66_io,ONLY:read_dos,read_eig
USE m_evaldos
USE m_cdninf
......@@ -28,6 +28,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mcd),INTENT(IN) :: mcd
......@@ -71,13 +72,11 @@ CONTAINS
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
!
! write header information to vacdos & dosinp
IF (input%film) THEN
WRITE (85,FMT=8080) vacuum%nvac,kpts%nkpt
ELSE
......@@ -93,47 +92,40 @@ CONTAINS
ENDIF
DO ikpt=1,kpts%nkpt
call read_eig(eig_id,ikpt,kspin,neig=ne,eig=eig)
call read_dos(eig_id,ikpt,kspin,qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
qis(:,ikpt,kspin),qvlay(:,:,:),qstars,ksym,jsym)
! call read_eig(eig_id,ikpt,kspin,neig=ne,eig=eig)
! call read_dos(eig_id,ikpt,kspin,qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
! qis(:,ikpt,kspin),qvlay(:,:,:),qstars,ksym,jsym)
CALL cdninf(input,sym,noco,kspin,atoms,vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
kpts%wtkpt(ikpt),cell,kpts,ne,eig,qal(0:,:,:,kspin),qis,qvac,&
qvlay(:,:,:),qstars,ksym,jsym)
ENDDO
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
ENDDO ! end spin loop (kspin = 1,input%jspins)
END DO ! end spin loop (kspin = 1,input%jspins)
ENDIF
END IF
IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
CLOSE(85)
RETURN
! ok, all done in the bandstructure/cdninf case
ENDIF
!
! write DOS/VACDOS
!
!
END IF
! write DOS/VACDOS
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
DIMENSION,results%ef,results%bandgap,&
banddos%l_mcd,mcd%ncore,mcd%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!
!
CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd%ncore,mcd%e_mcd,nsld)
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!
IF (vacuum%nstm.EQ.3) THEN
call juDFT_error("nstm=3 not implemented in doswrite")
!OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw)
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
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
......
MODULE m_evaldos
CONTAINS
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
dimension,efermiarg,bandgap,l_mcd,ncore,e_mcd,nsld)
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
dimension,efermiarg,bandgap,l_mcd,ncore,e_mcd,nsld)
!----------------------------------------------------------------------
!
! vk: k-vectors
......@@ -39,6 +39,8 @@
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_results),INTENT(IN) :: results
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
......
......@@ -102,7 +102,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (mpi%irank.EQ.0) THEN
IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
CALL timestart("cdngen: dos")
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,mcd,results,slab%nsld,oneD)
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab%nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,slab)
END IF
......
This diff is collapsed.
......@@ -11,6 +11,8 @@ IMPLICIT NONE
PRIVATE
TYPE t_dos
INTEGER, ALLOCATABLE :: jsym(:,:,:)
INTEGER, ALLOCATABLE :: ksym(:,:,:)
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
......@@ -39,12 +41,16 @@ SUBROUTINE dos_init(thisDOS,input,atoms,dimension,kpts,vacuum)
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_vacuum), INTENT(IN) :: vacuum
ALLOCATE(thisDOS%jsym(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%ksym(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qal(0:3,atoms%ntype,dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
thisDOS%jsym = 0
thisDOS%ksym = 0
thisDOS%qis = 0.0
thisDOS%qal = 0.0
thisDOS%qvac = 0.0
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment