Commit d5e6c308 authored by Matthias Redies's avatar Matthias Redies

merge daniels fixes

parents a1f07339 37c97a93
......@@ -111,18 +111,8 @@ CONTAINS
ENDDO
ENDDO
END DO
!Now add diagonal contribution to matrices
IF (jsp<3) THEN
DO l = 0,atoms%lmax(n)
DO m = -l,l
lm = l* (l+1) + m
lmplm = (lm* (lm+3))/2
td%tuu(lmplm,n,jsp)=td%tuu(lmplm,n,jsp) + enpara%el0(l,n,jsp)
td%tdd(lmplm,n,jsp)=td%tdd(lmplm,n,jsp) + enpara%el0(l,n,jsp)*ud%ddn(l,n,jsp)
td%tud(lmplm,n,jsp)=td%tud(lmplm,n,jsp) + 0.5
td%tdu(lmplm,n,jsp)=td%tdu(lmplm,n,jsp) + 0.5
ENDDO
ENDDO
!Create Cholesky decomposition of local hamiltonian
!---> Add diagonal terms to make matrix positive definite
......@@ -155,6 +145,19 @@ CONTAINS
ENDIF
ENDIF
ENDDO cholesky_loop
!Now add diagonal contribution to matrices
IF (jsp<3) THEN
DO l = 0,atoms%lmax(n)
DO m = -l,l
lm = l* (l+1) + m
lmplm = (lm* (lm+3))/2
td%tuu(lmplm,n,jsp)=td%tuu(lmplm,n,jsp) + enpara%el0(l,n,jsp)
td%tdd(lmplm,n,jsp)=td%tdd(lmplm,n,jsp) + enpara%el0(l,n,jsp)*ud%ddn(l,n,jsp)
td%tud(lmplm,n,jsp)=td%tud(lmplm,n,jsp) + 0.5
td%tdu(lmplm,n,jsp)=td%tdu(lmplm,n,jsp) + 0.5
ENDDO
ENDDO
ENDIF
ENDDO
!$OMP END PARALLEL DO
IF (noco%l_constr) CALL tlmplm_constrained(atoms,v,enpara,input,ud,noco,td)
......
......@@ -62,16 +62,19 @@ CONTAINS
CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
END SUBROUTINE dmi_start
LOGICAL FUNCTION dmi_next_job(this,lastiter,noco)
LOGICAL FUNCTION dmi_next_job(this,lastiter,atoms,noco)
USE m_types_setup
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
LOGICAL,INTENT(IN) :: lastiter
TYPE(t_atoms),INTENT(IN) :: atoms
!Stuff that might be modified...
TYPE(t_noco),INTENT(INOUT) :: noco
INTEGER :: itype
IF (.NOT.lastiter) THEN
dmi_next_job=this%t_forcetheo%next_job(lastiter,noco)
dmi_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
RETURN
ENDIF
!OK, now we start the DMI-loop
......@@ -81,6 +84,10 @@ CONTAINS
!Now modify the noco-file
noco%qss=this%qvec(:,this%q_done)
!Modify the alpha-angles
DO iType = 1,atoms%ntype
noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_PRODUCT(noco%qss,atoms%taual(:,SUM(atoms%neq(:itype-1))+1))
END DO
IF (.NOT.this%l_io) RETURN
IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_DMI')
......
......@@ -103,13 +103,14 @@ CONTAINS
CALL this%t_forcetheo%start(potden,l_io) !call routine of basis type
END SUBROUTINE jij_start
LOGICAL FUNCTION jij_next_job(this,lastiter,noco)
LOGICAL FUNCTION jij_next_job(this,lastiter,atoms,noco)
USE m_types_setup
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_jij),INTENT(INOUT):: this
LOGICAL,INTENT(IN) :: lastiter
TYPE(t_atoms),INTENT(IN) :: atoms
!Stuff that might be modified...
TYPE(t_noco),INTENT(INOUT) :: noco
......@@ -117,7 +118,7 @@ CONTAINS
INTEGER:: n
IF (.NOT.lastiter) THEN
jij_next_job=this%t_forcetheo%next_job(lastiter,noco)
jij_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
RETURN
ENDIF
......
......@@ -61,16 +61,18 @@ CONTAINS
END SUBROUTINE mae_start
LOGICAL FUNCTION mae_next_job(this,lastiter,noco)
LOGICAL FUNCTION mae_next_job(this,lastiter,atoms,noco)
USE m_types_setup
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_mae),INTENT(INOUT):: this
LOGICAL,INTENT(IN) :: lastiter
TYPE(t_atoms),INTENT(IN) :: atoms
!Stuff that might be modified...
TYPE(t_noco),INTENT(INOUT) :: noco
IF (.NOT.lastiter) THEN
mae_next_job=this%t_forcetheo%next_job(lastiter,noco)
mae_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
RETURN
ENDIF
!OK, now we start the MAE-loop
......
......@@ -65,16 +65,19 @@ CONTAINS
END SUBROUTINE ssdisp_start
LOGICAL FUNCTION ssdisp_next_job(this,lastiter,noco)
LOGICAL FUNCTION ssdisp_next_job(this,lastiter,atoms,noco)
USE m_types_setup
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
LOGICAL,INTENT(IN) :: lastiter
TYPE(t_atoms),INTENT(IN) :: atoms
!Stuff that might be modified...
TYPE(t_noco),INTENT(INOUT) :: noco
INTEGER :: itype
IF (.NOT.lastiter) THEN
ssdisp_next_job=this%t_forcetheo%next_job(lastiter,noco)
ssdisp_next_job=this%t_forcetheo%next_job(lastiter,atoms,noco)
RETURN
ENDIF
!OK, now we start the SSDISP-loop
......@@ -84,6 +87,10 @@ CONTAINS
!Now modify the noco-file
noco%qss=this%qvec(:,this%q_done)
!Modify the alpha-angles
DO iType = 1,atoms%ntype
noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_PRODUCT(noco%qss,atoms%taual(:,SUM(atoms%neq(:itype-1))+1))
END DO
IF (.NOT.this%l_io) RETURN
IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_SSDISP')
CALL openXMLElementPoly('Forcetheorem_Loop_SSDISP',(/'Q-vec'/),(/this%q_done/))
......
......@@ -217,8 +217,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
na = 1
DO iType = 1,atoms%ntype
noco%phi = tpi_const*dot_product(noco%qss,atoms%taual(:,na))
noco%alph(iType) = noco%alphInit(iType) + noco%phi
noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_product(noco%qss,atoms%taual(:,na))
na = na + atoms%neq(iType)
END DO
END IF
......
......@@ -13,7 +13,7 @@ CONTAINS
omp_para_loc = check_omp_para()
call MPI_Reduce(omp_para_loc, omp_root_and, 1,&
MPI_LOGICAL, MPI_LAND, 0, MPI_COMM_WORLD)
MPI_LOGICAL, MPI_LAND, 0, MPI_COMM_WORLD,ierr)
if(irank == 0 .and. omp_root_and) then
write (*,*) "Parallelization OK"
......@@ -63,12 +63,13 @@ CONTAINS
use m_judft_stop
implicit none
logical :: parallel_ok
real(8) :: summe, t_omp, t_seq
integer(4) :: rank, size, ierr
real :: summe, t_omp, t_seq
integer :: rank, size, ierr
integer :: i, omp_threads
integer, parameter :: loop_end = 300000000
summe = 0.0
t_omp=0.0
!$omp parallel reduction(+: t_omp)
omp_threads = OMP_GET_NUM_THREADS()
t_omp = OMP_GET_WTIME()
......
......@@ -241,7 +241,7 @@ CONTAINS
#endif
CALL forcetheo%start(vtot,mpi%irank==0)
forcetheoloop:DO WHILE(forcetheo%next_job(iter==input%itmax,noco))
forcetheoloop:DO WHILE(forcetheo%next_job(iter==input%itmax,atoms,noco))
CALL timestart("gen. of hamil. and diag. (total)")
CALL timestart("eigen")
......
......@@ -42,11 +42,12 @@ CONTAINS
this%l_io=l_io
END SUBROUTINE forcetheo_start
LOGICAL FUNCTION forcetheo_next_job(this,lastiter,noco)
LOGICAL FUNCTION forcetheo_next_job(this,lastiter,atoms,noco)
USE m_types_setup
IMPLICIT NONE
CLASS(t_forcetheo),INTENT(INOUT):: this
LOGICAL,INTENT(IN) :: lastiter
LOGICAL,INTENT(IN) :: lastiter
TYPE(t_atoms),INTENT(IN) :: atoms
!Stuff that might be modified...
TYPE(t_noco),INTENT(INOUT) :: noco
forcetheo_next_job=this%firstloop
......
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