Commit a5d130c7 authored by Gregor Michalicek's avatar Gregor Michalicek

Remove mcd from read_dos

parent cced8df0
......@@ -139,7 +139,7 @@ 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)
CALL mcd%init1(banddos,dimension,input,atoms,kpts)
CALL slab%init(banddos,dimension,atoms,cell)
CALL orbcomp%init(banddos,dimension,atoms)
......@@ -271,13 +271,13 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
! 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)
CALL write_dos(eig_id,ikpt,jspin,slab,orbcomp,mcd%mcd(:,:,:,ikpt,jspin))
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,&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,mcd,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO
#endif
......
......@@ -61,7 +61,7 @@ CONTAINS
IF ((ikpt.LE.mpi%isize).AND..NOT.l_evp) THEN
IF (l_mcd) THEN
mcd%mcd(:,:,:) = 0.0
mcd%mcd(:,:,:,ikpt,jsp) = 0.0
ENDIF
regCharges%ener(:,:,jsp) = 0.0
regCharges%sqal(:,:,jsp) = 0.0
......@@ -101,7 +101,7 @@ CONTAINS
DO icore = 1, mcd%ncore(n)
DO ipol = 1, 3
index = 3*(n-1) + ipol
mcd%mcd(index,icore,i)=mcd%mcd(index,icore,i) + fac*(&
mcd%mcd(index,icore,i,ikpt,jsp)=mcd%mcd(index,icore,i,ikpt,jsp) + fac*(&
suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +&
......
......@@ -13,7 +13,6 @@ MODULE m_doswrite
CONTAINS
SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,&
sliceplot,noco,sym,cell,dos,mcd,results,nsld,oneD)
USE m_eig66_io,ONLY:read_dos,read_eig
USE m_evaldos
USE m_cdninf
USE m_types
......@@ -104,7 +103,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%ncore,mcd%e_mcd,nsld)
DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,nsld)
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,ncore,e_mcd,nsld)
dimension,efermiarg,bandgap,l_mcd,mcd,nsld)
!----------------------------------------------------------------------
!
! vk: k-vectors
......@@ -19,7 +19,7 @@
! ntb=max(nevk)
!
!----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos,read_eig
USE m_eig66_io,ONLY:read_dos
USE m_triang
USE m_maketetra
USE m_tetrados
......@@ -41,17 +41,14 @@
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_results),INTENT(IN) :: results
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_mcd),INTENT(IN) :: mcd
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER, INTENT(IN) :: nsld
REAL, INTENT(IN) :: efermiarg, bandgap
LOGICAL, INTENT(IN) :: l_mcd
INTEGER, INTENT(IN) :: ncore(atoms%ntype)!(ntype)
REAL, INTENT(IN) :: e_mcd(atoms%ntype,input%jspins,dimension%nstd)
!-odim
!+odim
! locals
INTEGER, PARAMETER :: lmax= 4, ned = 1301
INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra
......@@ -65,14 +62,14 @@
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(:,:,:),orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: mcd_local(:,:,:),orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:),qvac(:,:)
CHARACTER(len=2) :: spin12(2),ch_mcd(3)
CHARACTER(len=8) :: chntype*2,chform*19
DATA spin12/'.1' , '.2'/
DATA ch_mcd/'.+' , '.-' , '.0'/
ncored = MAX(0,MAXVAL(ncore))
ncored = MAX(0,MAXVAL(mcd%ncore))
qdim = lmax*atoms%ntype+3
l_orbcomp = banddos%l_orb
IF (banddos%ndir.EQ.-3) THEN
......@@ -88,9 +85,9 @@
& qval(vacuum%nstars*vacuum%layers*vacuum%nvac,dimension%neigd,kpts%nkpt),&
& qlay(dimension%neigd,vacuum%layerd,2))
IF (l_mcd) THEN
ALLOCATE( mcd(3*atoms%ntype*ncored,dimension%neigd,kpts%nkpt) )
ALLOCATE(mcd_local(3*atoms%ntype*ncored,dimension%neigd,kpts%nkpt) )
ELSE
ALLOCATE(mcd(0,0,0))
ALLOCATE(mcd_local(0,0,0))
ENDIF
!
! scale energies
......@@ -126,9 +123,9 @@
e_up = -9.9d+9
DO jspin = 1,input%jspins
DO n = 1,atoms%ntype
DO icore = 1 , ncore(n)
e_lo = min(e_mcd(n,jspin,icore),e_lo)
e_up = max(e_mcd(n,jspin,icore),e_up)
DO icore = 1 , mcd%ncore(n)
e_lo = min(mcd%e_mcd(n,jspin,icore),e_lo)
e_up = max(mcd%e_mcd(n,jspin,icore),e_up)
ENDDO
ENDDO
ENDDO
......@@ -156,12 +153,13 @@
qval(i,n,k) = 0.
ENDDO
ENDDO
!
! read data from file!
!
ntb = max(ntb,results%neig(k,jspin))
ALLOCATE( orbcomp(dimension%neigd,23,atoms%nat),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%nat))
CALL read_dos(eig_id,k,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos(eig_id,k,jspin,qintsl,qmtsl,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)/))
qal(lmax*atoms%ntype+2,:,k)=dos%qvac(:,1,k,jspin) ! vacuum 1
......@@ -183,7 +181,6 @@
END IF
END IF
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp)
ntb = max(ntb,results%neig(k,jspin))
!
! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays
......@@ -332,7 +329,7 @@
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev,qal, g)
ELSE
CALL dos_bin(input%jspins,3*atoms%ntype*ncored,ned,emin,emax,ntb,kpts%nkpt,&
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g)
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd_local(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g)
ENDIF
ENDIF
!
......@@ -401,18 +398,18 @@
CLOSE (18)
ELSE
write(*,'(4f15.8)') ((e_mcd(n,jspin,i),n=1,atoms%ntype),i=1,ncored)
write(*,'(4f15.8)') ((mcd%e_mcd(n,jspin,i),n=1,atoms%ntype),i=1,ncored)
write(*,*)
write(*,'(4f15.8)') (g(800,n),n=1,3*atoms%ntype*ncored)
write(*,*)
write(*,'(4f15.8)') (mcd(n,10,8),n=1,3*atoms%ntype*ncored)
write(*,'(4f15.8)') (mcd_local(n,10,8),n=1,3*atoms%ntype*ncored)
DO n = 1,atoms%ntype
DO l = 1 , ned
DO icore = 1 , ncore(n)
DO icore = 1 , mcd%ncore(n)
DO i = 1 , ned-1
IF (e(i).GT.0) THEN ! take unoccupied part only
e_test1 = -e(i) - efermi +e_mcd(n,jspin,icore)*hartree_to_ev_const
e_test2 = -e(i+1)-efermi +e_mcd(n,jspin,icore)*hartree_to_ev_const
e_test1 = -e(i) - efermi +mcd%e_mcd(n,jspin,icore)*hartree_to_ev_const
e_test2 = -e(i+1)-efermi +mcd%e_mcd(n,jspin,icore)*hartree_to_ev_const
IF ((e_test2.LE.e_grid(l)).AND. (e_test1.GT.e_grid(l))) THEN
fac = (e_grid(l)-e_test1)/(e_test2-e_test1)
DO k = 3*(n-1)+1,3*(n-1)+3
......@@ -524,7 +521,7 @@
ENDIF
DEALLOCATE(qal,qval,qlay)
IF (l_mcd) DEALLOCATE( mcd )
IF (l_mcd) DEALLOCATE( mcd_local )
99001 FORMAT (f10.5,110(1x,e10.3))
END SUBROUTINE evaldos
......
......@@ -285,10 +285,9 @@ CONTAINS
END IF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_DA),POINTER:: d
INTEGER:: nrec
......@@ -299,8 +298,6 @@ CONTAINS
IF (d%l_orb.AND.PRESENT(qmtsl)) THEN
IF (d%l_mcd) CPP_error("mcd & orbital decomposition not implemented in IO")
READ(d%file_io_id_dos,REC=nrec) qintsl,qmtsl,qmtp,orbcomp
ELSEIF(d%l_mcd.AND.PRESENT(mcd)) THEN
READ(d%file_io_id_dos,REC=nrec) mcd
END IF
END SUBROUTINE read_dos
......
......@@ -294,17 +294,13 @@ CONTAINS
END SUBROUTINE priv_r_vec
#endif
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),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_read_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_read_real2(d%qintslsetid,(/1,1,nk,jspin/),(/SIZE(qintsl,1),SIZE(qintsl,2),1,1/),qintsl)
CALL io_read_real2(d%qmtslsetid,(/1,1,nk,jspin/),(/SIZE(qmtsl,1),SIZE(qmtsl,2),1,1/),qmtsl)
......
......@@ -195,25 +195,24 @@ CONTAINS
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,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 :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
CALL timestart("IO (dos-read)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL read_dos_DA(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_DA(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
CASE (hdf_mode)
CALL read_dos_HDF(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_HDF(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
CASE (mem_mode)
CALL read_dos_Mem(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_Mem(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
CASE (MPI_mode)
CALL read_dos_MPI(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_MPI(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
CASE (-1)
CALL juDFT_error("Could not DOS from read eig-file before opening", calledby = "eig66_io")
END SELECT
......
......@@ -172,10 +172,9 @@ CONTAINS
ENDIF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
INTEGER::nrec
......@@ -184,7 +183,6 @@ CONTAINS
nrec=nk+(jspin-1)*d%nkpts
IF (d%l_mcd.AND.PRESENT(mcd)) mcd=d%mcd(:,:,:,nrec)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
qintsl=d%qintsl(:,:,nrec)
qmtsl=d%qmtsl(:,:,nrec)
......
......@@ -525,10 +525,9 @@ CONTAINS
#endif
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(out),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(out),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
#ifdef CPP_MPI
TYPE(t_data_MPI),POINTER :: d
......@@ -538,7 +537,6 @@ CONTAINS
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
IF (d%l_mcd.AND.PRESENT(mcd)) CALL priv_get_data(pe,slot,SIZE(mcd),d%mcd_handle,rdata=mcd)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
CALL priv_get_data(pe,slot,SIZE(qintsl),d%qintsl_handle,rdata=qintsl)
CALL priv_get_data(pe,slot,SIZE(qmtsl),d%qmtsl_handle,rdata=qmtsl)
......
......@@ -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,&
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,mcd,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
#include"cpp_double.h"
......@@ -40,6 +40,7 @@ CONTAINS
TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
TYPE (t_regionCharges), INTENT(INOUT) :: regCharges
TYPE (t_dos), INTENT(INOUT) :: dos
TYPE (t_mcd), INTENT(INOUT) :: mcd
! ..
! .. Local Scalars ..
INTEGER :: n, i
......@@ -173,6 +174,13 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, dos%qstars(:,:,:,:,:,jspin), 1)
DEALLOCATE (c_b)
! Collect mcd%mcd
n = SIZE(mcd%mcd,1)*SIZE(mcd%mcd,2)*SIZE(mcd%mcd,3)*SIZE(mcd%mcd,4)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(mcd%mcd(:,:,:,:,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, mcd%mcd(:,:,:,:,jspin), 1)
DEALLOCATE (r_b)
! -> Collect force
IF (input%l_f) THEN
n=3*atoms%ntype
......
......@@ -89,7 +89,7 @@ PRIVATE
INTEGER, ALLOCATABLE :: ncore(:)
REAL, ALLOCATABLE :: e_mcd(:,:,:)
REAL, ALLOCATABLE :: mcd(:,:,:)
REAL, ALLOCATABLE :: mcd(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: m_mcd(:,:,:,:)
CONTAINS
......@@ -362,9 +362,10 @@ SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,dimension,atoms,noco,jspin,noccbd)
END SUBROUTINE eigVecCoeffs_init
SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms,kpts)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
......@@ -373,6 +374,7 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
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)
......@@ -385,11 +387,11 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
thisMCD%emcd_lo = banddos%e_mcd_lo
thisMCD%emcd_up = banddos%e_mcd_up
ALLOCATE (thisMCD%m_mcd(dimension%nstd,(3+1)**2,3*atoms%ntype,2))
ALLOCATE (thisMCD%mcd(3*atoms%ntype,dimension%nstd,dimension%neigd) )
ALLOCATE (thisMCD%mcd(3*atoms%ntype,dimension%nstd,dimension%neigd,kpts%nkpt,input%jspins) )
IF (.NOT.banddos%dos) WRITE (*,*) 'For mcd-spectra set banddos%dos=T!'
ELSE
ALLOCATE (thisMCD%m_mcd(1,1,1,1))
ALLOCATE (thisMCD%mcd(1,1,1))
ALLOCATE (thisMCD%mcd(1,1,1,1,input%jspins))
ENDIF
thisMCD%ncore = 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