Unifying use of blacs processor grid

diagonalization/elpa.F90

@@ -47,7 +47,7 @@ CONTAINS
     INCLUDE 'mpif.h'
     !...  Local variables
     !
-    INTEGER           :: num,num2,myrow,mycol
+    INTEGER           :: num,num2
     INTEGER           :: nb, myid, np
     INTEGER           :: n_col, n_row
     LOGICAL           :: ok
@@ -77,18 +77,16 @@ CONTAINS
     CALL MPI_BARRIER(hmat%blacsdata%mpi_com,err)    
     CALL MPI_COMM_RANK(hmat%blacsdata%mpi_com,myid,err)
     CALL MPI_COMM_SIZE(hmat%blacsdata%mpi_com,np,err)
-    myrow = myid/hmat%blacsdata%npcol
-    mycol = myid -(myid/hmat%blacsdata%npcol)*hmat%blacsdata%npcol  
-
+   
 
     !Create communicators for ELPA
 #if defined (CPP_ELPA_201705003)
     mpi_comm_rows = -1
     mpi_comm_cols = -1
 #elif defined (CPP_ELPA_201605004) || defined (CPP_ELPA_201605003)||defined(CPP_ELPA_NEW)
-    err=get_elpa_row_col_comms(hmat%blacsdata%mpi_com, myrow, mycol,mpi_comm_rows, mpi_comm_cols)
+    err=get_elpa_row_col_comms(hmat%blacsdata%mpi_com, hmat%blacsdata%myrow, hmat%blacsdata%mycol,mpi_comm_rows, mpi_comm_cols)
 #else
-    CALL get_elpa_row_col_comms(hmat%blacsdata%mpi_com, myrow, mycol,mpi_comm_rows, mpi_comm_cols)
+    CALL get_elpa_row_col_comms(hmat%blacsdata%mpi_com, hmat%blacsdata%myrow, hmat%blacsdata%mycol,mpi_comm_rows, mpi_comm_cols)
 #endif
     !print *,"creating ELPA comms  --  done"
 
@@ -119,8 +117,8 @@ CONTAINS
     CALL elpa_obj%set("local_ncols", hmat%matsize2, err)
     CALL elpa_obj%set("nblk", nb, err)
     CALL elpa_obj%set("mpi_comm_parent", hmat%blacsdata%mpi_com, err)
-    CALL elpa_obj%set("process_row", myrow, err)
-    CALL elpa_obj%set("process_col", mycol, err)
+    CALL elpa_obj%set("process_row", hmat%blacsdata%myrow, err)
+    CALL elpa_obj%set("process_col", hmat%blacsdata%mycol, err)
 #ifdef CPP_ELPA2
     CALL elpa_obj%set("solver", ELPA_SOLVER_2STAGE)
 #else
@@ -188,8 +186,8 @@ CONTAINS
     DO i=1,hmat%matsize2
        ! Get global column corresponding to i and number of local rows up to
        ! and including the diagonal, these are unchanged in H
-       n_col = indxl2g(i,     nb, mycol, 0, hmat%blacsdata%npcol)
-       n_row = numroc (n_col, nb, myrow, 0, hmat%blacsdata%nprow)
+       n_col = indxl2g(i,     nb, hmat%blacsdata%mycol, 0, hmat%blacsdata%npcol)
+       n_row = numroc (n_col, nb, hmat%blacsdata%myrow, 0, hmat%blacsdata%nprow)
        IF (hmat%l_real) THEN
           hmat%data_r(n_row+1:hmat%matsize1,i) = 0.d0 
        ELSE
@@ -210,8 +208,8 @@ CONTAINS
     DO i=1,hmat%matsize2
        ! Get global column corresponding to i and number of local rows up to
        ! and including the diagonal, these are unchanged in H
-       n_col = indxl2g(i,     nb, mycol, 0, hmat%blacsdata%npcol)
-       n_row = numroc (n_col, nb, myrow, 0, hmat%blacsdata%nprow)
+       n_col = indxl2g(i,     nb, hmat%blacsdata%mycol, 0, hmat%blacsdata%npcol)
+       n_row = numroc (n_col, nb, hmat%blacsdata%myrow, 0, hmat%blacsdata%nprow)
        IF (hmat%l_real) THEN
           hmat%data_r(n_row+1:hmat%matsize1,i) = ev_dist%data_r(n_row+1:ev_dist%matsize1,i)
        ELSE
@@ -317,8 +315,8 @@ CONTAINS
     DO i=1,hmat%matsize2
        ! Get global column corresponding to i and number of local rows up to
        ! and including the diagonal, these are unchanged in A
-       n_col = indxl2g(i,     nb, mycol, 0, hmat%blacsdata%npcol)
-       n_row = numroc (n_col, nb, myrow, 0, hmat%blacsdata%nprow)
+       n_col = indxl2g(i,     nb, hmat%blacsdata%mycol, 0, hmat%blacsdata%npcol)
+       n_row = numroc (n_col, nb, hmat%blacsdata%myrow, 0, hmat%blacsdata%nprow)
        IF (hmat%l_real) THEN
           hmat%data_r(n_row+1:hmat%matsize1,i) = ev_dist%data_r(n_row+1:ev_dist%matsize1,i)
        ELSE

