Commit 466580da authored by Gregor Michalicek's avatar Gregor Michalicek

Reduce size of rhoLRes Array

If this is not enough there is also the option to only allocate
it for certain calculations. Up to now the feature that needs it
is deactivated anyway.
parent 92f307ef
...@@ -293,7 +293,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -293,7 +293,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO END DO
#endif #endif
CALL cdnmt(mpi,input%jspins,atoms,sym,sphhar,noco,jsp_start,jsp_end,& CALL cdnmt(mpi,input%jspins,input,atoms,sym,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt,hub1,input%l_dftspinpol) enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt,hub1,input%l_dftspinpol)
IF (mpi%irank==0) THEN IF (mpi%irank==0) THEN
......
...@@ -10,7 +10,7 @@ MODULE m_cdnmt ...@@ -10,7 +10,7 @@ MODULE m_cdnmt
! Philipp Kurz 2000-02-03 ! Philipp Kurz 2000-02-03
!*********************************************************************** !***********************************************************************
CONTAINS CONTAINS
SUBROUTINE cdnmt(mpi,jspd,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,& SUBROUTINE cdnmt(mpi,jspd,input,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,&
vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho,hub1,l_dftspinpol) vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho,hub1,l_dftspinpol)
use m_constants,only: sfp_const use m_constants,only: sfp_const
USE m_rhosphnlo USE m_rhosphnlo
...@@ -19,6 +19,7 @@ CONTAINS ...@@ -19,6 +19,7 @@ CONTAINS
USE m_types USE m_types
USE m_xmlOutput USE m_xmlOutput
IMPLICIT NONE IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_usdus), INTENT(INOUT) :: usdus !in fact only the lo part is intent(in) TYPE(t_usdus), INTENT(INOUT) :: usdus !in fact only the lo part is intent(in)
TYPE(t_noco), INTENT(IN) :: noco TYPE(t_noco), INTENT(IN) :: noco
...@@ -115,7 +116,9 @@ CONTAINS ...@@ -115,7 +116,9 @@ CONTAINS
+ denCoeffs%dd(l,itype,ispin)*( g(j,1,l,ispin)*g(j,1,l,ispin)+g(j,2,l,ispin)*g(j,2,l,ispin) )& + denCoeffs%dd(l,itype,ispin)*( g(j,1,l,ispin)*g(j,1,l,ispin)+g(j,2,l,ispin)*g(j,2,l,ispin) )&
+ 2*denCoeffs%du(l,itype,ispin)*( f(j,1,l,ispin)*g(j,1,l,ispin)+f(j,2,l,ispin)*g(j,2,l,ispin) ) + 2*denCoeffs%du(l,itype,ispin)*( f(j,1,l,ispin)*g(j,1,l,ispin)+f(j,2,l,ispin)*g(j,2,l,ispin) )
rho(j,0,itype,ispin) = rho(j,0,itype,ispin)+ s/(atoms%neq(itype)*sfp_const) rho(j,0,itype,ispin) = rho(j,0,itype,ispin)+ s/(atoms%neq(itype)*sfp_const)
moments%rhoLRes(j,0,llp,itype,ispin) = moments%rhoLRes(j,0,llp,itype,ispin)+ s/(atoms%neq(itype)*sfp_const) IF (l.LE.input%lResMax) THEN
moments%rhoLRes(j,0,llp,itype,ispin) = moments%rhoLRes(j,0,llp,itype,ispin)+ s/(atoms%neq(itype)*sfp_const)
END IF
ENDDO ENDDO
ENDDO ENDDO
...@@ -126,7 +129,7 @@ CONTAINS ...@@ -126,7 +129,7 @@ CONTAINS
qmtllo(l) = 0.0 qmtllo(l) = 0.0
END DO END DO
CALL rhosphnlo(itype,atoms,sphhar,sym,& CALL rhosphnlo(itype,input,atoms,sphhar,sym,&
usdus%uloulopn(:,:,itype,ispin),usdus%dulon(:,itype,ispin),& usdus%uloulopn(:,:,itype,ispin),usdus%dulon(:,itype,ispin),&
usdus%uulon(:,itype,ispin),enpara%ello0(:,itype,ispin),& usdus%uulon(:,itype,ispin),enpara%ello0(:,itype,ispin),&
vr(:,itype,ispin),denCoeffs%aclo(:,itype,ispin),denCoeffs%bclo(:,itype,ispin),& vr(:,itype,ispin),denCoeffs%aclo(:,itype,ispin),denCoeffs%bclo(:,itype,ispin),&
...@@ -179,7 +182,9 @@ CONTAINS ...@@ -179,7 +182,9 @@ CONTAINS
+ denCoeffs%dunmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*f(j,1,lp,ispin)& + denCoeffs%dunmt(llp,lh,itype,ispin)*(g(j,1,l,ispin)*f(j,1,lp,ispin)&
+ g(j,2,l,ispin)*f(j,2,lp,ispin) ) + g(j,2,l,ispin)*f(j,2,lp,ispin) )
rho(j,lh,itype,ispin) = rho(j,lh,itype,ispin)+ s/atoms%neq(itype) rho(j,lh,itype,ispin) = rho(j,lh,itype,ispin)+ s/atoms%neq(itype)
moments%rhoLRes(j,lh,llp,itype,ispin) = moments%rhoLRes(j,lh,llp,itype,ispin)+ s/atoms%neq(itype) IF ((l.LE.input%lResMax).AND.(lp.LE.input%lResMax)) THEN
moments%rhoLRes(j,lh,llp,itype,ispin) = moments%rhoLRes(j,lh,llp,itype,ispin)+ s/atoms%neq(itype)
END IF
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -228,8 +233,10 @@ CONTAINS ...@@ -228,8 +233,10 @@ CONTAINS
rho21=CONJG(cs)/(atoms%neq(itype)*sfp_const) rho21=CONJG(cs)/(atoms%neq(itype)*sfp_const)
rho(j,0,itype,3)=rho(j,0,itype,3)+REAL(rho21) rho(j,0,itype,3)=rho(j,0,itype,3)+REAL(rho21)
rho(j,0,itype,4)=rho(j,0,itype,4)+aimag(rho21) rho(j,0,itype,4)=rho(j,0,itype,4)+aimag(rho21)
moments%rhoLRes(j,0,llp,itype,3) = moments%rhoLRes(j,0,llp,itype,3)+ REAL(conjg(cs)/(atoms%neq(itype)*sfp_const)) IF (l.LE.input%lResMax) THEN
moments%rhoLRes(j,0,llp,itype,4) = moments%rhoLRes(j,0,llp,itype,4)+ AIMAG(conjg(cs)/(atoms%neq(itype)*sfp_const)) moments%rhoLRes(j,0,llp,itype,3) = moments%rhoLRes(j,0,llp,itype,3)+ REAL(conjg(cs)/(atoms%neq(itype)*sfp_const))
moments%rhoLRes(j,0,llp,itype,4) = moments%rhoLRes(j,0,llp,itype,4)+ AIMAG(conjg(cs)/(atoms%neq(itype)*sfp_const))
END IF
ENDDO ENDDO
ENDDO ENDDO
...@@ -250,8 +257,10 @@ CONTAINS ...@@ -250,8 +257,10 @@ CONTAINS
rho21=CONJG(cs)/atoms%neq(itype) rho21=CONJG(cs)/atoms%neq(itype)
rho(j,lh,itype,3)=rho(j,lh,itype,3)+REAL(rho21) rho(j,lh,itype,3)=rho(j,lh,itype,3)+REAL(rho21)
rho(j,lh,itype,4)=rho(j,lh,itype,4)+aimag(rho21) rho(j,lh,itype,4)=rho(j,lh,itype,4)+aimag(rho21)
moments%rhoLRes(j,lh,llpb,itype,3)= moments%rhoLRes(j,lh,llpb,itype,3) + REAL(conjg(cs)/atoms%neq(itype)) IF ((l.LE.input%lResMax).AND.(lp.LE.input%lResMax)) THEN
moments%rhoLRes(j,lh,llpb,itype,4)= moments%rhoLRes(j,lh,llpb,itype,4) + AIMAG(conjg(cs)/atoms%neq(itype)) moments%rhoLRes(j,lh,llpb,itype,3)= moments%rhoLRes(j,lh,llpb,itype,3) + REAL(conjg(cs)/atoms%neq(itype))
moments%rhoLRes(j,lh,llpb,itype,4)= moments%rhoLRes(j,lh,llpb,itype,4) + AIMAG(conjg(cs)/atoms%neq(itype))
END IF
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
......
...@@ -63,7 +63,7 @@ SUBROUTINE resMoms(sym,input,atoms,sphhar,noco,den,rhoLRes) ...@@ -63,7 +63,7 @@ SUBROUTINE resMoms(sym,input,atoms,sphhar,noco,den,rhoLRes)
CALL magDiMom(sym,input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,t_op,elecDip) CALL magDiMom(sym,input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,t_op,elecDip)
DO l = 0, atoms%lmaxd DO l = 0, input%lResMax
DO lp = 0, l DO lp = 0, l
llp = (l* (l+1))/2 + lp llp = (l* (l+1))/2 + lp
rhoTemp = 0.0 rhoTemp = 0.0
......
...@@ -12,7 +12,7 @@ MODULE m_rhosphnlo ...@@ -12,7 +12,7 @@ MODULE m_rhosphnlo
! Philipp Kurz 99/04 ! Philipp Kurz 99/04
!*********************************************************************** !***********************************************************************
CONTAINS CONTAINS
SUBROUTINE rhosphnlo(itype,atoms,sphhar,sym, uloulopn,dulon,uulon,& SUBROUTINE rhosphnlo(itype,input,atoms,sphhar,sym, uloulopn,dulon,uulon,&
ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,rholres,qmtllo) ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,rholres,qmtllo)
USE m_constants, ONLY : c_light,sfp_const USE m_constants, ONLY : c_light,sfp_const
...@@ -20,6 +20,7 @@ CONTAINS ...@@ -20,6 +20,7 @@ CONTAINS
USE m_radsrdn USE m_radsrdn
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
...@@ -99,7 +100,9 @@ CONTAINS ...@@ -99,7 +100,9 @@ CONTAINS
(aclo(lo) * ( f(j,1,l)*flo(j,1,lo) +f(j,2,l)*flo(j,2,lo) ) +& (aclo(lo) * ( f(j,1,l)*flo(j,1,lo) +f(j,2,l)*flo(j,2,lo) ) +&
bclo(lo) * ( g(j,1,l)*flo(j,1,lo) +g(j,2,l)*flo(j,2,lo) ) ) bclo(lo) * ( g(j,1,l)*flo(j,1,lo) +g(j,2,l)*flo(j,2,lo) ) )
rho(j,0) = rho(j,0) + temp rho(j,0) = rho(j,0) + temp
rhoLRes(j,0,llp) = rhoLRes(j,0,llp) + temp IF (l.LE.input%lResMax) THEN
rhoLRes(j,0,llp) = rhoLRes(j,0,llp) + temp
END IF
END DO END DO
DO lop = 1,atoms%nlo(itype) DO lop = 1,atoms%nlo(itype)
IF (atoms%llo(lop,itype).EQ.l) THEN IF (atoms%llo(lop,itype).EQ.l) THEN
...@@ -107,7 +110,9 @@ CONTAINS ...@@ -107,7 +110,9 @@ CONTAINS
temp = c_2 * cclo(lop,lo) *& temp = c_2 * cclo(lop,lo) *&
( flo(j,1,lop)*flo(j,1,lo) +flo(j,2,lop)*flo(j,2,lo) ) ( flo(j,1,lop)*flo(j,1,lo) +flo(j,2,lop)*flo(j,2,lo) )
rho(j,0) = rho(j,0) + temp rho(j,0) = rho(j,0) + temp
rhoLRes(j,0,llp) = rhoLRes(j,0,llp) + temp IF (l.LE.input%lResMax) THEN
rhoLRes(j,0,llp) = rhoLRes(j,0,llp) + temp
END IF
END DO END DO
END IF END IF
END DO END DO
...@@ -126,7 +131,9 @@ CONTAINS ...@@ -126,7 +131,9 @@ CONTAINS
acnmt(lp,lo,lh) * (f(j,1,lp)*flo(j,1,lo) +f(j,2,lp)*flo(j,2,lo) ) +& acnmt(lp,lo,lh) * (f(j,1,lp)*flo(j,1,lo) +f(j,2,lp)*flo(j,2,lo) ) +&
bcnmt(lp,lo,lh) * (g(j,1,lp)*flo(j,1,lo) +g(j,2,lp)*flo(j,2,lo) ) ) bcnmt(lp,lo,lh) * (g(j,1,lp)*flo(j,1,lo) +g(j,2,lp)*flo(j,2,lo) ) )
rho(j,lh) = rho(j,lh) + temp rho(j,lh) = rho(j,lh) + temp
rhoLRes(j,lh,llp) = rhoLRes(j,lh,llp) + temp IF ((l.LE.input%lResMax).AND.(lp.LE.input%lResMax)) THEN
rhoLRes(j,lh,llp) = rhoLRes(j,lh,llp) + temp
END IF
END DO END DO
END DO END DO
END DO END DO
...@@ -139,7 +146,9 @@ CONTAINS ...@@ -139,7 +146,9 @@ CONTAINS
temp = c_1 * ccnmt(lop,lo,lh) *& temp = c_1 * ccnmt(lop,lo,lh) *&
( flo(j,1,lop)*flo(j,1,lo) +flo(j,2,lop)*flo(j,2,lo) ) ( flo(j,1,lop)*flo(j,1,lo) +flo(j,2,lop)*flo(j,2,lo) )
rho(j,lh) = rho(j,lh) + temp rho(j,lh) = rho(j,lh) + temp
rhoLRes(j,lh,llp) = rhoLRes(j,lh,llp) + temp IF ((l.LE.input%lResMax).AND.(lp.LE.input%lResMax)) THEN
rhoLRes(j,lh,llp) = rhoLRes(j,lh,llp) + temp
END IF
END DO END DO
END DO END DO
END DO END DO
......
...@@ -97,6 +97,7 @@ MODULE m_types_input ...@@ -97,6 +97,7 @@ MODULE m_types_input
INTEGER :: rdmftStatesBelow=0 INTEGER :: rdmftStatesBelow=0
INTEGER :: rdmftStatesAbove=0 INTEGER :: rdmftStatesAbove=0
INTEGER :: rdmftFunctional=0 INTEGER :: rdmftFunctional=0
INTEGER :: lResMax = 3
CONTAINS CONTAINS
PROCEDURE :: read_xml=>read_xml_input PROCEDURE :: read_xml=>read_xml_input
PROCEDURE :: init => init_input PROCEDURE :: init => init_input
......
...@@ -429,7 +429,7 @@ SUBROUTINE moments_init(thisMoments,mpi,input,sphhar,atoms) ...@@ -429,7 +429,7 @@ SUBROUTINE moments_init(thisMoments,mpi,input,sphhar,atoms)
thisMoments%svdn = 0.0 thisMoments%svdn = 0.0
IF(mpi%irank.EQ.0) THEN IF(mpi%irank.EQ.0) THEN
ALLOCATE(thisMoments%rhoLRes(atoms%jmtd,0:sphhar%nlhd,0:(atoms%lmaxd*(atoms%lmaxd+1))/2+atoms%lmaxd,atoms%ntype,4)) ALLOCATE(thisMoments%rhoLRes(atoms%jmtd,0:sphhar%nlhd,0:(input%lResMax*(input%lResMax+1))/2+input%lResMax,atoms%ntype,4))
thisMoments%rhoLRes = 0.0 thisMoments%rhoLRes = 0.0
END IF END IF
......
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