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

Eliminate write_dos and read_dos subroutines

parent bfbfae41
......@@ -12,7 +12,7 @@ CONTAINS
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,&
moments,mcd,slab)
moments,mcd,slab,orbcomp)
!************************************************************************************
! This is the FLEUR valence density generator
......@@ -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_mcd), INTENT(INOUT) :: mcd
TYPE(t_slab), INTENT(INOUT) :: slab
TYPE(t_orbcomp), INTENT(INOUT) :: orbcomp
! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin
......@@ -107,7 +108,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
TYPE (t_orbcomp) :: orbcomp
TYPE (t_gVacMap) :: gVacMap
CALL timestart("cdnval")
......@@ -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 force%init1(input,atoms)
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 (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
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
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
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
END DO ! end loop over ispin
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!
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,slab,orbcomp,mcd%mcd(:,:,:,ikpt,jspin))
CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
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,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))
END DO
#endif
......@@ -297,10 +292,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL closeXMLElement('mtCharges')
END IF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
CALL timestop("cdnval")
END SUBROUTINE cdnval
......
MODULE m_orbcomp
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
!
......@@ -39,7 +39,7 @@ CONTAINS
TYPE(t_orbcomp),INTENT(INOUT) :: orbcomp
! ..Scalar Argument
INTEGER, INTENT (IN) :: nobd,ne,jspin
INTEGER, INTENT (IN) :: nobd,ne,jspin,ikpt
! ..Local Scalars
INTEGER n,mt,ityp,imt,lm,lo
......@@ -321,8 +321,8 @@ CONTAINS
sum = sum + comp(lm)
ENDDO
cf = 100.0/sum
orbcomp%qmtp(n,mt) = sum*100.0
orbcomp%comp(n,:,mt) = comp(:)*cf
orbcomp%qmtp(n,mt,ikpt,jspin) = sum*100.0
orbcomp%comp(n,:,mt,ikpt,jspin) = comp(:)*cf
!----------------------------------------------------
ENDDO ! bands (n)
ENDDO ! atoms (imt) -> mt (=atoms%nat)
......
MODULE m_Ekwritesl
use m_juDFT
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 read data from tmp_dos and write of E(k) in ek_orbcomp
!-----------------------------------------------------------------
USE m_types
USE m_eig66_io
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input
......@@ -18,6 +17,8 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_orbcomp),INTENT(IN) :: orbcomp
TYPE(t_results),INTENT(IN) :: results
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: eig_id
......@@ -31,17 +32,14 @@ CONTAINS
! .. Local Arrays
INTEGER norb(23),iqsl(slab%nsld),iqvacpc(2)
REAL qvact(2)
REAL, ALLOCATABLE :: eig(:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qmtp(:,:,:,:)
REAL, ALLOCATABLE :: eig(:)
CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform
! ..
IF (slab%nsl.GT.slab%nsld) THEN
CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
ENDIF
ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%nat,kpts%nkpt,dimension%jspd))
ALLOCATE(qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
!
ALLOCATE(eig(dimension%neigd))
! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry
!
......@@ -74,15 +72,11 @@ CONTAINS
806 FORMAT (5X,51i4)
!==============================================================
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)
8000 FORMAT (/,3x,' k =',3f10.5,/)
!
DO iband = 1,nbands
DO iband = 1,results%neig(ikpt,kspin)
qvact = 0.0
DO ivac = 1,vacuum%nvac
qvact(ivac) = dos%qvac(iband,ivac,ikpt,kspin)
......@@ -92,7 +86,7 @@ CONTAINS
DO j = 1,slab%nsl
iqsl(j) = nint((slab%qintsl(j,iband,ikpt,kspin) + slab%qmtsl(j,iband,ikpt,kspin))*100.0)
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=8)
WRITE(130,FMT=9)
......@@ -104,15 +98,15 @@ CONTAINS
na = slab%nslat(mt,n)
IF (na.EQ.1) THEN
DO j=1,23
norb(j) = nint ( orbcomp(iband,j,mt,ikpt,kspin) )
norb(j) = nint ( orbcomp%comp(iband,j,mt,ikpt,kspin) )
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
ENDDO
enddo
ENDDO ! over ( n = 1,nsl )
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 ( kspin = 1,input%jspins )
CLOSE (130)
......@@ -126,7 +120,7 @@ CONTAINS
& 7(1x,i3,1x),'|',7(1x,i3,1x),'|',f6.1,'|')
9 FORMAT(133('-'))
!
DEALLOCATE ( eig,orbcomp,qmtp )
DEALLOCATE ( eig )
END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl
......@@ -12,7 +12,7 @@ MODULE m_doswrite
!
CONTAINS
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_cdninf
USE m_types
......@@ -29,6 +29,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_orbcomp),INTENT(IN) :: orbcomp
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mcd),INTENT(IN) :: mcd
......@@ -104,7 +105,7 @@ CONTAINS
! 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,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
! Now write to vacwave if nstm=3
......
MODULE m_evaldos
CONTAINS
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
......@@ -19,7 +19,6 @@
! ntb=max(nevk)
!
!----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos
USE m_triang
USE m_maketetra
USE m_tetrados
......@@ -43,6 +42,7 @@
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_mcd),INTENT(IN) :: mcd
TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_orbcomp),INTENT(IN) :: orbcomp
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -62,7 +62,7 @@
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, ALLOCATABLE :: qal(:,:,:),qval(:,:,:),qlay(:,:,:),g(:,:)
REAL, ALLOCATABLE :: mcd_local(:,:,:),orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: mcd_local(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:)
CHARACTER(len=2) :: spin12(2),ch_mcd(3)
CHARACTER(len=8) :: chntype*2,chform*19
......@@ -142,23 +142,11 @@
DO jspin = 1,input%jspins
ntb = 0
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))
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 (.NOT.l_orbcomp) THEN
qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/))
......@@ -169,10 +157,10 @@
IF (n_orb == 0) THEN
qal(1:slab%nsld,:,k) = slab%qintsl(:,:,k,jspin)
qal(slab%nsld+1:2*slab%nsld,:,k) = slab%qmtsl(:,:,k,jspin)
ELSE
ELSE
DO i = 1, 23
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
DO l = results%neig(k,jspin)+1, dimension%neigd
qal(i,l,k) = 0.0
......@@ -180,7 +168,6 @@
END DO
END IF
END IF
DEALLOCATE( orbcomp,qmtp)
!
! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays
......
......@@ -265,38 +265,4 @@ CONTAINS
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
......@@ -39,7 +39,7 @@ MODULE m_eig66_hdf
#endif
PUBLIC open_eig,close_eig
PUBLIC read_eig,read_dos,write_dos
PUBLIC read_eig
PUBLIC write_eig!,writesingleeig,writeeigc,writebas
CONTAINS
......@@ -294,41 +294,6 @@ CONTAINS
END SUBROUTINE priv_r_vec
#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)
......
......@@ -13,7 +13,6 @@ MODULE m_eig66_io
PUBLIC open_eig,close_eig
PUBLIC read_eig, write_eig
PUBLIC read_dos,write_dos
CONTAINS
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,&
......@@ -167,56 +166,4 @@ CONTAINS
CALL timestop("IO (write)")
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)")
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
USE m_eig66_hdf,ONLY:read_dos_hdf=>read_dos
USE m_eig66_DA ,ONLY:read_dos_DA=>read_dos
USE m_eig66_mem,ONLY:read_dos_MEM=>read_dos
USE m_eig66_MPI,ONLY:read_dos_MPI=>read_dos
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: qmtp(:,:),orbcomp(:,:,:)
CALL timestart("IO (dos-read)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL read_dos_DA(id,nk,jspin,qmtp,orbcomp)
CASE (hdf_mode)
CALL read_dos_HDF(id,nk,jspin,qmtp,orbcomp)
CASE (mem_mode)
CALL read_dos_Mem(id,nk,jspin,qmtp,orbcomp)
CASE (MPI_mode)
CALL read_dos_MPI(id,nk,jspin,qmtp,orbcomp)
CASE (-1)
CALL juDFT_error("Could not DOS from read eig-file before opening", calledby = "eig66_io")
END SELECT
CALL timestop("IO (dos-read)")
END SUBROUTINE read_dos
END MODULE m_eig66_io
......@@ -151,45 +151,6 @@ CONTAINS
END SUBROUTINE priv_writetofile
END SUBROUTINE close_eig
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(:,:,:)
INTEGER::nrec
TYPE(t_data_mem),POINTER:: d
CALL priv_find_data(id,d)
nrec=nk+(jspin-1)*d%nkpts
IF (d%l_mcd.AND.PRESENT(mcd)) d%mcd(:,:,:,nrec)=mcd
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
d%qintsl(:,:,nrec)=qintsl
d%qmtsl(:,:,nrec)=qmtsl
d%qmtp(:,:,nrec)=qmtp
d%orbcomp(:,:,:,nrec)=orbcomp
ENDIF
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(:,:,:)
INTEGER::nrec
TYPE(t_data_mem),POINTER:: d
CALL priv_find_data(id,d)
nrec=nk+(jspin-1)*d%nkpts
IF (d%l_orb) THEN
qmtp=d%qmtp(:,:,nrec)
orbcomp=d%orbcomp(:,:,:,nrec)
ENDIF
END SUBROUTINE read_dos
SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
......
......@@ -7,7 +7,7 @@ MODULE m_eig66_mpi
#endif
IMPLICIT NONE
PRIVATE
PUBLIC open_eig,read_eig,write_eig,close_eig,write_dos,read_dos
PUBLIC open_eig,read_eig,write_eig,close_eig
CONTAINS
SUBROUTINE priv_find_data(id,d)
......@@ -502,49 +502,6 @@ CONTAINS
END SUBROUTINE priv_get_data
#endif
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(:,:,:)
#ifdef CPP_MPI
TYPE(t_data_MPI),POINTER :: d
INTEGER:: pe,slot
CALL priv_find_data(id,d)
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
IF (d%l_mcd.AND.PRESENT(mcd)) CALL priv_put_data(pe,slot,RESHAPE(mcd,(/SIZE(mcd)/)),d%mcd_handle)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
CALL priv_put_data(pe,slot,RESHAPE(qintsl,(/SIZE(qintsl)/)),d%qintsl_handle)
CALL priv_put_data(pe,slot,RESHAPE(qmtsl,(/SIZE(qmtsl)/)),d%qmtsl_handle)
CALL priv_put_data(pe,slot,RESHAPE(qmtp,(/SIZE(qmtp)/)),d%qmtp_handle)
CALL priv_put_data(pe,slot,RESHAPE(orbcomp,(/SIZE(orbcomp)/)),d%orbcomp_handle)
ENDIF
#endif
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(:,:,:)
#ifdef CPP_MPI
TYPE(t_data_MPI),POINTER :: d
INTEGER:: pe,slot
CALL priv_find_data(id,d)
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
IF (d%l_orb) THEN
CALL priv_get_data(pe,slot,SIZE(qmtp),d%qmtp_handle,rdata=qmtp)
CALL priv_get_data(pe,slot,SIZE(orbcomp),d%orbcomp_handle,rdata=orbcomp)
ENDIF
#endif
END SUBROUTINE read_dos
#ifdef CPP_MPI
SUBROUTINE create_maps(d,isize,nkpts,jspins,neig,n_size)
IMPLICIT NONE
......
......@@ -74,6 +74,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
TYPE(t_moments) :: moments
TYPE(t_mcd) :: mcd
TYPE(t_slab) :: slab
TYPE(t_orbcomp) :: orbcomp
TYPE(t_cdnvalKLoop) :: cdnvalKLoop
......@@ -84,6 +85,9 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL regCharges%init(input,atoms)
CALL dos%init(input,atoms,dimension,kpts,vacuum)
CALL moments%init(input,atoms)
CALL mcd%init1(banddos,dimension,input,atoms,kpts)
CALL slab%init(banddos,dimension,atoms,cell,input,kpts)
CALL orbcomp%init(input,banddos,dimension,atoms,kpts)
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
......@@ -96,15 +100,15 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DO jspin = 1,jspmax
CALL cdnvalKLoop%init(mpi,input,kpts,banddos,noco,results,jspin,sliceplot)
CALL cdnval(eig_id,mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,outDen,regCharges,dos,results,moments,mcd,slab)
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,outDen,regCharges,dos,results,moments,mcd,slab,orbcomp)
END DO
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,dos,mcd,results,slab,oneD)
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab)
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results)
END IF
CALL timestop("cdngen: dos")
END IF
......
......@@ -9,7 +9,7 @@ MODULE m_mpi_col_den
! collect all data calculated in cdnval on different pe's on pe 0
!
CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,mcd,slab,&
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,mcd,slab,orbcomp,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
#include"cpp_double.h"
......@@ -42,6 +42,7 @@ CONTAINS
TYPE (t_dos), INTENT(INOUT) :: dos
TYPE (t_mcd), INTENT(INOUT) :: mcd
TYPE (t_slab), INTENT(INOUT) :: slab
TYPE (t_orbcomp), INTENT(INOUT) :: orbcomp
! ..
! .. Local Scalars ..
INTEGER :: n, i
......@@ -195,6 +196,20 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, slab%qmtsl(:,:,:,jspin), 1)
DEALLOCATE (r_b)
! Collect orbcomp - comp and qmtp
n = SIZE(orbcomp%comp,1)*SIZE(orbcomp%comp,2)*SIZE(orbcomp%comp,3)*SIZE(orbcomp%comp,4)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(orbcomp%comp(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, orbcomp%comp(:,:,:,:,jspin), 1)
DEALLOCATE (r_b)
n = SIZE(orbcomp%qmtp,1)*SIZE(orbcomp%qmtp,2)*SIZE(orbcomp%qmtp,3)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(orbcomp%qmtp(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, orbcomp%qmtp(:,:,:,jspin), 1)
DEALLOCATE (r_b)
! -> Collect force
IF (input%l_f) THEN
n=3*atoms%ntype
......
......@@ -111,8 +111,8 @@ PRIVATE
TYPE t_orbcomp
REAL, ALLOCATABLE :: comp(:,:,:)
REAL, ALLOCATABLE :: qmtp(:,:)
REAL, ALLOCATABLE :: comp(:,:,:,:,:)
REAL, ALLOCATABLE :: qmtp(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => orbcomp_init
......@@ -299,14 +299,6 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts)
nsld=1
IF (ALLOCATED(thisSlab%nmtsl)) DEALLOCATE(thisSlab%nmtsl)
IF (ALLOCATED(thisSlab%nslat)) DEALLOCATE(thisSlab%nslat)
IF (ALLOCATED(thisSlab%zsl)) DEALLOCATE(thisSlab%zsl)
IF (ALLOCATED(thisSlab%volsl)) DEALLOCATE(thisSlab%volsl)
IF (ALLOCATED(thisSlab%volintsl)) DEALLOCATE(thisSlab%volintsl)
IF (ALLOCATED(thisSlab%qintsl)) DEALLOCATE(thisSlab%qintsl)
IF (ALLOCATED(thisSlab%qmtsl)) DEALLOCATE(thisSlab%qmtsl)
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
CALL slab_dim(atoms, nsld)
ALLOCATE (thisSlab%nmtsl(atoms%ntype,nsld))
......@@ -379,11 +371,6 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts)
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
IF (ALLOCATED(thisMCD%ncore)) DEALLOCATE(thisMCD%ncore)
IF (ALLOCATED(thisMCD%e_mcd)) DEALLOCATE(thisMCD%e_mcd)
IF (ALLOCATED(thisMCD%m_mcd)) DEALLOCATE(thisMCD%m_mcd)
IF (ALLOCATED(thisMCD%mcd)) DEALLOCATE(thisMCD%mcd)
ALLOCATE (thisMCD%ncore(atoms%ntype))
ALLOCATE (thisMCD%e_mcd(atoms%ntype,input%jspins,dimension%nstd))
IF (banddos%l_mcd) THEN
......@@ -430,23 +417,26 @@ SUBROUTINE moments_init(thisMoments,input,atoms)
END SUBROUTINE moments_init
SUBROUTINE orbcomp_init(thisOrbcomp,banddos,dimension,atoms)
SUBROUTINE orbcomp_init(t