Commit d5e6c308 by 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!