Skip to content
GitLab
Commit bfbfae41 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files

Remove qintsl and qmtsl from read_dos

parent a5d130c7
Hide whitespace changes
Inline Side-by-side
cdn/cdnval.F90
View file @ bfbfae41
......@@ -140,7 +140,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
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)
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")
......@@ -221,7 +221,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,den,dos%qis,results,force%f_b8,zMat)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF (l_dosNdir) CALL q_int_sl(jspin,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
IF (l_dosNdir) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
! valence density in the vacuum region
IF (input%film) THEN
CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
......@@ -277,7 +277,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
#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,&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,mcd,slab,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO
#endif
......
cdn/q_int_sl.F90
View file @ bfbfae41
MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)
SUBROUTINE q_int_sl(isp,ikpt,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
......@@ -23,7 +23,7 @@ CONTAINS
TYPE(t_slab),INTENT(INOUT):: slab
!
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,isp
INTEGER, INTENT (IN) :: ne,isp,ikpt
! ..
! .. Local Scalars ..
REAL q1,zsl1,zsl2,qi,volsli,volintsli
......@@ -105,7 +105,7 @@ CONTAINS
DO j = 1,stars%ng3
qi = qi + z_z(j)*stfunint(j,i)
ENDDO
slab%qintsl(i,n) = qi
slab%qintsl(i,n,ikpt,isp) = qi
ENDDO ! over vacuum%layers
ENDDO ! over states
......
cdn/q_mt_sl.f90
View file @ bfbfae41
......@@ -134,7 +134,7 @@ CONTAINS
DO ntyp = 1,atoms%ntype
qq = qq + qmttot(ntyp,i)*slab%nmtsl(ntyp,nl)
ENDDO
slab%qmtsl(nl,i) = qq
slab%qmtsl(nl,i,ikpt,jsp) = qq
ENDDO
ENDDO
! DO ntyp = 1,ntype
......
dos/Ek_write_sl.f90
View file @ bfbfae41
......@@ -32,7 +32,7 @@ CONTAINS
INTEGER norb(23),iqsl(slab%nsld),iqvacpc(2)
REAL qvact(2)
REAL, ALLOCATABLE :: eig(:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:),qmtsl(:,:,:,:),qmtp(:,:,:,:)
REAL, ALLOCATABLE :: qmtp(:,:,:,:)
CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform
! ..
......@@ -40,8 +40,7 @@ CONTAINS
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(qintsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
ALLOCATE(qmtsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd),qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
ALLOCATE(qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
!
! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry
......@@ -77,8 +76,7 @@ CONTAINS
DO ikpt=1,kpts%nkpt
!
call read_eig(eig_id,ikpt,kspin,neig=nbands,eig=eig)
call read_dos(eig_id,ikpt,kspin,&
qintsl=qintsl(:,:,ikpt,kspin),qmtsl= qmtsl(:,:,ikpt,kspin),qmtp=qmtp(:,:,ikpt,kspin),orbcomp=orbcomp(:,:,:,ikpt,kspin))
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)
......@@ -92,11 +90,9 @@ CONTAINS
IF (sym%invs .OR. sym%zrfs) qvact(2) = qvact(1)
iqvacpc(:) = nint(qvact(:)*100.0)
DO j = 1,slab%nsl
iqsl(j) = nint( ( qintsl(j,iband,ikpt,kspin) + &
& 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
WRITE (130,FMT=chform) iband,eig(iband),iqvacpc(2),&
& (iqsl(l),l=1,slab%nsl),iqvacpc(1)
WRITE(130,FMT=chform) iband,eig(iband),iqvacpc(2),(iqsl(l),l=1,slab%nsl),iqvacpc(1)
WRITE(130,FMT=9)
WRITE(130,FMT=8)
WRITE(130,FMT=9)
......@@ -108,12 +104,9 @@ 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(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),qmtp(iband,mt,ikpt,kspin)
ENDIF
ENDDO
enddo
......@@ -133,7 +126,7 @@ CONTAINS
& 7(1x,i3,1x),'|',7(1x,i3,1x),'|',f6.1,'|')
9 FORMAT(133('-'))
!
DEALLOCATE ( eig,orbcomp,qintsl,qmtsl,qmtp )
DEALLOCATE ( eig,orbcomp,qmtp )
END SUBROUTINE Ek_write_sl
END MODULE m_Ekwritesl
dos/doswrite.f90
View file @ bfbfae41
......@@ -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,nsld,oneD)
sliceplot,noco,sym,cell,dos,mcd,results,slab,oneD)
USE m_evaldos
USE m_cdninf
USE m_types
......@@ -28,6 +28,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_slab),INTENT(IN) :: slab
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mcd),INTENT(IN) :: mcd
......@@ -35,7 +36,7 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER,PARAMETER :: n2max=13
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: eig_id
! locals
REAL :: wk,bkpt(3)
......@@ -103,7 +104,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,nsld)
DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd,slab)
END IF
! Now write to vacwave if nstm=3
......
dos/evaldos.f90
View file @ bfbfae41
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,nsld)
dimension,efermiarg,bandgap,l_mcd,mcd,slab)
!----------------------------------------------------------------------
!
! vk: k-vectors
......@@ -42,10 +42,10 @@
TYPE(t_results),INTENT(IN) :: results
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_mcd),INTENT(IN) :: mcd
TYPE(t_slab),INTENT(IN) :: slab
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
......@@ -63,7 +63,7 @@
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 :: qintsl(:,:),qmtsl(:,:),qvac(:,:)
REAL, ALLOCATABLE :: qvac(:,:)
CHARACTER(len=2) :: spin12(2),ch_mcd(3)
CHARACTER(len=8) :: chntype*2,chform*19
DATA spin12/'.1' , '.2'/
......@@ -73,7 +73,7 @@
qdim = lmax*atoms%ntype+3
l_orbcomp = banddos%l_orb
IF (banddos%ndir.EQ.-3) THEN
qdim = 2*nsld
qdim = 2*slab%nsld
n_orb = 0
IF (banddos%l_orb) THEN
n_orb = banddos%orbCompAtom
......@@ -156,9 +156,9 @@
! 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,qintsl,qmtsl,qmtp,orbcomp)
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)/))
......@@ -167,8 +167,8 @@
qal(lmax*atoms%ntype+1,:,k)=dos%qis(:,k,jspin) ! interstitial
ELSE
IF (n_orb == 0) THEN
qal(1:nsld,:,k) = qintsl(:,:)
qal(nsld+1:2*nsld,:,k) = qmtsl(:,:)
qal(1:slab%nsld,:,k) = slab%qintsl(:,:,k,jspin)
qal(slab%nsld+1:2*slab%nsld,:,k) = slab%qmtsl(:,:,k,jspin)
ELSE
DO i = 1, 23
DO l = 1, results%neig(k,jspin)
......@@ -180,7 +180,7 @@
END DO
END IF
END IF
DEALLOCATE( orbcomp,qintsl,qmtsl,qmtp)
DEALLOCATE( orbcomp,qmtp)
!
! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays
......@@ -356,8 +356,8 @@
ENDDO
ENDDO
ELSEIF (n_orb == 0) THEN
DO l = 1 , nsld
nl = nsld+l
DO l = 1, slab%nsld
nl = slab%nsld+l
DO i = 1 , ned
gpart(i,l) = g(i,l) + g(i,nl)
ENDDO
......@@ -384,10 +384,10 @@
g(i,lmax*atoms%ntype+2),g(i,lmax*atoms%ntype+3), (gpart(i,l),l=1,atoms%ntype)
ENDIF
ELSEIF (n_orb == 0) THEN
DO nl = 1 , nsld
DO nl = 1, slab%nsld
totdos = totdos + gpart(i,nl)
ENDDO
WRITE (18,99001) e(i),totdos,(gpart(i,nl),nl=1,nsld), (g(i,l),l=1,2*nsld)
WRITE (18,99001) e(i),totdos,(gpart(i,nl),nl=1,slab%nsld), (g(i,l),l=1,2*slab%nsld)
ELSE
DO nl = 1 , 23
totdos = totdos + g(i,nl)
......
io/eig66_da.F90
View file @ bfbfae41
......@@ -266,38 +266,35 @@ CONTAINS
END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE write_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
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.AND.PRESENT(qmtsl)) THEN
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) qintsl,qmtsl,qmtp,orbcomp
ELSEIF(d%l_mcd.AND.PRESENT(mcd)) THEN
WRITE(d%file_io_id_dos,REC=nrec) mcd
WRITE(d%file_io_id_dos,REC=nrec) qmtp,orbcomp
END IF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
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.AND.PRESENT(qmtsl)) THEN
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) qintsl,qmtsl,qmtp,orbcomp
READ(d%file_io_id_dos,REC=nrec) qmtp,orbcomp
END IF
END SUBROUTINE read_dos
......
io/eig66_hdf.F90
View file @ bfbfae41
......@@ -294,16 +294,14 @@ CONTAINS
END SUBROUTINE priv_r_vec
#endif
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
TYPE(t_data_HDF),POINTER :: d
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.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)
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
......
io/eig66_io.F90
View file @ bfbfae41
......@@ -181,13 +181,13 @@ CONTAINS
CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CALL write_dos_DA(id,nk,jspin,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
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,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
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,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
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
......@@ -195,24 +195,24 @@ CONTAINS
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
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 :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
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,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_DA(id,nk,jspin,qmtp,orbcomp)
CASE (hdf_mode)
CALL read_dos_HDF(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_HDF(id,nk,jspin,qmtp,orbcomp)
CASE (mem_mode)
CALL read_dos_Mem(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
CALL read_dos_Mem(id,nk,jspin,qmtp,orbcomp)
CASE (MPI_mode)
CALL read_dos_MPI(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
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
......
io/eig66_mem.F90
View file @ bfbfae41
......@@ -172,10 +172,10 @@ CONTAINS
ENDIF
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(OUT),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
REAL,INTENT(OUT),OPTIONAL :: qmtp(:,:),orbcomp(:,:,:)
INTEGER::nrec
TYPE(t_data_mem),POINTER:: d
......@@ -183,9 +183,7 @@ CONTAINS
nrec=nk+(jspin-1)*d%nkpts
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
qintsl=d%qintsl(:,:,nrec)
qmtsl=d%qmtsl(:,:,nrec)
IF (d%l_orb) THEN
qmtp=d%qmtp(:,:,nrec)
orbcomp=d%orbcomp(:,:,:,nrec)
ENDIF
......
io/eig66_mpi.F90
View file @ bfbfae41
......@@ -525,10 +525,10 @@ CONTAINS
#endif
END SUBROUTINE write_dos
SUBROUTINE read_dos(id,nk,jspin,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE read_dos(id,nk,jspin,qmtp,orbcomp)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(out),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
REAL,INTENT(out),OPTIONAL :: qmtp(:,:),orbcomp(:,:,:)
#ifdef CPP_MPI
TYPE(t_data_MPI),POINTER :: d
INTEGER:: pe,slot
......@@ -537,9 +537,7 @@ CONTAINS
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
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)
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
......
main/cdngen.F90
View file @ bfbfae41
......@@ -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,dos,mcd,results,slab%nsld,oneD)
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab,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)
END IF
......
mpi/mpi_col_den.F90
View file @ bfbfae41
......@@ -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,&
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,mcd,slab,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
#include"cpp_double.h"
......@@ -20,12 +20,12 @@ CONTAINS
TYPE(t_results),INTENT(INOUT):: results
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(INOUT) :: den
INCLUDE 'mpif.h'
......@@ -41,6 +41,7 @@ CONTAINS
TYPE (t_regionCharges), INTENT(INOUT) :: regCharges
TYPE (t_dos), INTENT(INOUT) :: dos
TYPE (t_mcd), INTENT(INOUT) :: mcd
TYPE (t_slab), INTENT(INOUT) :: slab
! ..
! .. Local Scalars ..
INTEGER :: n, i
......@@ -181,6 +182,19 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, mcd%mcd(:,:,:,:,jspin), 1)
DEALLOCATE (r_b)
! Collect slab - qintsl and qmtsl
n = SIZE(slab%qintsl,1)*SIZE(slab%qintsl,2)*SIZE(slab%qintsl,3)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(slab%qintsl(:,:,:,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, slab%qintsl(:,:,:,jspin), 1)
DEALLOCATE (r_b)
n = SIZE(slab%qmtsl,1)*SIZE(slab%qmtsl,2)*SIZE(slab%qmtsl,3)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(slab%qmtsl(:,:,:,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, slab%qmtsl(:,:,:,jspin), 1)
DEALLOCATE (r_b)
! -> Collect force
IF (input%l_f) THEN
n=3*atoms%ntype
......
types/types_cdnval.f90
View file @ bfbfae41
......@@ -68,8 +68,8 @@ PRIVATE
REAL, ALLOCATABLE :: zsl(:,:)
REAL, ALLOCATABLE :: volsl(:)
REAL, ALLOCATABLE :: volintsl(:)
REAL, ALLOCATABLE :: qintsl(:,:)
REAL, ALLOCATABLE :: qmtsl(:,:)
REAL, ALLOCATABLE :: qintsl(:,:,:,:)
REAL, ALLOCATABLE :: qmtsl(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => slab_init
......@@ -278,9 +278,10 @@ SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end)
END SUBROUTINE denCoeffs_init
SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell,input,kpts)
USE m_types_setup
USE m_types_kpts
USE m_slabdim
USE m_slabgeom
......@@ -291,6 +292,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_input), INTENT(IN) :: input
TYPE(t_kpts), INTENT(IN) :: kpts
INTEGER :: nsld
......@@ -311,8 +314,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
ALLOCATE (thisSlab%zsl(2,nsld))
ALLOCATE (thisSlab%volsl(nsld))
ALLOCATE (thisSlab%volintsl(nsld))
ALLOCATE (thisSlab%qintsl(nsld,dimension%neigd))
ALLOCATE (thisSlab%qmtsl(nsld,dimension%neigd))
ALLOCATE (thisSlab%qintsl(nsld,dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE (thisSlab%qmtsl(nsld,dimension%neigd,kpts%nkpt,input%jspins))
CALL slabgeom(atoms,cell,nsld,thisSlab%nsl,thisSlab%zsl,thisSlab%nmtsl,&
thisSlab%nslat,thisSlab%volsl,thisSlab%volintsl)
ELSE
......@@ -321,8 +324,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
ALLOCATE (thisSlab%zsl(1,1))
ALLOCATE (thisSlab%volsl(1))
ALLOCATE (thisSlab%volintsl(1))
ALLOCATE (thisSlab%qintsl(1,1))
ALLOCATE (thisSlab%qmtsl(1,1))
ALLOCATE (thisSlab%qintsl(1,1,1,input%jspins))
ALLOCATE (thisSlab%qmtsl(1,1,1,input%jspins))
END IF
thisSlab%nsld = nsld
......
Supports Markdown
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