Commit 7fe29d49 authored by Gregor Michalicek's avatar Gregor Michalicek

Move some cdnval related timers to the actually associated subroutines

parent aef7be8e
......@@ -131,6 +131,8 @@ CONTAINS
TYPE (t_orbcomp) :: orbcomp
TYPE (t_gVacMap) :: gVacMap
CALL timestart("cdnval")
l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco)
IF (noco%l_mperp) THEN
......@@ -183,15 +185,11 @@ CONTAINS
l_write = input%cdinf.AND.mpi%irank==0
DO iType = 1,atoms%ntype
DO ispin = jsp_start, jsp_end
CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,l_write,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin))
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)
END DO
......@@ -249,10 +247,8 @@ CONTAINS
! ----> valence density in the interstitial region
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: pwden")
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,den,regCharges%qis,results,force%f_b8,zMat)
CALL timestop("cdnval: pwden")
END IF
!---> charge of each valence state in this k-point of the SBZ
......@@ -266,11 +262,9 @@ CONTAINS
!---> valence density in the vacuum region
IF (input%film) THEN
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac0,eig,&
den,regCharges%qvac,regCharges%qvlay,regCharges%qstars,zMat)
CALL timestop("cdnval: vacden")
END IF
!---> perform Brillouin zone integration and summation over the
!---> bands in order to determine the vacuum energy parameters.
......@@ -287,13 +281,9 @@ CONTAINS
DO ispin = jsp_start,jsp_end
IF (input%l_f) CALL force%init2(noccbd,input,atoms)
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
CALL timestop("cdnval: abcof")
IF (atoms%n_u.GT.0) CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,jspin))
!---> perform Brillouin zone integration and summation over the
......@@ -324,14 +314,12 @@ CONTAINS
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
IF (input%l_f) THEN
CALL timestart("cdnval: force_a12/21")
IF (.not.input%l_useapw) THEN
CALL force_a12(atoms,noccbd,sym,dimension,cell,oneD,&
we,ispin,noccbd,usdus,eigVecCoeffs,force,results)
ENDIF
CALL force_a21(input,atoms,dimension,noccbd,sym,oneD,cell,we,ispin,&
enpara%el0(0:,:,ispin),noccbd,eig,usdus,eigVecCoeffs,force,results)
CALL timestop("cdnval: force_a12/21")
END IF
IF(l_cs) THEN
......@@ -359,12 +347,10 @@ CONTAINS
END DO !---> end of k-point loop
#ifdef CPP_MPI
CALL timestart("cdnval: mpi_col_den")
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO
CALL timestop("cdnval: mpi_col_den")
#endif
IF (mpi%irank==0) THEN
......@@ -377,19 +363,13 @@ CONTAINS
!---> check continuity of charge density
IF (input%cdinf) THEN
CALL timestart("cdnval: cdninf-stuff")
WRITE (6,FMT=8210) ispin
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin)
CALL timestop("cdnval: cdninf-stuff")
END IF
!---> forces of equ. A8 of Yu et al.
IF ((input%l_f)) THEN
CALL timestart("cdnval: force_a8")
CALL force_a8(input,atoms,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results)
CALL timestop("cdnval: force_a8")
END IF
IF ((input%l_f)) CALL force_a8(input,atoms,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results)
END DO ! end of loop ispin = jsp_start,jsp_end
CALL closeXMLElement('mtCharges')
......@@ -408,5 +388,7 @@ CONTAINS
CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
#endif
CALL timestop("cdnval")
END SUBROUTINE cdnval
END MODULE m_cdnval
......@@ -176,8 +176,8 @@ CONTAINS
! pgfft : contains the phases of the g-vectors of sph.
! isn : isn = +1, FFT transform for g-space to r-space
! isn = -1, vice versa
!
CALL timestart("pwden")
ALLOCATE(cwk(stars%ng3),ecwk(stars%ng3))
......@@ -715,5 +715,7 @@ CONTAINS
IF (input%l_f) DEALLOCATE ( kpsir,kpsii,ekin)
ENDIF
CALL timestop("pwden")
END SUBROUTINE pwden
END MODULE m_pwden
......@@ -138,7 +138,9 @@ CONTAINS
! \vec{a}_1,2 are the 2D lattice vectors
!
! **************************************************************************************************
!
CALL timestart("vacden")
ALLOCATE ( ac(DIMENSION%nv2d,DIMENSION%neigd,DIMENSION%jspd),bc(DIMENSION%nv2d,DIMENSION%neigd,DIMENSION%jspd),dt(DIMENSION%nv2d),&
& dte(DIMENSION%nv2d),du(vacuum%nmzd),ddu(vacuum%nmzd,DIMENSION%nv2d),due(vacuum%nmzd),&
& ddue(vacuum%nmzd,DIMENSION%nv2d),t(DIMENSION%nv2d),te(DIMENSION%nv2d),&
......@@ -1244,5 +1246,7 @@ CONTAINS
DEALLOCATE (t_1,te_1,tei_1,u_1,ue_1)
END IF ! oneD%odi%d1
CALL timestop("vacden")
END SUBROUTINE vacden
END MODULE m_vacden
......@@ -15,6 +15,7 @@ CONTAINS
USE m_abclocdn
USE m_ylm
USE m_types
USE m_juDFT
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_usdus),INTENT(IN) :: usdus
......@@ -55,6 +56,8 @@ CONTAINS
REAL, ALLOCATABLE :: work_r(:)
COMPLEX, ALLOCATABLE :: work_c(:)
CALL timestart("abcof")
IF (zmat%l_real) THEN
IF (noco%l_soc.AND.sym%invs) CALL judft_error("BUG in abcof, SOC&INVS but real?")
IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
......@@ -362,5 +365,7 @@ CONTAINS
ENDDO
ENDIF
CALL timestop("abcof")
END SUBROUTINE abcof
END MODULE m_abcof
......@@ -9,6 +9,7 @@ CONTAINS
we,jsp,ne,usdus,eigVecCoeffs,force,results)
USE m_types
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_force),INTENT(INOUT) :: force
......@@ -43,13 +44,9 @@ CONTAINS
! .. Statement Functions ..
REAL alpha,beta,delta,epslon,gamma,phi
INTEGER krondel
! ..
! .. Statement Function definitions ..
! inline functions:
!
! Kronecker delta for arguments >=0 AND <0
!
!
krondel(i,j) = MIN(ABS(i)+1,ABS(j)+1)/MAX(ABS(i)+1,ABS(j)+1)* (1+SIGN(1,i)*SIGN(1,j))/2
alpha(l,m) = (l+1)*0.5e0*SQRT(REAL((l-m)* (l-m-1))/ REAL((2*l-1)* (2*l+1)))
beta(l,m) = l*0.5e0*SQRT(REAL((l+m+2)* (l+m+1))/ REAL((2*l+1)* (2*l+3)))
......@@ -57,9 +54,9 @@ CONTAINS
delta(l,m) = l*0.5e0*SQRT(REAL((l-m+2)* (l-m+1))/ REAL((2*l+1)* (2*l+3)))
epslon(l,m) = (l+1)*SQRT(REAL((l-m)* (l+m))/ REAL((2*l-1)* (2*l+1)))
phi(l,m) = l*SQRT(REAL((l-m+1)* (l+m+1))/REAL((2*l+1)* (2*l+3)))
! ..
!
!
CALL timestart("force_a12")
natom = 1
DO n = 1,atoms%ntype
IF (atoms%l_geo(n)) THEN
......@@ -235,6 +232,8 @@ CONTAINS
ENDIF
natom = natom + atoms%neq(n)
ENDDO
!
CALL timestop("force_a12")
END SUBROUTINE force_a12
END MODULE m_forcea12
......@@ -26,6 +26,7 @@ CONTAINS
USE m_tlmplm_store
USE m_types
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_force),INTENT(INOUT) :: force
......@@ -62,8 +63,9 @@ CONTAINS
REAL vec(3),vec2(3),vecsum(3),vecsum2(3)
TYPE(t_tlmplm)::tlmplm
! ..
! ..
CALL timestart("force_a21")
!dimension%lmplmd = (dimension%lmd* (dimension%lmd+3))/2
mlotot = 0 ; mlolotot = 0
DO n = 1, atoms%ntype
......@@ -355,8 +357,8 @@ CONTAINS
ENDIF ! IF (atoms%l_geo(n)) ...
natom = natom + atoms%neq(n)
ENDDO
!
DEALLOCATE (tlmplm%tdd,tlmplm%tuu,tlmplm%tdu,tlmplm%tud,tlmplm%tuulo,tlmplm%tdulo,tlmplm%tuloulo,tlmplm%ind,a21,b4)
CALL timestop("force_a21")
END SUBROUTINE force_a21
END MODULE m_forcea21
......@@ -11,6 +11,7 @@ CONTAINS
USE m_gaunt, ONLY :gaunt1
USE m_differentiate,ONLY: difcub
USE m_types
USE m_juDFT
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
......@@ -41,12 +42,8 @@ CONTAINS
! .. Data statements ..
COMPLEX,PARAMETER:: czero=CMPLX(0.000,0.000)
COMPLEX,PARAMETER:: ci = CMPLX(0.0,1.0)
!
! inline functions:
!
! Kronecker delta for arguments >=0 AND <0
!
!
krondel(i,j) = MIN(ABS(i)+1,ABS(j)+1)/MAX(ABS(i)+1,ABS(j)+1)* (1+SIGN(1,i)*SIGN(1,j))/2
alpha(l,m) = (l+1)*0.5e0*SQRT(REAL((l-m)* (l-m-1))/ REAL((2*l-1)* (2*l+1)))
beta(l,m) = l*0.5e0*SQRT(REAL((l+m+2)* (l+m+1))/ REAL((2*l+1)* (2*l+3)))
......@@ -54,10 +51,12 @@ CONTAINS
delta(l,m) = l*0.5e0*SQRT(REAL((l-m+2)* (l-m+1))/ REAL((2*l+1)* (2*l+3)))
epslon(l,m) = (l+1)*SQRT(REAL((l-m)* (l+m))/ REAL((2*l-1)* (2*l+1)))
phi(l,m) = l*SQRT(REAL((l-m+1)* (l+m+1))/REAL((2*l+1)* (2*l+3)))
! ..
CALL timestart("force_a8")
WRITE (6,*)
WRITE (16,*)
!
na = 1
DO n = 1,atoms%ntype
IF (atoms%l_geo(n)) THEN
......@@ -69,7 +68,7 @@ CONTAINS
nd = atoms%ntypsy(na)
!
CALL intgr3(rho(:,0,n,jsp),atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),qval)
!
! check if l=0 density is correct;
! note that in general also all l>0
! components of the density have been multiplied by r**2
......@@ -77,9 +76,8 @@ CONTAINS
! factor sqrt(4pi) comes from Y_00 * \int d\Omega = 1/sqrt(4pi) * 4pi
! write(16,1616) qval*sfp
8000 FORMAT (' FORCE_A8: valence charge=',1p,e16.8)
!
! PART I of FORCE_A8
!
DO lh1 = 0,sphhar%nlh(nd)
l1 = sphhar%llh(lh1,nd)
DO lh2 = 0,sphhar%nlh(nd)
......@@ -309,5 +307,7 @@ CONTAINS
8060 FORMAT (' FX_A21=',2f10.6,' FY_A21=',2f10.6,' FZ_A21=',2f10.6)
ENDDO
CALL timestop("force_a8")
END SUBROUTINE force_a8
END MODULE m_forcea8
......@@ -16,6 +16,7 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
USE m_types
USE m_cylpts
USE m_points
USE m_juDFT
IMPLICIT NONE
......@@ -37,6 +38,8 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
REAL :: xp(3,dimension%nspd)
CALL timestart("checkDOPAll")
IF ((input%film).AND.(.NOT.oneD%odi%d1)) THEN
!---> vacuum boundaries
npd = min(dimension%nspd,25)
......@@ -48,12 +51,10 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
sphhar,stars,sym,vacuum,cell,oneD,potden)
END DO
ELSE IF (oneD%odi%d1) THEN
!-odim
npd = min(dimension%nspd,25)
CALL cylpts(xp,npd,cell%z1)
CALL checkdop(xp,npd,0,0,ivac,1,ispin,dimension,atoms,&
sphhar,stars,sym,vacuum,cell,oneD,potden)
!+odim
END IF
!---> m.t. boundaries
......@@ -65,6 +66,8 @@ SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
nat = nat + atoms%neq(n)
END DO
CALL timestop("checkDOPAll")
END SUBROUTINE checkDOPAll
END MODULE m_checkdopall
......@@ -92,21 +92,19 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
jspmax = input%jspins
IF (noco%l_mperp) jspmax = 1
DO jspin = 1,jspmax
CALL timestart("cdngen: cdnval")
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,results,moments,mcd,slab)
CALL timestop("cdngen: cdnval")
END DO
IF (mpi%irank.EQ.0) THEN
IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
CALL timestart("cdnval: dos")
CALL timestart("cdngen: dos")
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,mcd,results,slab%nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,slab)
END IF
CALL timestop("cdnval: dos")
CALL timestop("cdngen: dos")
END IF
END IF
......
......@@ -15,6 +15,7 @@ CONTAINS
#include"cpp_double.h"
USE m_types
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT):: results
......@@ -50,6 +51,7 @@ CONTAINS
! .. External Subroutines
EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE
CALL timestart("mpi_col_den")
! -> Collect den%pw(:,jspin)
n = stars%ng3
......@@ -440,6 +442,7 @@ CONTAINS
ENDIF
!-lda+U
RETURN
CALL timestop("mpi_col_den")
END SUBROUTINE mpi_col_den
END MODULE m_mpi_col_den
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