Commit d7334200 authored by Uliana Alekseeva's avatar Uliana Alekseeva

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

parents 289cc8b7 d8afa3fa
......@@ -171,12 +171,6 @@ CONTAINS
l_wu=.FALSE.
ne_all=DIMENSION%neigd
if (allocated(zmat)) then
CALL zmat%free()
deallocate(zmat, stat=dealloc_stat, errmsg=errmsg)
if(dealloc_stat /= 0) call juDFT_error("deallocate failed for zmat",&
hint=errmsg, calledby="eigen.F90")
endif
!Try to symmetrize matrix
CALL symmetrize_matrix(mpi,noco,kpts,nk,hmat,smat)
......@@ -199,6 +193,7 @@ CONTAINS
END IF
CALL eigen_diag(mpi,hmat,smat,nk,jsp,iter,ne_all,eig,zMat)
CALL smat%free()
CALL hmat%free()
DEALLOCATE(hmat,smat, stat=dealloc_stat, errmsg=errmsg)
......@@ -215,11 +210,11 @@ CONTAINS
#else
ne_found=ne_all
#endif
IF (.NOT.zmat%l_real) THEN
IF (.NOT.zMat%l_real) THEN
zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found))
END IF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,&
eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zMat=zMat)
neigBuffer(nk,jsp) = ne_found
#if defined(CPP_MPI)
! RMA synchronization
......@@ -235,6 +230,8 @@ CONTAINS
hint=errmsg, calledby="eigen.F90")
END IF
call zMat%free()
deallocate(zMat)
END DO k_loop
END DO ! spin loop ends
......
......@@ -98,13 +98,6 @@ CONTAINS
CALL eigen_redist_matrix(mpi,lapw,atoms,smat,smat_final)
CALL eigen_redist_matrix(mpi,lapw,atoms,hmat,hmat_final,smat_final)
DO i=1,nspins
DO j=1,nspins
call smat(i,j)%free()
call hmat(i,j)%free()
ENDDO
ENDDO
END SUBROUTINE eigen_hssetup
END MODULE m_eigen_hssetup
......@@ -352,11 +352,11 @@ CONTAINS
REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:)
! ..
! .. Local Scalars ..
REAL tnn(3), elall,fct,fct2,fjkiln,gjkiln,ddnln,ski(3)
REAL tnn(3), elall,fct,fjkiln,gjkiln,ddnln,ski(3)
REAL apw_lo1,apw_lo2,apw1,w1
COMPLEX capw1
INTEGER kii,ki,kj,l,nn,kj_end
INTEGER kii,ki,kj,l,nn
! ..
! .. Local Arrays ..
......@@ -364,7 +364,6 @@ CONTAINS
REAL fl2p1bt(0:atoms%lmaxd)
REAL qssbti(3),qssbtj(3)
REAL, ALLOCATABLE :: plegend(:,:)
REAL, ALLOCATABLE :: VecHelpS(:),VecHelpH(:)
COMPLEX, ALLOCATABLE :: cph(:)
LOGICAL apw(0:atoms%lmaxd)
......@@ -377,13 +376,12 @@ CONTAINS
fl2p1bt(l) = fl2p1(l)*0.5
END DO
!$OMP PARALLEL DEFAULT(SHARED)&
!$OMP PRIVATE(kii,ki,ski,kj,plegend,l,kj_end)&
!$OMP PRIVATE(kii,ki,ski,kj,plegend,l)&
!$OMP PRIVATE(cph,nn,tnn,fjkiln,gjkiln)&
!$OMP PRIVATE(w1,apw_lo1,apw_lo2,ddnln,elall,fct,apw1)&
!$OMP PRIVATE(capw1,VecHelpS,VecHelpH)
!$OMP PRIVATE(capw1)
ALLOCATE(cph(MAXVAL(lapw%nv)))
ALLOCATE(plegend(MAXVAL(lapw%nv),0:atoms%lmaxd))
ALLOCATE(VecHelpS(MAXVAL(lapw%nv)),VecHelpH(MAXVAL(lapw%nv)))
plegend=0.0
plegend(:,0)=1.0
qssbti=MERGE(- noco%qss/2,+ noco%qss/2,jintsp.EQ.1)
......@@ -412,9 +410,6 @@ CONTAINS
END DO
!---> update overlap and l-diagonal hamiltonian matrix
kj_end = MIN(ki,lapw%nv(iintsp))
VecHelpS = 0.d0
VecHelpH = 0.d0
DO l = 0,atoms%lmax(n)
fjkiln = fj(ki,l,jintsp)
gjkiln = gj(ki,l,jintsp)
......@@ -435,10 +430,10 @@ CONTAINS
DO kj = 1,ki
fct = plegend(kj,l)*fl2p1(l)*&
( fjkiln*fj(kj,l,iintsp) + gjkiln*gj(kj,l,iintsp)*ddnln )
fct2 = plegend(kj,l)*fl2p1bt(l) * ( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) )
smat%data_r(kj,kii)=smat%data_r(kj,kii)+REAL(cph(kj))*fct
hmat%data_r(kj,kii)=hmat%data_r(kj,kii) + REAL(cph(kj)) * ( fct * elall + fct2)
hmat%data_r(kj,kii)=hmat%data_r(kj,kii) + REAL(cph(kj)) * &
( fct * elall + plegend(kj,l) * fl2p1bt(l) *&
( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) ) )
!+APW
IF (input%l_useapw) THEN
apw1 = REAL(cph(kj)) * plegend(kj,l) * &
......@@ -448,13 +443,13 @@ CONTAINS
!-APW
ENDDO
ELSE
DO kj = 1,kj_end
fct = plegend(kj,l)*fl2p1(l)*&
DO kj = 1,MIN(ki,lapw%nv(iintsp))
fct = chi*plegend(kj,l)*fl2p1(l)*&
( fjkiln*fj(kj,l,iintsp) + gjkiln*gj(kj,l,iintsp)*ddnln )
fct2 = plegend(kj,l)*fl2p1bt(l) * ( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) )
VecHelpS(kj) = VecHelpS(kj) + fct
VecHelpH(kj) = VecHelpH(kj) + fct*elall + fct2
smat%data_c(kj,kii)=smat%data_c(kj,kii) + cph(kj)*fct
hmat%data_c(kj,kii)=hmat%data_c(kj,kii) + cph(kj) * ( fct*elall &
+ chi*plegend(kj,l)*fl2p1bt(l) * ( fjkiln*gj(kj,l,iintsp) + gjkiln*fj(kj,l,iintsp) ) )
IF (input%l_useapw) THEN
capw1 = cph(kj)*plegend(kj,l)&
......@@ -466,10 +461,6 @@ CONTAINS
ENDIF
!---> end loop over l
ENDDO
IF (.not.smat%l_real) THEN
smat%data_c(:kj_end,kii)=smat%data_c(:kj_end,kii) + chi*cph(:kj_end) * VecHelpS(:kj_end)
hmat%data_c(:kj_end,kii)=hmat%data_c(:kj_end,kii) + chi*cph(:kj_end) * VecHelpH(:kj_end)
ENDIF
!---> end loop over ki
ENDDO
!$OMP END DO
......
......@@ -46,7 +46,7 @@ MODULE m_types_mpimat
PROCEDURE,PASS :: generate_full_matrix ! construct full matrix if only upper triangle of hermitian matrix is given
PROCEDURE,PASS :: print_matrix
PROCEDURE,PASS :: from_non_dist
FINAL :: finalize
FINAL :: finalize, finalize_1d, finalize_2d, finalize_3d
END TYPE t_mpimat
PUBLIC t_mpimat
......@@ -295,6 +295,44 @@ CONTAINS
CALL mpimat_free(mat)
END SUBROUTINE finalize
SUBROUTINE finalize_1d(mat)
IMPLICIT NONE
TYPE(t_mpimat),INTENT(INOUT) :: mat(:)
INTEGER :: i
DO i = 1,size(mat)
CALL mpimat_free(mat(i))
ENDDO
END SUBROUTINE finalize_1d
SUBROUTINE finalize_2d(mat)
IMPLICIT NONE
TYPE(t_mpimat),INTENT(INOUT) :: mat(:,:)
INTEGER :: i,j
DO i = 1,size(mat, dim=1)
DO j = 1,size(mat, dim=2)
CALL mpimat_free(mat(i,j))
ENDDO
ENDDO
END SUBROUTINE finalize_2d
SUBROUTINE finalize_3d(mat)
IMPLICIT NONE
TYPE(t_mpimat),INTENT(INOUT) :: mat(:,:,:)
INTEGER :: i,j,k
DO i = 1,size(mat, dim=1)
DO j = 1,size(mat, dim=2)
DO k = 1,size(mat, dim=3)
CALL mpimat_free(mat(i,j,k))
ENDDO
ENDDO
ENDDO
END SUBROUTINE finalize_3d
SUBROUTINE mpimat_free(mat)
IMPLICIT NONE
CLASS(t_mpimat),INTENT(INOUT) :: mat
......
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