Commit f3a9572a authored by Gregor Michalicek's avatar Gregor Michalicek

Make some arguments to cdnval optional

parent 6827f484
......@@ -11,8 +11,8 @@ USE m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalJob,den,regCharges,dos,results,&
moments,mcd,slab,orbcomp)
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,cdnvalJob,den,regCharges,dos,results,&
moments,orbcomp,coreSpecInput,mcd,slab)
!************************************************************************************
! This is the FLEUR valence density generator
......@@ -70,16 +70,16 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_coreSpecInput), INTENT(IN) :: coreSpecInput
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_cdnvalJob), INTENT(IN) :: cdnvalJob
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_mcd), INTENT(INOUT) :: mcd
TYPE(t_slab), INTENT(INOUT) :: slab
TYPE(t_orbcomp), INTENT(INOUT) :: orbcomp
TYPE(t_coreSpecInput), OPTIONAL, INTENT(IN) :: coreSpecInput
TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
TYPE(t_slab), OPTIONAL, INTENT(INOUT) :: slab
! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin
......@@ -92,7 +92,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp
INTEGER :: iErr,nbands,noccbd,iType
INTEGER :: skip_t,skip_tt,nStart,nEnd,nbasfcn
LOGICAL :: l_orbcomprot, l_real, l_write, l_dosNdir
LOGICAL :: l_orbcomprot, l_real, l_write, l_dosNdir, l_corespec
! Local Arrays
REAL, ALLOCATABLE :: we(:)
......@@ -141,11 +141,16 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
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 (banddos%l_mcd.AND..NOT.PRESENT(mcd)) CALL juDFT_error("mcd is missing",calledby ="cdnval")
! calculation of core spectra (EELS) initializations -start-
CALL corespec_init(input,atoms,coreSpecInput)
IF(l_cs.AND.(mpi%isize.NE.1)) CALL juDFT_error('EELS + MPI not implemented', calledby = 'cdnval')
IF(l_cs.AND.jspin.EQ.1) CALL corespec_gaunt()
l_coreSpec = .FALSE.
IF (PRESENT(coreSpecInput)) THEN
CALL corespec_init(input,atoms,coreSpecInput)
IF(l_cs.AND.(mpi%isize.NE.1)) CALL juDFT_error('EELS + MPI not implemented', calledby = 'cdnval')
IF(l_cs.AND.jspin.EQ.1) CALL corespec_gaunt()
l_coreSpec = l_cs
END IF
! calculation of core spectra (EELS) initializations -end-
IF (mpi%irank==0) THEN
......@@ -162,8 +167,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO
IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
IF (l_cs) CALL corespec_rme(atoms,input,iType,dimension%nstd,input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g)
IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,dimension%nstd,input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g)
END DO
DEALLOCATE (f,g,flo)
......@@ -211,14 +216,13 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
! valence density in the interstitial region
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)
jspin,lapw,noccbd,we,eig,den,results,force%f_b8,zMat,dos)
! 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,ikpt,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
IF (l_dosNdir.AND.PRESENT(slab)) 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,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac0,eig,&
den,dos%qvac,dos%qvlay,dos%qstars,zMat)
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac0,eig,den,zMat,dos)
END IF
END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
......@@ -235,13 +239,13 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
! perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,mcd,banddos%l_mcd)
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF (l_dosNdir) THEN
CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
......@@ -254,8 +258,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
IF (input%l_f) CALL force%addContribsA21A12(input,atoms,dimension,sym,cell,oneD,enpara,&
usdus,eigVecCoeffs,noccbd,ispin,eig,we,results)
IF(l_cs) CALL corespec_dos(atoms,usdus,ispin,dimension%lmd,kpts%nkpt,ikpt,dimension%neigd,&
noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,dimension%lmd,kpts%nkpt,ikpt,dimension%neigd,&
noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
END DO ! end loop over ispin
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
......@@ -267,15 +271,15 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#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,orbcomp,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,orbcomp,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin),mcd,slab)
END DO
#endif
IF (mpi%irank==0) THEN
CALL cdnmt(dimension%jspd,atoms,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF (l_cs) CALL corespec_ddscs(jspin,input%jspins)
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
DO ispin = jsp_start,jsp_end
IF (input%cdinf) THEN
WRITE (6,FMT=8210) ispin
......
......@@ -24,7 +24,7 @@ MODULE m_eparas
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,mcd,l_mcd)
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus
......@@ -33,7 +33,7 @@ CONTAINS
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_mcd), INTENT(INOUT) :: mcd
TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,jsp
......
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne,we,eig,den,qis,results,f_b8,zMat)
ikpt,jspin,lapw,ne,we,eig,den,results,f_b8,zMat,dos)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -80,32 +80,32 @@ CONTAINS
USE m_types
USE m_fft_interface
IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dos), INTENT(INOUT) :: dos
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
!-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne
!-----> CHARGE DENSITY INFORMATION
INTEGER,INTENT(IN) :: ikpt,jspin
REAL,INTENT(OUT) :: qis(:,:,:) !(dimension%neigd,kpts%nkpt,dimension%jspd)
INTEGER,INTENT(IN) :: ikpt,jspin
COMPLEX, INTENT (INOUT) :: f_b8(3,atoms%ntype)
!
!-----> LOCAL VARIABLES
!
!-----> FFT INFORMATION
INTEGER :: ifftq2d,ifftq3d
......@@ -256,7 +256,7 @@ CONTAINS
IF (noco%l_noco) THEN
rhomat = 0.0
IF (ikpt.LE.mpi%isize) THEN
qis=0.0
dos%qis=0.0
ENDIF
ELSE
rhon=0.0
......@@ -473,7 +473,7 @@ CONTAINS
!---> total charge does not need to be one in each spin-
!---> channel. Thus it has to be calculated explicitly, if
!---> it is needed.
IF (banddos%dos .OR. banddos%vacdos .OR. input%cdinf) THEN
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
DO ir = 0,ifftq3d-1
psi1r(ir) = (psi1r(ir)**2 + psi1i(ir)**2)
psi2r(ir) = (psi2r(ir)**2 + psi2i(ir)**2)
......@@ -494,7 +494,7 @@ CONTAINS
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell,stars%kv3(1,istr),x)
qis(nu,ikpt,1) = qis(nu,ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
dos%qis(nu,ikpt,1) = dos%qis(nu,ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
cwk=0.0
......@@ -504,7 +504,7 @@ CONTAINS
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell, stars%kv3(1,istr), x)
qis(nu,ikpt,input%jspins) = qis(nu,ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
dos%qis(nu,ikpt,input%jspins) = dos%qis(nu,ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
ENDIF
ELSE
......
This diff is collapsed.
......@@ -100,7 +100,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DO jspin = 1,jspmax
CALL cdnvalJob%init(mpi,input,kpts,banddos,noco,results,jspin,sliceplot)
CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalJob,outDen,regCharges,dos,results,moments,mcd,slab,orbcomp)
sphhar,sym,obsolete,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,orbcomp,coreSpecInput,mcd,slab)
END DO
IF (mpi%irank.EQ.0) THEN
......
......@@ -9,8 +9,8 @@ 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,orbcomp,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,orbcomp,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp,mcd,slab)
#include"cpp_double.h"
USE m_types
......@@ -40,9 +40,9 @@ 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
TYPE (t_slab), INTENT(INOUT) :: slab
TYPE (t_orbcomp), INTENT(INOUT) :: orbcomp
TYPE (t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
TYPE (t_slab), OPTIONAL, INTENT(INOUT) :: slab
! ..
! .. Local Scalars ..
INTEGER :: n, i
......@@ -177,24 +177,28 @@ CONTAINS
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)
IF (PRESENT(mcd)) THEN
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)
END IF
! 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)
IF (PRESENT(slab)) THEN
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)
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)
END IF
! Collect orbcomp - comp and qmtp
......
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