Chase for MPI should be working now...

diagonalization/chase_diag.F90

@@ -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,7 +356,7 @@ 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
@@ -379,28 +379,21 @@ IMPLICIT NONE
     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

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