Skip to content

GitLab

fleur
fleur
Commit ed8a3553 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 969f97e4 0d31f0ab
Hide whitespace changes
Inline Side-by-side
Showing with 84 additions and 51 deletions
cdn/cdntot.f90
View file @ ed8a3553
MODULE m_cdntot
MODULE m_cdntot
! ********************************************************
! calculate the total charge density in the interstial.,
! vacuum, and mt regions c.l.fu
! ********************************************************
CONTAINS
SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,&
den,l_printData,qtot,qistot)
CONTAINS
SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,&
den,l_printData,qtot,qistot)
USE m_intgr, ONLY : intgr3
USE m_constants
......@@ -55,19 +55,19 @@
q = 0.e0
! -----mt charge
CALL timestart("MT")
DO 10 n = 1,atoms%ntype
DO n = 1,atoms%ntype
CALL intgr3(den%mt(:,0,n,jspin),atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),w)
qmt(n) = w*sfp_const
q = q + atoms%neq(n)*qmt(n)
10 CONTINUE
ENDDO
CALL timestop("MT")
! -----vacuum region
IF (input%film) THEN
DO 20 ivac = 1,vacuum%nvac
DO ivac = 1,vacuum%nvac
DO nz = 1,vacuum%nmz
IF (oneD%odi%d1) THEN
rht1(nz,ivac,jspin) = (cell%z1+(nz-1)*vacuum%delz)*&
& den%vacz(nz,ivac,jspin)
den%vacz(nz,ivac,jspin)
ELSE
rht1(nz,ivac,jspin) = den%vacz(nz,ivac,jspin)
END IF
......@@ -79,30 +79,19 @@
ELSE
q = q + cell%area*q2(1)
END IF
20 CONTINUE
ENDDO
END IF
! -----is region
IF (.not.judft_was_Argument("-oldfix")) THEN
CALL convol(stars,x,den%pw(:,jspin),stars%ufft)
qis = x(1)*cell%omtil
ELSE
qis = 0.
! DO 30 j = 1,nq3
! CALL pwint(
! > k1d,k2d,k3d,n3d,ntypd,natd,nop,invtab,odi,
! > ntype,neq,volmts,taual,z1,vol,volint,
! > symor,tau,mrot,rmt,sk3,bmat,ig2,ig,
! > kv3(1,j),
! < x)
! qis = qis + den%pw(j,jspin)*x*nstr(j)
! 30 CONTINUE
CALL pwint_all(&
& stars,atoms,sym,oneD,&
& cell,&
& x)
DO j = 1,stars%ng3
qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j)
ENDDO
qis = 0.
CALL pwint_all(stars,atoms,sym,oneD,cell,x)
DO j = 1,stars%ng3
qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j)
ENDDO
endif
qistot = qistot + qis
q = q + qis
......@@ -137,12 +126,12 @@
IF(l_printData) THEN
CALL writeXMLElementFormPoly('totalCharge',(/'value'/),(/qtot/),reshape((/5,20/),(/1,2/)))
END IF
8000 FORMAT (/,10x,'total charge for spin',i3,'=',f12.6,/,10x,&
& 'interst. charge = ',f12.6,/,&
& (10x,'mt charge= ',4f12.6,/))
8010 FORMAT (10x,'vacuum ',i2,' charge= ',f12.6)
8020 FORMAT (/,10x,'total charge =',f12.6)
8000 FORMAT (/,10x,'total charge for spin',i3,'=',f12.6,/,10x,&
'interst. charge = ',f12.6,/,&
(10x,'mt charge= ',4f12.6,/))
8010 FORMAT (10x,'vacuum ',i2,' charge= ',f12.6)
8020 FORMAT (/,10x,'total charge =',f12.6)
CALL timestop("cdntot")
END SUBROUTINE cdntot
END MODULE m_cdntot
END SUBROUTINE cdntot
END MODULE m_cdntot
diagonalization/chase_diag.F90
View file @ ed8a3553
......@@ -70,13 +70,25 @@ IMPLICIT NONE
PRIVATE
INTEGER :: chase_eig_id
INTEGER :: chase_eig_id
PUBLIC init_chase, chase_diag
#endif
REAL :: scale_distance
REAL :: tol
PUBLIC chase_distance
CONTAINS
CONTAINS
SUBROUTINE init_chase(mpi,dimension,atoms,kpts,noco,l_real)
SUBROUTINE chase_distance(dist)
IMPLICIT NONE
REAL,INTENT(in)::dist
tol=MAX(1E-8,dist*scale_distance)
END SUBROUTINE chase_distance
#ifdef CPP_CHASE
SUBROUTINE init_chase(mpi,DIMENSION,atoms,kpts,noco,l_real)
USE m_types_mpimat
USE m_types
USE m_types_mpi
......@@ -90,11 +102,18 @@ IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_noco), INTENT(IN) :: noco
LOGICAL, INTENT(IN) :: l_real
INTEGER :: nevd, nexd
CHARACTER(len=1000)::arg
scale_distance=1E-3
IF (judft_was_argument("-chase_scale")) THEN
arg=juDFT_string_for_argument("-chase_scale")
READ(arg,*) scale_distance
ENDIF
IF (juDFT_was_argument("-diag:chase")) THEN
nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
......@@ -204,10 +223,10 @@ IMPLICIT NONE
end do
end do
if(iter.EQ.1) then
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-6, 'R', 'S' )
CALL chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, scale_distance, 'R', 'S' )
else
CALL read_eig(chase_eig_id,ikpt,jsp,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-6, 'A', 'S' )
CALL chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, tol, 'A', 'S' )
end if
ne = nev
......@@ -259,10 +278,10 @@ IMPLICIT NONE
end do
if(iter.EQ.1) then
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-6, 'R', 'S' )
CALL chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, scale_distance, 'R', 'S' )
else
CALL read_eig(chase_eig_id,ikpt,jsp,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-6, 'A', 'S' )
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, tol, 'A', 'S' )
end if
ne = nev
......@@ -313,8 +332,11 @@ IMPLICIT NONE
TYPE(t_mat) :: zMatTemp
TYPE(t_mpimat) :: chase_mat
REAL, ALLOCATABLE :: eigenvalues(:)
REAL :: t1,t2,t3,t4
include 'mpif.h'
CALL CPU_TIME(t1)
CALL MPI_COMM_RANK(hmat%mpi_com,myid,info)
CALL MPI_COMM_SIZE(hmat%mpi_com,np,info)
smat%blacs_desc=hmat%blacs_desc
......@@ -361,17 +383,25 @@ IMPLICIT NONE
IF (hmat%l_real) THEN
IF(iter.EQ.1) THEN
CALL mpi_chase_r(chase_mat%data_r, zMatTemp%data_r, eigenvalues, 25, 1e-10, 'R', 'S' )
CALL CPU_TIME(t2)
CALL mpi_chase_r(chase_mat%data_r, zMatTemp%data_r, eigenvalues, 25, 1E-4, 'R', 'S' )
CALL CPU_TIME(t3)
ELSE
CALL read_eig(chase_eig_id,ikpt,jsp,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
CALL mpi_chase_r(chase_mat%data_r, zMatTemp%data_r, eigenvalues, 25, 1e-10, 'A', 'S' )
CALL CPU_TIME(t2)
CALL mpi_chase_r(chase_mat%data_r, zMatTemp%data_r, eigenvalues, 25, tol, 'A', 'S' )
CALL CPU_TIME(t3)
END IF
ELSE
IF(iter.EQ.1) THEN
CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, 1e-10, 'R', 'S' )
CALL CPU_TIME(t2)
CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, 1E-4, 'R', 'S' )
CALL CPU_TIME(t3)
ELSE
CALL read_eig(chase_eig_id,ikpt,jsp,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, 1e-10, 'A', 'S' )
CALL CPU_TIME(t2)
CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, tol, 'A', 'S' )
CALL CPU_TIME(t3)
END IF
ENDIF
......@@ -408,6 +438,16 @@ IMPLICIT NONE
ne=ne+1
eig(ne)=eigenvalues(i)
ENDDO
CALL CPU_TIME(t4)
IF (myid==0) THEN
PRINT *,"Chase Prep:",t2-t1
PRINT *,"Chase Call:",t3-t2
PRINT *,"Chase Post:",t4-t3
PRINT *,"Chase Total:",t4-t1
ENDIF
END SUBROUTINE chase_diag_MPI
SUBROUTINE priv_init_chasempimat(hmat,mat,nev,nex)
......
external/chase/src/FLEUR/fleur_chase.cpp
View file @ ed8a3553
......@@ -127,10 +127,6 @@ void chase_solve(T* H, T* V, Base<T>* ritzv, int* deg, double* tol, char* mode,
auto nev = config.GetNev();
auto nex = config.GetNex();
if (!config.UseApprox())
for (std::size_t k = 0; k < N * (nev + nex); ++k)
V[k] = getRandomT<T>([&]() { return d(gen); });
for (std::size_t k = 0; k < xlen * ylen; ++k) H_[k] = H[k];
config.SetTol(*tol);
......@@ -138,6 +134,12 @@ void chase_solve(T* H, T* V, Base<T>* ritzv, int* deg, double* tol, char* mode,
config.SetOpt(*opt == 'S');
config.SetApprox(*mode == 'A');
if (!config.UseApprox()){
std::cerr << "random vectors" << std::endl;
for (std::size_t k = 0; k < N * (nev + nex); ++k)
V[k] = getRandomT<T>([&]() { return d(gen); });
}
chase::Solve(&single);
}
......
main/fleur.F90
View file @ ed8a3553
......@@ -193,6 +193,8 @@ CONTAINS
ENDIF !mpi%irank.eq.0
input%total = .TRUE.
CALL chase_distance(results%last_distance)
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,inDen)
#endif
......
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