types/types_mpimat.F90

@@ -28,6 +28,7 @@ MODULE m_types_mpimat
      !> 7,8: row/colum of grid for first row/colum of matrix
      !> 9: leading dimension of local matrix
      INTEGER:: npcol,nprow                     !> the number of columns/rows in the processor grid
+     INTEGER:: mycol,myrow
   END TYPE t_blacsdata
   
   
@@ -91,7 +92,7 @@ CONTAINS
   SUBROUTINE generate_full_matrix(mat)
     CLASS(t_mpimat),INTENT(INOUT) ::mat
     
-    INTEGER :: i,j,i_glob,j_glob,npcol,nprow,myid,err,myrow,mycol,np
+    INTEGER :: i,j,i_glob,j_glob,myid,err,np
     COMPLEX,ALLOCATABLE:: tmp_c(:,:)
     REAL,ALLOCATABLE   :: tmp_r(:,:)
 #ifdef CPP_SCALAPACK
@@ -100,16 +101,14 @@ CONTAINS
 
     CALL MPI_COMM_RANK(mat%blacsdata%mpi_com,myid,err)
     CALL MPI_COMM_SIZE(mat%blacsdata%mpi_com,np,err)
- 
-    CALL blacs_gridinfo(mat%blacsdata%blacs_desc(2),nprow,npcol,myrow,mycol)
     !Set lower part of matrix to zero
  
     DO i=1,mat%matsize1
        DO j=1,mat%matsize2
           ! Get global column corresponding to i and number of local rows up to
           ! and including the diagonal, these are unchanged in A
-          i_glob = indxl2g(i,     mat%blacsdata%blacs_desc(5), myrow, 0, nprow)
-          j_glob = indxl2g(j,     mat%blacsdata%blacs_desc(6), mycol, 0, npcol)
+          i_glob = indxl2g(i,     mat%blacsdata%blacs_desc(5), mat%blacsdata%myrow, 0, mat%blacsdata%nprow)
+          j_glob = indxl2g(j,     mat%blacsdata%blacs_desc(6), mat%blacsdata%mycol, 0, mat%blacsdata%npcol)
 
           IF (i_glob>j_glob) THEN
              IF (mat%l_real) THEN
@@ -299,9 +298,7 @@ CONTAINS
     mat%blacsdata%no_use=1
     mat%blacsdata%mpi_com=mpi_subcom
     CALL priv_create_blacsgrid(mat%blacsdata%mpi_com,l_2d,matsize1,matsize2,nbx,nby,&
-         mat%blacsdata%blacs_desc,&
-         mat%matsize1,mat%matsize2,&
-         mat%blacsdata%npcol,mat%blacsdata%nprow)
+         mat%blacsdata,mat%matsize1,mat%matsize2)
     CALL mat%alloc(l_real) !Attention,sizes determined in call to priv_create_blacsgrid
     !check if this matrix is actually distributed over MPI_COMM_SELF
     IF (mpi_subcom==MPI_COMM_SELF) THEN
@@ -333,21 +330,20 @@ CONTAINS
   END SUBROUTINE mpimat_init_template
 
     
-  SUBROUTINE priv_create_blacsgrid(mpi_subcom,l_2d,m1,m2,nbc,nbr,sc_desc,local_size1,local_size2,nprow,npcol)
+  SUBROUTINE priv_create_blacsgrid(mpi_subcom,l_2d,m1,m2,nbc,nbr,blacsdata,local_size1,local_size2)
     IMPLICIT NONE
     INTEGER,INTENT(IN) :: mpi_subcom
     INTEGER,INTENT(IN) :: m1,m2
     INTEGER,INTENT(INOUT)::nbc,nbr
     LOGICAL,INTENT(IN) :: l_2d
-    INTEGER,INTENT(OUT):: sc_desc(:)
+    type(t_blacsdata),INTENT(OUT)::blacsdata
     INTEGER,INTENT(OUT):: local_size1,local_size2
-    INTEGER,INTENT(OUT):: npcol,nprow
    
 #ifdef CPP_MPI
     INCLUDE 'mpif.h'
-    INTEGER     :: myrowssca,mycolssca,myrow,mycol
+    INTEGER     :: myrowssca,mycolssca
     INTEGER     :: iamblacs,npblacs,np,myid
-    INTEGER     :: nprow2,npcol2,myrowblacs,mycolblacs
+    INTEGER     :: nprow2,npcol2
     INTEGER     :: k,i,j,ictextblacs
     INTEGER     :: ierr
 
@@ -366,34 +362,34 @@ CONTAINS
     IF (l_2d) THEN
        distloop: DO j=INT(SQRT(REAL(np))),1,-1
           IF ( (np/j) * j == np) THEN
