Commit 9a64cbe9 authored by Gregor Michalicek's avatar Gregor Michalicek

Eliminate write_dos and read_dos subroutines

parent bfbfae41
...@@ -12,7 +12,7 @@ CONTAINS ...@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,& SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,den,regCharges,dos,results,& vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,den,regCharges,dos,results,&
moments,mcd,slab) moments,mcd,slab,orbcomp)
!************************************************************************************ !************************************************************************************
! This is the FLEUR valence density generator ! This is the FLEUR valence density generator
...@@ -80,6 +80,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -80,6 +80,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
TYPE(t_moments), INTENT(INOUT) :: moments TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_mcd), INTENT(INOUT) :: mcd TYPE(t_mcd), INTENT(INOUT) :: mcd
TYPE(t_slab), INTENT(INOUT) :: slab TYPE(t_slab), INTENT(INOUT) :: slab
TYPE(t_orbcomp), INTENT(INOUT) :: orbcomp
! Scalar Arguments ! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin INTEGER, INTENT(IN) :: eig_id, jspin
...@@ -107,7 +108,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -107,7 +108,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
TYPE (t_eigVecCoeffs) :: eigVecCoeffs TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat TYPE (t_zMat) :: zMat
TYPE (t_orbcomp) :: orbcomp
TYPE (t_gVacMap) :: gVacMap TYPE (t_gVacMap) :: gVacMap
CALL timestart("cdnval") CALL timestart("cdnval")
...@@ -139,9 +139,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -139,9 +139,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL denCoeffsOffdiag%init(atoms,noco,sphhar,.FALSE.) CALL denCoeffsOffdiag%init(atoms,noco,sphhar,.FALSE.)
CALL force%init1(input,atoms) CALL force%init1(input,atoms)
CALL orb%init(atoms,noco,jsp_start,jsp_end) CALL orb%init(atoms,noco,jsp_start,jsp_end)
CALL mcd%init1(banddos,dimension,input,atoms,kpts)
CALL slab%init(banddos,dimension,atoms,cell,input,kpts)
CALL orbcomp%init(banddos,dimension,atoms)
IF (denCoeffsOffdiag%l_fmpl.AND.(.NOT.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval") IF (denCoeffsOffdiag%l_fmpl.AND.(.NOT.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval")
IF (l_dosNdir.AND.oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval") IF (l_dosNdir.AND.oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval")
...@@ -254,7 +251,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -254,7 +251,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
INQUIRE (file='orbcomprot',exist=l_orbcomprot) INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp) CALL orb_comp(ispin,ikpt,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END IF END IF
CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs) CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
...@@ -267,17 +264,15 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -267,17 +264,15 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
END DO ! end loop over ispin END DO ! end loop over ispin
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd) IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN
! since z is no longer an argument of cdninf sympsi has to be called here! ! 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,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat) 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,slab,orbcomp,mcd%mcd(:,:,:,ikpt,jspin))
END IF END IF
END DO ! end of k-point loop END DO ! end of k-point loop
#ifdef CPP_MPI #ifdef CPP_MPI
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,mcd,slab,& CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,mcd,slab,orbcomp,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin)) results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO END DO
#endif #endif
...@@ -297,10 +292,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -297,10 +292,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL closeXMLElement('mtCharges') CALL closeXMLElement('mtCharges')
END IF END IF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
CALL timestop("cdnval") CALL timestop("cdnval")
END SUBROUTINE cdnval END SUBROUTINE cdnval
......
MODULE m_orbcomp MODULE m_orbcomp
CONTAINS CONTAINS
SUBROUTINE orb_comp(jspin,nobd,atoms,ne,usdus,eigVecCoeffs,orbcomp) SUBROUTINE orb_comp(jspin,ikpt,nobd,atoms,ne,usdus,eigVecCoeffs,orbcomp)
!*********************************************************************** !***********************************************************************
! Calculates an orbital composition of eigen states ! Calculates an orbital composition of eigen states
! !
...@@ -39,7 +39,7 @@ CONTAINS ...@@ -39,7 +39,7 @@ CONTAINS
TYPE(t_orbcomp),INTENT(INOUT) :: orbcomp TYPE(t_orbcomp),INTENT(INOUT) :: orbcomp
! ..Scalar Argument ! ..Scalar Argument
INTEGER, INTENT (IN) :: nobd,ne,jspin INTEGER, INTENT (IN) :: nobd,ne,jspin,ikpt
! ..Local Scalars ! ..Local Scalars
INTEGER n,mt,ityp,imt,lm,lo INTEGER n,mt,ityp,imt,lm,lo
...@@ -321,8 +321,8 @@ CONTAINS ...@@ -321,8 +321,8 @@ CONTAINS
sum = sum + comp(lm) sum = sum + comp(lm)
ENDDO ENDDO
cf = 100.0/sum cf = 100.0/sum
orbcomp%qmtp(n,mt) = sum*100.0 orbcomp%qmtp(n,mt,ikpt,jspin) = sum*100.0
orbcomp%comp(n,:,mt) = comp(:)*cf orbcomp%comp(n,:,mt,ikpt,jspin) = comp(:)*cf
!---------------------------------------------------- !----------------------------------------------------
ENDDO ! bands (n) ENDDO ! bands (n)
ENDDO ! atoms (imt) -> mt (=atoms%nat) ENDDO ! atoms (imt) -> mt (=atoms%nat)
......
MODULE m_Ekwritesl MODULE m_Ekwritesl
use m_juDFT use m_juDFT
CONTAINS CONTAINS
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,dos,slab) SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,dos,slab,orbcomp,results)
!----------------------------------------------------------------- !-----------------------------------------------------------------
!-- now write E(k) for all kpts if on T3E !-- now write E(k) for all kpts if on T3E
!-- now read data from tmp_dos and write of E(k) in ek_orbcomp !-- now read data from tmp_dos and write of E(k) in ek_orbcomp
!----------------------------------------------------------------- !-----------------------------------------------------------------
USE m_types USE m_types
USE m_eig66_io
IMPLICIT NONE IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: dimension TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
...@@ -18,6 +17,8 @@ CONTAINS ...@@ -18,6 +17,8 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_slab),INTENT(IN) :: slab TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_orbcomp),INTENT(IN) :: orbcomp
TYPE(t_results),INTENT(IN) :: results
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: eig_id INTEGER, INTENT (IN) :: eig_id
...@@ -31,17 +32,14 @@ CONTAINS ...@@ -31,17 +32,14 @@ CONTAINS
! .. Local Arrays ! .. Local Arrays
INTEGER norb(23),iqsl(slab%nsld),iqvacpc(2) INTEGER norb(23),iqsl(slab%nsld),iqvacpc(2)
REAL qvact(2) REAL qvact(2)
REAL, ALLOCATABLE :: eig(:),orbcomp(:,:,:,:,:) REAL, ALLOCATABLE :: eig(:)
REAL, ALLOCATABLE :: qmtp(:,:,:,:)
CHARACTER (len=2) :: chntype CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform CHARACTER (len=99) :: chform
! .. ! ..
IF (slab%nsl.GT.slab%nsld) THEN IF (slab%nsl.GT.slab%nsld) THEN
CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl") CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
ENDIF ENDIF
ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%nat,kpts%nkpt,dimension%jspd)) ALLOCATE(eig(dimension%neigd))
ALLOCATE(qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
!
! ---> open files for a bandstucture with an orbital composition ! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry ! ---> in the case of the film geometry
! !
...@@ -74,15 +72,11 @@ CONTAINS ...@@ -74,15 +72,11 @@ CONTAINS
806 FORMAT (5X,51i4) 806 FORMAT (5X,51i4)
!============================================================== !==============================================================
DO ikpt=1,kpts%nkpt DO ikpt=1,kpts%nkpt
!
call read_eig(eig_id,ikpt,kspin,neig=nbands,eig=eig)
call read_dos(eig_id,ikpt,kspin,qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
! write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
!
WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3) WRITE (130,FMT=8000) (kpts%bk(i,ikpt),i=1,3)
8000 FORMAT (/,3x,' k =',3f10.5,/) 8000 FORMAT (/,3x,' k =',3f10.5,/)
! !
DO iband = 1,nbands DO iband = 1,results%neig(ikpt,kspin)
qvact = 0.0 qvact = 0.0
DO ivac = 1,vacuum%nvac DO ivac = 1,vacuum%nvac
qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin) qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin)
...@@ -92,7 +86,7 @@ CONTAINS ...@@ -92,7 +86,7 @@ CONTAINS
DO j = 1,slab%nsl DO j = 1,slab%nsl
iqsl(j) = nint((slab%qintsl(j,iband,ikpt,kspin) + slab%qmtsl(j,iband,ikpt,kspin))*100.0) iqsl(j) = nint((slab%qintsl(j,iband,ikpt,kspin) + slab%qmtsl(j,iband,ikpt,kspin))*100.0)
ENDDO ENDDO
WRITE(130,FMT=chform) iband,eig(iband),iqvacpc(2),(iqsl(l),l=1,slab%nsl),iqvacpc(1) WRITE(130,FMT=chform) iband,results%eig(iband,ikpt,kspin),iqvacpc(2),(iqsl(l),l=1,slab%nsl),iqvacpc(1)
WRITE(130,FMT=9) WRITE(130,FMT=9)
WRITE(130,FMT=8) WRITE(130,FMT=8)
WRITE(130,FMT=9) WRITE(130,FMT=9)
...@@ -104,15 +98,15 @@ CONTAINS ...@@ -104,15 +98,15 @@ CONTAINS
na = slab%nslat(mt,n) na = slab%nslat(mt,n)
IF (na.EQ.1) THEN IF (na.EQ.1) THEN
DO j=1,23 DO j=1,23
norb(j) = nint ( orbcomp(iband,j,mt,ikpt,kspin) ) norb(j) = nint ( orbcomp%comp(iband,j,mt,ikpt,kspin) )
ENDDO ENDDO
WRITE (130,FMT=5) n,it,m,(norb(l),l=1,23),qmtp(iband,mt,ikpt,kspin) WRITE (130,FMT=5) n,it,m,(norb(l),l=1,23),orbcomp%qmtp(iband,mt,ikpt,kspin)
ENDIF ENDIF
ENDDO ENDDO
enddo enddo
ENDDO ! over ( n = 1,nsl ) ENDDO ! over ( n = 1,nsl )
WRITE(130,FMT=9) WRITE(130,FMT=9)
ENDDO ! over ( iband = 1,nbands ) ENDDO ! over ( iband = 1,results%neig(ikpt,kspin) )
ENDDO ! over ( ikpt=1,kpts%nkpt ) ENDDO ! over ( ikpt=1,kpts%nkpt )
ENDDO ! over ( kspin = 1,input%jspins ) ENDDO ! over ( kspin = 1,input%jspins )
CLOSE (130) CLOSE (130)
...@@ -126,7 +120,7 @@ CONTAINS ...@@ -126,7 +120,7 @@ CONTAINS
& 7(1x,i3,1x),'|',7(1x,i3,1x),'|',f6.1,'|') & 7(1x,i3,1x),'|',7(1x,i3,1x),'|',f6.1,'|')
9 FORMAT(133('-')) 9 FORMAT(133('-'))
! !
DEALLOCATE ( eig,orbcomp,qmtp ) DEALLOCATE ( eig )
END SUBROUTINE Ek_write_sl END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl END MODULE m_Ekwritesl
...@@ -12,7 +12,7 @@ MODULE m_doswrite ...@@ -12,7 +12,7 @@ MODULE m_doswrite
! !
CONTAINS CONTAINS
SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,& SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,&
sliceplot,noco,sym,cell,dos,mcd,results,slab,oneD) sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD)
USE m_evaldos USE m_evaldos
USE m_cdninf USE m_cdninf
USE m_types USE m_types
...@@ -29,6 +29,7 @@ CONTAINS ...@@ -29,6 +29,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_slab),INTENT(IN) :: slab TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_orbcomp),INTENT(IN) :: orbcomp
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mcd),INTENT(IN) :: mcd TYPE(t_mcd),INTENT(IN) :: mcd
...@@ -104,7 +105,7 @@ CONTAINS ...@@ -104,7 +105,7 @@ CONTAINS
! write DOS/VACDOS ! write DOS/VACDOS
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,& CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,slab) DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,slab,orbcomp)
END IF END IF
! Now write to vacwave if nstm=3 ! Now write to vacwave if nstm=3
......
MODULE m_evaldos MODULE m_evaldos
CONTAINS CONTAINS
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,& SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
dimension,efermiarg,bandgap,l_mcd,mcd,slab) dimension,efermiarg,bandgap,l_mcd,mcd,slab,orbcomp)
!---------------------------------------------------------------------- !----------------------------------------------------------------------
! !
! vk: k-vectors ! vk: k-vectors
...@@ -19,7 +19,6 @@ ...@@ -19,7 +19,6 @@
! ntb=max(nevk) ! ntb=max(nevk)
! !
!---------------------------------------------------------------------- !----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos
USE m_triang USE m_triang
USE m_maketetra USE m_maketetra
USE m_tetrados USE m_tetrados
...@@ -43,6 +42,7 @@ ...@@ -43,6 +42,7 @@
TYPE(t_dos),INTENT(IN) :: dos TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_mcd),INTENT(IN) :: mcd TYPE(t_mcd),INTENT(IN) :: mcd
TYPE(t_slab),INTENT(IN) :: slab TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_orbcomp),INTENT(IN) :: orbcomp
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
...@@ -62,7 +62,7 @@ ...@@ -62,7 +62,7 @@
REAL ev(dimension%neigd,kpts%nkpt),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt) REAL ev(dimension%neigd,kpts%nkpt),e(ned),gpart(ned,atoms%ntype),atr(2*kpts%nkpt)
REAL e_grid(ned+1),spect(ned,3*atoms%ntype),ferwe(dimension%neigd,kpts%nkpt) REAL e_grid(ned+1),spect(ned,3*atoms%ntype),ferwe(dimension%neigd,kpts%nkpt)
REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:) REAL, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:)
REAL, ALLOCATABLE :: mcd_local(:,:,:),orbcomp(:,:,:),qmtp(:,:) REAL, ALLOCATABLE :: mcd_local(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:) REAL, ALLOCATABLE :: qvac(:,:)
CHARACTER(len=2) :: spin12(2),ch_mcd(3) CHARACTER(len=2) :: spin12(2),ch_mcd(3)
CHARACTER(len=8) :: chntype*2,chform*19 CHARACTER(len=8) :: chntype*2,chform*19
...@@ -142,23 +142,11 @@ ...@@ -142,23 +142,11 @@
DO jspin = 1,input%jspins DO jspin = 1,input%jspins
ntb = 0 ntb = 0
DO k = 1,kpts%nkpt DO k = 1,kpts%nkpt
!
! initialize arrays
!
DO n = 1,dimension%neigd
DO i = 1,qdim
qal(i,n,k) = 0.
ENDDO
DO i = 1,vacuum%nstars*vacuum%layers*vacuum%nvac
qval(i,n,k) = 0.
ENDDO
ENDDO
! read data from file! qal(:,:,k) = 0.0
qval(:,:,k) = 0.0
ntb = max(ntb,results%neig(k,jspin)) ntb = max(ntb,results%neig(k,jspin))
ALLOCATE( orbcomp(dimension%neigd,23,atoms%nat))
ALLOCATE( qmtp(dimension%neigd,atoms%nat))
CALL read_dos(eig_id,k,jspin,qmtp,orbcomp)
IF (l_mcd) mcd_local(:,:,k) = RESHAPE(mcd%mcd(:,1:ncored,:,k,jspin),(/3*atoms%ntype*ncored,dimension%neigd/)) IF (l_mcd) mcd_local(:,:,k) = RESHAPE(mcd%mcd(:,1:ncored,:,k,jspin),(/3*atoms%ntype*ncored,dimension%neigd/))
IF (.NOT.l_orbcomp) THEN IF (.NOT.l_orbcomp) THEN
qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/)) qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/))
...@@ -169,10 +157,10 @@ ...@@ -169,10 +157,10 @@
IF (n_orb == 0) THEN IF (n_orb == 0) THEN
qal(1:slab%nsld,:,k) = slab%qintsl(:,:,k,jspin) qal(1:slab%nsld,:,k) = slab%qintsl(:,:,k,jspin)
qal(slab%nsld+1:2*slab%nsld,:,k) = slab%qmtsl(:,:,k,jspin) qal(slab%nsld+1:2*slab%nsld,:,k) = slab%qmtsl(:,:,k,jspin)
ELSE ELSE
DO i = 1, 23 DO i = 1, 23
DO l = 1, results%neig(k,jspin) DO l = 1, results%neig(k,jspin)
qal(i,l,k) = orbcomp(l,i,n_orb)*qmtp(l,n_orb)/10000. qal(i,l,k) = orbcomp%comp(l,i,n_orb,k,jspin)*orbcomp%qmtp(l,n_orb,k,jspin)/10000.
END DO END DO
DO l = results%neig(k,jspin)+1, dimension%neigd DO l = results%neig(k,jspin)+1, dimension%neigd
qal(i,l,k) = 0.0 qal(i,l,k) = 0.0
...@@ -180,7 +168,6 @@ ...@@ -180,7 +168,6 @@
END DO END DO
END IF END IF
END IF END IF
DEALLOCATE( orbcomp,qmtp)
! !
! set vacuum partial charge zero, if bulk calculation ! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays ! otherwise, write vacuum charge in correct arrays
......
...@@ -265,38 +265,4 @@ CONTAINS ...@@ -265,38 +265,4 @@ CONTAINS
END SUBROUTINE write_eig END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN),OPTIONAL :: qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_DA),POINTER:: d
INTEGER:: nrec
CALL priv_find_data(id,d)
nrec=nk+(jspin-1)*d%nkpts
IF (d%l_orb) THEN
IF (d%l_mcd) CPP_error("mcd & orbital decomposition not implemented in IO")
WRITE(d%file_io_id_dos,REC=nrec) qmtp,orbcomp
END IF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_DA),POINTER:: d
INTEGER:: nrec
CALL priv_find_data(id,d)
nrec=nk+(jspin-1)*d%nkpts
IF (d%l_orb) THEN
IF (d%l_mcd) CPP_error("mcd & orbital decomposition not implemented in IO")
READ(d%file_io_id_dos,REC=nrec) qmtp,orbcomp
END IF
END SUBROUTINE read_dos
END MODULE m_eig66_da END MODULE m_eig66_da
...@@ -39,7 +39,7 @@ MODULE m_eig66_hdf ...@@ -39,7 +39,7 @@ MODULE m_eig66_hdf
#endif #endif
PUBLIC open_eig,close_eig PUBLIC open_eig,close_eig
PUBLIC read_eig,read_dos,write_dos PUBLIC read_eig
PUBLIC write_eig!,writesingleeig,writeeigc,writebas PUBLIC write_eig!,writesingleeig,writeeigc,writebas
CONTAINS CONTAINS
...@@ -294,41 +294,6 @@ CONTAINS ...@@ -294,41 +294,6 @@ CONTAINS
END SUBROUTINE priv_r_vec END SUBROUTINE priv_r_vec
#endif #endif
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_HDF),POINTER :: d
CALL priv_find_data(id,d)
#ifdef CPP_HDF
IF (d%l_orb) THEN
CALL io_read_real2(d%qmtpsetid,(/1,1,nk,jspin/),(/SIZE(qmtp,1),SIZE(qmtp,2),1,1/),qmtp)
CALL io_read_real3(d%orbcompsetid,(/1,1,1,nk,jspin/),(/SIZE(orbcomp,1),23,SIZE(orbcomp,3),1,1/),orbcomp)
ENDIF
#endif
END SUBROUTINE read_dos
SUBROUTINE write_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_HDF),POINTER ::d
CALL priv_find_data(id,d)
#ifdef CPP_HDF
IF (d%l_mcd.AND.PRESENT(mcd)) THEN
CALL io_write_real3(d%mcdsetid,(/1,1,1,nk,jspin/),(/SIZE(mcd,1),SIZE(mcd,2),SIZE(mcd,3),1,1/),mcd)
ENDIF
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
CALL io_write_real2(d%qintslsetid,(/1,1,nk,jspin/),(/SIZE(qintsl,1),SIZE(qintsl,2),1,1/),qintsl)
CALL io_write_real2(d%qmtslsetid,(/1,1,nk,jspin/),(/SIZE(qmtsl,1),SIZE(qmtsl,2),1,1/),qmtsl)
CALL io_write_real2(d%qmtpsetid,(/1,1,nk,jspin/),(/SIZE(qmtp,1),SIZE(qmtp,2),1,1/),qmtp)
CALL io_write_real3(d%orbcompsetid,(/1,1,1,nk,jspin/),(/SIZE(orbcomp,1),23,SIZE(orbcomp,3),1,1/),orbcomp)
ENDIF
#endif
END SUBROUTINE write_dos
SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat) SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
......
...@@ -13,7 +13,6 @@ MODULE m_eig66_io ...@@ -13,7 +13,6 @@ MODULE m_eig66_io
PUBLIC open_eig,close_eig PUBLIC open_eig,close_eig
PUBLIC read_eig, write_eig PUBLIC read_eig, write_eig
PUBLIC read_dos,write_dos
CONTAINS CONTAINS
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,& FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,&
...@@ -167,56 +166,4 @@ CONTAINS ...@@ -167,56 +166,4 @@ CONTAINS
CALL timestop("IO (write)") CALL timestop("IO (write)")
END SUBROUTINE write_eig END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,slab,orbcomp,mcd)
USE m_eig66_hdf,ONLY:write_dos_hdf=>write_dos
USE m_eig66_DA ,ONLY:write_dos_DA=>write_dos
USE m_eig66_mem,ONLY:write_dos_MEM=>write_dos
USE m_eig66_MPI,ONLY:write_dos_MPI=>write_dos
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
TYPE(t_orbcomp), INTENT(IN) :: orbcomp
TYPE(t_slab), INTENT(IN) :: slab
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,mcd,slab%qintsl(:,:,nk,jspin),slab%qmtsl(:,:,nk,jspin),orbcomp%qmtp,orbcomp%comp)
CASE (mem_mode)
CALL write_dos_Mem(id,nk,jspin,mcd,slab%qintsl(:,:,nk,jspin),slab%qmtsl(:,:,nk,jspin),orbcomp%qmtp,orbcomp%comp)
CASE (MPI_mode)
CALL write_dos_MPI(id,nk,jspin,mcd,slab%qintsl(:,:,nk,jspin),slab%qmtsl(:,:,nk,jspin),orbcomp%qmtp,orbcomp%comp)
CASE (-1)
CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io")
END SELECT
CALL timestop("IO (dos-write)")