From 55d11190841521ccbcd0f99eb8081c2da3daadff Mon Sep 17 00:00:00 2001 From: Daniel Wortmann Date: Fri, 7 Sep 2018 14:31:13 +0200 Subject: [PATCH] Chase for MPI should be working now... --- diagonalization/chase_diag.F90 | 41 ++++++++++++++-------------------- types/types_mpimat.F90 | 25 ++++++++++++++++++++- 2 files changed, 41 insertions(+), 25 deletions(-) diff --git a/diagonalization/chase_diag.F90 b/diagonalization/chase_diag.F90 index fbef30c4..9bd3f61c 100644 --- a/diagonalization/chase_diag.F90 +++ b/diagonalization/chase_diag.F90 @@ -298,7 +298,7 @@ IMPLICIT NONE !Simple driver to solve Generalized Eigenvalue Problem using the ChASE library IMPLICIT NONE - TYPE(t_mpimat), INTENT(INOUT) :: hmat,smat + TYPE(t_mpimat), INTENT(INOUT) :: hmat,smat INTEGER, INTENT(IN) :: ikpt INTEGER, INTENT(IN) :: jsp INTEGER, INTENT(IN) :: iter @@ -310,7 +310,7 @@ IMPLICIT NONE INTEGER :: info,myid,np REAL :: scale !scaling of eigenvalues from scalapack - CLASS(t_mat), ALLOCATABLE :: zMatTemp + TYPE(t_mat) :: zMatTemp TYPE(t_mpimat) :: chase_mat REAL, ALLOCATABLE :: eigenvalues(:) include 'mpif.h' @@ -356,9 +356,9 @@ IMPLICIT NONE CALL chase_mat%generate_full_matrix() ALLOCATE(eigenvalues(nev+nex)) eigenvalues = 0.0 - ALLOCATE(t_mpimat::zmatTemp) + !ALLOCATE(t_mpimat::zmatTemp) CALL zMatTemp%init(hmat%l_real,hmat%global_size1,nev+nex,MPI_COMM_SELF,.TRUE.) !Generate a pseudo-distributed matrix - + 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' ) @@ -374,33 +374,26 @@ IMPLICIT NONE CALL mpi_chase_c(chase_mat%data_c, zMatTemp%data_c, eigenvalues, 25, 1e-10, 'A', 'S' ) END IF ENDIF - + ne = nev IF (myid==0) CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,& eigenvalues(:(nev+nex)),zmat=zMatTemp) - !Back-Transform + CALL hmat%from_non_dist(zmattemp) + call zmatTemp%free() + + ! --> recover the generalized eigenvectors z by solving z' = l^t * z IF (smat%l_real) THEN - CALL PDTRTRI('U','N',smat%global_size1,smat%data_r,1,1,smat%blacs_desc,info) - CALL PDGEMM('N','N',smat%global_size1,smat%global_size1,smat%global_size1,1.0,smat%data_r,1,1,smat%blacs_desc,zmatTemp%data_r,1,1,zmattemp%blacs_desc,0.0,hmat%data_r,1,1,hmat%blacs_desc) + CALL pdtrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_r,1,1,smat%blacs_desc,& + hmat%data_r,1,1,smat%blacs_desc,info) ELSE - STOP 'chase no complex' + CALL pztrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_c,1,1,smat%blacs_desc,& + hmat%data_c,1,1,smat%blacs_desc,info) + END IF + IF (info.NE.0) THEN + WRITE (6,*) 'Error in p?trtrs: info =',info + CALL juDFT_error("Diagonalization failed",calledby="chase_diag") ENDIF -!!$ CALL hmat%copy(zmatTemp,1,1) !Copy matrix into distributed form -!!$ call zmatTemp%free() -!!$ -!!$ ! --> recover the generalized eigenvectors z by solving z' = l^t * z -!!$ IF (smat%l_real) THEN -!!$ CALL pdtrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_r,1,1,smat%blacs_desc,& -!!$ hmat%data_r,1,1,smat%blacs_desc,info) -!!$ ELSE -!!$ CALL pztrtrs('U','N','N',hmat%global_size1,hmat%global_size1,smat%data_c,1,1,smat%blacs_desc,& -!!$ hmat%data_c,1,1,smat%blacs_desc,info) -!!$ END IF -!!$ IF (info.NE.0) THEN -!!$ WRITE (6,*) 'Error in p?trtrs: info =',info -!!$ CALL juDFT_error("Diagonalization failed",calledby="chase_diag") -!!$ ENDIF ! Redistribute eigvec from ScaLAPACK distribution to each process ! having all eigenvectors corresponding to his eigenvalues as above diff --git a/types/types_mpimat.F90 b/types/types_mpimat.F90 index 4c023424..0ff793a9 100644 --- a/types/types_mpimat.F90 +++ b/types/types_mpimat.F90 @@ -34,6 +34,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 END TYPE t_mpimat @@ -198,7 +199,7 @@ CONTAINS SELECT TYPE(mat1) TYPE IS(t_mpimat) IF (mat%l_real) THEN - CALL pdgemr2d(mat1%global_size1,mat1%global_size2,mat1%data_r,1,1,mat1%blacs_desc,mat%data_r,n1,n2,mat%blacs_desc,mat%blacs_ctext) + CALL pdgemr2d(Mat1%global_size1,mat1%global_size2,mat1%data_r,1,1,mat1%blacs_desc,mat%data_r,n1,n2,mat%blacs_desc,mat%blacs_ctext) ELSE CALL pzgemr2d(mat1%global_size1,mat1%global_size2,mat1%data_c,1,1,mat1%blacs_desc,mat%data_c,n1,n2,mat%blacs_desc,mat%blacs_ctext) END IF @@ -208,6 +209,28 @@ CONTAINS #endif END SUBROUTINE mpimat_copy + SUBROUTINE from_non_dist(mat,mat1) + IMPLICIT NONE + CLASS(t_mpimat),INTENT(INOUT)::mat + TYPE(t_mat),INTENT(IN) ::mat1 + + INTEGER:: blacs_desc(9),irank,ierr,umap(1,1),np + + blacs_desc=(/1,-1,mat1%matsize1,mat1%matsize2,mat1%matsize1,mat1%matsize2,0,0,mat1%matsize1/) + + CALL MPI_COMM_RANK(mat%mpi_com,irank,ierr) + umap(1,1)=0 + CALL BLACS_GET(mat%blacs_ctext,10,blacs_desc(2)) + CALL BLACS_GRIDMAP(blacs_desc(2),umap,1,1,1) + IF (mat%l_real) THEN + CALL pdgemr2d(Mat1%matsize1,mat1%matsize2,mat1%data_r,1,1,blacs_desc,mat%data_r,1,1,mat%blacs_desc,mat%blacs_ctext) + ELSE + CALL pzgemr2d(mat1%matsize1,mat1%matsize2,mat1%data_c,1,1,blacs_desc,mat%data_c,1,1,mat%blacs_desc,mat%blacs_ctext) + END IF + END SUBROUTINE from_non_dist + + + SUBROUTINE mpimat_move(mat,mat1) IMPLICIT NONE CLASS(t_mpimat),INTENT(INOUT)::mat -- GitLab