-             npcol = np/j
-             nprow = j
+             blacsdata%npcol = np/j
+             blacsdata%nprow = j
              EXIT distloop
           ENDIF
        ENDDO distloop
     ELSE
        nbc=1
        nbr=MAX(m1,m2)
-       npcol=np
-       nprow=1
+       blacsdata%npcol=np
+       blacsdata%nprow=1
     ENDIF
-    ALLOCATE(iblacsnums(np),ihelp(np),iusermap(nprow,npcol))
+    ALLOCATE(iblacsnums(np),ihelp(np),iusermap(blacsdata%nprow,blacsdata%npcol))
 
-    !   An nprow*npcol processor grid will be created
+    !   An blacsdata%nprow*blacsdata%npcol processor grid will be created
     !   Row and column index myrow, mycol of this processor in the grid
     !   and distribution of A and B in ScaLAPACK
     !   The local processor will get myrowssca rows and mycolssca columns
     !   of A and B
     !
 
-    myrow = myid/npcol  ! my row number in the BLACS nprow*npcol grid
-    mycol = myid -(myid/npcol)*npcol  ! my column number in the BLACS nprow*npcol grid
+    myrow = myid/blacsdata%npcol  ! my row number in the BLACS blacsdata%nprow*blacsdata%npcol grid
+    mycol = myid -(myid/blacsdata%npcol)*blacsdata%npcol  ! my column number in the BLACS blacsdata%nprow*blacsdata%npcol grid
     !
     !  Now allocate Asca to put the elements of Achi or receivebuffer to
     !
-    myrowssca=(m1-1)/(nbr*nprow)*nbr+ MIN(MAX(m1-(m1-1)/(nbr*nprow)*nbr*nprow-nbr*myrow,0),nbr)
+    myrowssca=(m1-1)/(nbr*blacsdata%nprow)*nbr+ MIN(MAX(m1-(m1-1)/(nbr*blacsdata%nprow)*nbr*blacsdata%nprow-nbr*myrow,0),nbr)
     !     Number of rows the local process gets in ScaLAPACK distribution
-    mycolssca=(m2-1)/(nbc*npcol)*nbc+ MIN(MAX(m2-(m2-1)/(nbc*npcol)*nbc*npcol-nbc*mycol,0),nbc)
+    mycolssca=(m2-1)/(nbc*blacsdata%npcol)*nbc+ MIN(MAX(m2-(m2-1)/(nbc*blacsdata%npcol)*nbc*blacsdata%npcol-nbc*mycol,0),nbc)
   
 
     !Get BLACS ranks for all MPI ranks
@@ -407,8 +403,8 @@ CONTAINS
 
     !     iblacsnums(i) is the BLACS-process number of MPI-process i-1
     k = 1
-    DO i = 1, nprow
-       DO j = 1, npcol
+    DO i = 1, blacsdata%nprow
+       DO j = 1, blacsdata%npcol
           iusermap(i,j) = iblacsnums(k)
           k = k + 1
        ENDDO
@@ -416,23 +412,23 @@ CONTAINS
     !Get the Blacs default context
     CALL BLACS_GET(0,0,ictextblacs)
     ! Create the Grid
-    CALL BLACS_GRIDMAP(ictextblacs,iusermap,nprow,nprow,npcol)
+    CALL BLACS_GRIDMAP(ictextblacs,iusermap,size(iusermap,1),blacsdata%nprow,blacsdata%npcol)
     !     Now control, whether the BLACS grid is the one we wanted
-    CALL BLACS_GRIDINFO(ictextblacs, nprow2,npcol2,myrowblacs,mycolblacs)
-    IF (nprow2 /= nprow) THEN
+    CALL BLACS_GRIDINFO(ictextblacs, nprow2,npcol2,blacsdata%myrow,blacsdata%mycol)
+    IF (nprow2 /= blacsdata%nprow) THEN
        WRITE(6,*) 'Wrong number of rows in BLACS grid'
-       WRITE(6,*) 'nprow=',nprow,' nprow2=',nprow2
+       WRITE(6,*) 'nprow=',blacsdata%nprow,' nprow2=',nprow2
        call judft_error('Wrong number of rows in BLACS grid')
     ENDIF
-    IF (npcol2 /= npcol) THEN
+    IF (npcol2 /= blacsdata%npcol) THEN
        WRITE(6,*) 'Wrong number of columns in BLACS grid'
-       WRITE(6,*) 'npcol=',npcol,' npcol2=',npcol2
+       WRITE(6,*) 'npcol=',blacsdata%npcol,' npcol2=',npcol2
        call judft_error('Wrong number of columns in BLACS grid')
 
     ENDIF
 
     !Create the descriptors
-    CALL descinit(sc_desc,m1,m2,nbr,nbc,0,0,ictextblacs,myrowssca,ierr)
+    CALL descinit(blacsdata%blacs_desc,m1,m2,nbr,nbc,0,0,ictextblacs,myrowssca,ierr)
     IF (ierr /=0 ) call judft_error('Creation of BLACS descriptor failed')
     local_size1=myrowssca
     local_size2=mycolssca