Commit f850eb0a authored by Matthias Redies's avatar Matthias Redies

merge

parents 15fddc25 643a3f97
...@@ -74,11 +74,11 @@ CONTAINS ...@@ -74,11 +74,11 @@ CONTAINS
SELECT TYPE(smat) SELECT TYPE(smat)
TYPE IS (t_mpimat) TYPE IS (t_mpimat)
CALL MPI_BARRIER(hmat%mpi_com,err) CALL MPI_BARRIER(hmat%blacsdata%mpi_com,err)
CALL MPI_COMM_RANK(hmat%mpi_com,myid,err) CALL MPI_COMM_RANK(hmat%blacsdata%mpi_com,myid,err)
CALL MPI_COMM_SIZE(hmat%mpi_com,np,err) CALL MPI_COMM_SIZE(hmat%blacsdata%mpi_com,np,err)
myrow = myid/hmat%npcol myrow = myid/hmat%blacsdata%npcol
mycol = myid -(myid/hmat%npcol)*hmat%npcol mycol = myid -(myid/hmat%blacsdata%npcol)*hmat%blacsdata%npcol
!Create communicators for ELPA !Create communicators for ELPA
...@@ -86,9 +86,9 @@ CONTAINS ...@@ -86,9 +86,9 @@ CONTAINS
mpi_comm_rows = -1 mpi_comm_rows = -1
mpi_comm_cols = -1 mpi_comm_cols = -1
#elif defined (CPP_ELPA_201605004) || defined (CPP_ELPA_201605003)||defined(CPP_ELPA_NEW) #elif defined (CPP_ELPA_201605004) || defined (CPP_ELPA_201605003)||defined(CPP_ELPA_NEW)
err=get_elpa_row_col_comms(hmat%mpi_com, myrow, mycol,mpi_comm_rows, mpi_comm_cols) err=get_elpa_row_col_comms(hmat%blacsdata%mpi_com, myrow, mycol,mpi_comm_rows, mpi_comm_cols)
#else #else
CALL get_elpa_row_col_comms(hmat%mpi_com, myrow, mycol,mpi_comm_rows, mpi_comm_cols) CALL get_elpa_row_col_comms(hmat%blacsdata%mpi_com, myrow, mycol,mpi_comm_rows, mpi_comm_cols)
#endif #endif
!print *,"creating ELPA comms -- done" !print *,"creating ELPA comms -- done"
...@@ -97,7 +97,7 @@ CONTAINS ...@@ -97,7 +97,7 @@ CONTAINS
ALLOCATE ( eig2(hmat%global_size1), stat=err ) ! The eigenvalue array for ScaLAPACK ALLOCATE ( eig2(hmat%global_size1), stat=err ) ! The eigenvalue array for ScaLAPACK
IF (err.NE.0) CALL juDFT_error('Failed to allocated "eig2"', calledby ='elpa') IF (err.NE.0) CALL juDFT_error('Failed to allocated "eig2"', calledby ='elpa')
CALL ev_dist%init(hmat%l_real,hmat%global_size1,hmat%global_size2,hmat%mpi_com,.TRUE.)! Eigenvectors for ScaLAPACK CALL ev_dist%init(hmat)! Eigenvectors for ScaLAPACK
IF (err.NE.0) CALL juDFT_error('Failed to allocated "ev_dist"',calledby ='elpa') IF (err.NE.0) CALL juDFT_error('Failed to allocated "ev_dist"',calledby ='elpa')
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
...@@ -107,12 +107,10 @@ CONTAINS ...@@ -107,12 +107,10 @@ CONTAINS
ENDIF ENDIF
IF (err.NE.0) CALL juDFT_error('Failed to allocated "tmp2"', calledby ='elpa') IF (err.NE.0) CALL juDFT_error('Failed to allocated "tmp2"', calledby ='elpa')
smat%blacs_desc=hmat%blacs_desc
ev_dist%blacs_desc=hmat%blacs_desc
nb=hmat%blacs_desc(5)! Blocking factor nb=hmat%blacsdata%blacs_desc(5)! Blocking factor
IF (nb.NE.hmat%blacs_desc(6)) CALL judft_error("Different block sizes for rows/columns not supported") IF (nb.NE.hmat%blacsdata%%blacs_desc(6)) CALL judft_error("Different block sizes for rows/columns not supported")
#ifdef CPP_ELPA_201705003 #ifdef CPP_ELPA_201705003
CALL elpa_obj%set("na", hmat%global_size1, err) CALL elpa_obj%set("na", hmat%global_size1, err)
...@@ -120,7 +118,7 @@ CONTAINS ...@@ -120,7 +118,7 @@ CONTAINS
CALL elpa_obj%set("local_nrows", hmat%matsize1, err) CALL elpa_obj%set("local_nrows", hmat%matsize1, err)
CALL elpa_obj%set("local_ncols", hmat%matsize2, err) CALL elpa_obj%set("local_ncols", hmat%matsize2, err)
CALL elpa_obj%set("nblk", nb, err) CALL elpa_obj%set("nblk", nb, err)
CALL elpa_obj%set("mpi_comm_parent", hmat%mpi_com, 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_row", myrow, err)
CALL elpa_obj%set("process_col", mycol, err) CALL elpa_obj%set("process_col", mycol, err)
#ifdef CPP_ELPA2 #ifdef CPP_ELPA2
...@@ -202,10 +200,10 @@ CONTAINS ...@@ -202,10 +200,10 @@ CONTAINS
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
CALL pdtran(hmat%global_size1,hmat%global_size1,1.d0,hmat%data_r,1,1,& CALL pdtran(hmat%global_size1,hmat%global_size1,1.d0,hmat%data_r,1,1,&
hmat%blacs_desc,0.d0,ev_dist%data_r,1,1,ev_dist%blacs_desc) hmat%blacs_desc,0.d0,ev_dist%data_r,1,1,ev_dist%blacsdata%%blacs_desc)
ELSE ELSE
CALL pztranc(hmat%global_size1,hmat%global_size2,cmplx(1.d0,0.d0),hmat%data_c,1,1,& CALL pztranc(hmat%global_size1,hmat%global_size2,cmplx(1.d0,0.d0),hmat%data_c,1,1,&
hmat%blacs_desc,cmplx(0.d0,0.d0),ev_dist%data_c,1,1,ev_dist%blacs_desc) hmat%blacs_desc,cmplx(0.d0,0.d0),ev_dist%data_c,1,1,ev_dist%blacsdata%%blacs_desc)
ENDIF ENDIF
...@@ -261,10 +259,10 @@ CONTAINS ...@@ -261,10 +259,10 @@ CONTAINS
! 2b. tmp2 = eigvec**T ! 2b. tmp2 = eigvec**T
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
CALL pdtran(ev_dist%global_size1,ev_dist%global_size1,1.d0,ev_dist%data_r,1,1,& CALL pdtran(ev_dist%global_size1,ev_dist%global_size1,1.d0,ev_dist%data_r,1,1,&
ev_dist%blacs_desc,0.d0,tmp2_r,1,1,ev_dist%blacs_desc) ev_dist%blacsdata%blacs_desc,0.d0,tmp2_r,1,1,ev_dist%blacsdata%blacs_desc)
ELSE ELSE
CALL pztranc(ev_dist%global_size1,ev_dist%global_size1,cmplx(1.0,0.0),ev_dist%data_c,1,1,& CALL pztranc(ev_dist%global_size1,ev_dist%global_size1,cmplx(1.0,0.0),ev_dist%data_c,1,1,&
ev_dist%blacs_desc,cmplx(0.d0,0.d0),tmp2_c,1,1,ev_dist%blacs_desc) ev_dist%blacsdata%blacs_desc,cmplx(0.d0,0.d0),tmp2_c,1,1,ev_dist%blacsdata%blacs_desc)
ENDIF ENDIF
! 2c. A = U**-T * tmp2 ( = U**-T * Aorig * U**-1 ) ! 2c. A = U**-T * tmp2 ( = U**-T * Aorig * U**-1 )
...@@ -309,18 +307,18 @@ CONTAINS ...@@ -309,18 +307,18 @@ CONTAINS
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
CALL pdtran(hmat%global_size1,hmat%global_size1,1.d0,hmat%data_r,1,1,& CALL pdtran(hmat%global_size1,hmat%global_size1,1.d0,hmat%data_r,1,1,&
hmat%blacs_desc,0.d0,ev_dist%data_r,1,1,ev_dist%blacs_desc) hmat%blacsdata%blacs_desc,0.d0,ev_dist%data_r,1,1,ev_dist%blacsdata%blacs_desc)
ELSE ELSE
CALL pztranc(hmat%global_size1,hmat%global_size1,cmplx(1.0,0.0),hmat%data_c,1,1,& CALL pztranc(hmat%global_size1,hmat%global_size1,cmplx(1.0,0.0),hmat%data_c,1,1,&
hmat%blacs_desc,cmplx(0.d0,0.d0),ev_dist%data_c,1,1,ev_dist%blacs_desc) hmat%blacsdata%blacs_desc,cmplx(0.d0,0.d0),ev_dist%data_c,1,1,ev_dist%blacsdata%blacs_desc)
ENDIF ENDIF
DO i=1,hmat%matsize2 DO i=1,hmat%matsize2
! Get global column corresponding to i and number of local rows up to ! Get global column corresponding to i and number of local rows up to
! and including the diagonal, these are unchanged in A ! and including the diagonal, these are unchanged in A
n_col = indxl2g(i, nb, mycol, 0, hmat%npcol) n_col = indxl2g(i, nb, mycol, 0, hmat%blacsdata%npcol)
n_row = numroc (n_col, nb, myrow, 0, hmat%nprow) n_row = numroc (n_col, nb, myrow, 0, hmat%blacsdata%nprow)
IF (hmat%l_real) THEN 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) hmat%data_r(n_row+1:hmat%matsize1,i) = ev_dist%data_r(n_row+1:ev_dist%matsize1,i)
ELSE ELSE
...@@ -340,10 +338,10 @@ CONTAINS ...@@ -340,10 +338,10 @@ CONTAINS
#ifdef CPP_ELPA2 #ifdef CPP_ELPA2
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
ok=solve_evp_real_2stage(hmat%global_size1,num2,hmat%data_r,hmat%matsize1,& ok=solve_evp_real_2stage(hmat%global_size1,num2,hmat%data_r,hmat%matsize1,&
eig2,ev_dist%data_r,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%mpi_com) eig2,ev_dist%data_r,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%blacsdata%mpi_com)
ELSE ELSE
ok=solve_evp_complex_2stage(hmat%global_size1,num2,hmat%data_c,hmat%matsize1,& ok=solve_evp_complex_2stage(hmat%global_size1,num2,hmat%data_c,hmat%matsize1,&
eig2,ev_dist%data_c,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%mpi_com) eig2,ev_dist%data_c,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%blacsdata%mpi_com)
ENDIF ENDIF
#else #else
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
...@@ -358,10 +356,10 @@ CONTAINS ...@@ -358,10 +356,10 @@ CONTAINS
#ifdef CPP_ELPA2 #ifdef CPP_ELPA2
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
err=solve_evp_real_2stage(hmat%global_size1,num2,hmat%data_r,hmat%matsize1,& err=solve_evp_real_2stage(hmat%global_size1,num2,hmat%data_r,hmat%matsize1,&
eig2,ev_dist%data_r,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%mpi_com) eig2,ev_dist%data_r,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%blacsdata%mpi_com)
ELSE ELSE
err=solve_evp_complex_2stage(hmat%global_size1,num2,hmat%data_c,hmat%matsize1,& err=solve_evp_complex_2stage(hmat%global_size1,num2,hmat%data_c,hmat%matsize1,&
eig2,ev_dist%data_c,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%mpi_com) eig2,ev_dist%data_c,ev_dist%matsize1, nb,ev_dist%matsize2, mpi_comm_rows, mpi_comm_cols,hmat%blacsdata%mpi_com)
ENDIF ENDIF
#else #else
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
...@@ -376,10 +374,10 @@ CONTAINS ...@@ -376,10 +374,10 @@ CONTAINS
#ifdef CPP_ELPA2 #ifdef CPP_ELPA2
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
CALL solve_evp_real_2stage(hmat%global_size1,num2,hmat%data_r,hmat%matsize1,& CALL solve_evp_real_2stage(hmat%global_size1,num2,hmat%data_r,hmat%matsize1,&
eig2,ev_dist%data_r,ev_dist%matsize1, nb, mpi_comm_rows, mpi_comm_cols,hmat%mpi_com) eig2,ev_dist%data_r,ev_dist%matsize1, nb, mpi_comm_rows, mpi_comm_cols,hmat%blacsdata%mpi_com)
ELSE ELSE
CALL solve_evp_complex_2stage(hmat%global_size1,num2,hmat%data_c,hmat%matsize1,& CALL solve_evp_complex_2stage(hmat%global_size1,num2,hmat%data_c,hmat%matsize1,&
eig2,ev_dist%data_c,ev_dist%matsize1, nb, mpi_comm_rows, mpi_comm_cols,hmat%mpi_com) eig2,ev_dist%data_c,ev_dist%matsize1, nb, mpi_comm_rows, mpi_comm_cols,hmat%blacsdata%mpi_com)
ENDIF ENDIF
#else #else
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
...@@ -398,10 +396,10 @@ CONTAINS ...@@ -398,10 +396,10 @@ CONTAINS
! mult_ah_b_complex needs the transpose of U**-1, thus tmp2 = (U**-1)**T ! mult_ah_b_complex needs the transpose of U**-1, thus tmp2 = (U**-1)**T
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
CALL pdtran(smat%global_size1,smat%global_size1,1.d0,smat%data_r,1,1,& CALL pdtran(smat%global_size1,smat%global_size1,1.d0,smat%data_r,1,1,&
smat%blacs_desc,0.d0,tmp2_r,1,1,smat%blacs_desc) smat%blacsdata%blacs_desc,0.d0,tmp2_r,1,1,smat%blacsdata%blacs_desc)
ELSE ELSE
CALL pztranc(smat%global_size1,smat%global_size1,cmplx(1.d0,0.d0),smat%data_c,1,1,& CALL pztranc(smat%global_size1,smat%global_size1,cmplx(1.d0,0.d0),smat%data_c,1,1,&
smat%blacs_desc,cmplx(0.d0,0.d0),tmp2_c,1,1,smat%blacs_desc) smat%blacsdata%blacs_desc,cmplx(0.d0,0.d0),tmp2_c,1,1,smat%blacsdata%blacs_desc)
ENDIF ENDIF
#if defined (CPP_ELPA_201705003) #if defined (CPP_ELPA_201705003)
...@@ -471,7 +469,7 @@ CONTAINS ...@@ -471,7 +469,7 @@ CONTAINS
! having all eigenvectors corresponding to his eigenvalues as above ! having all eigenvectors corresponding to his eigenvalues as above
! !
ALLOCATE(t_mpimat::ev) ALLOCATE(t_mpimat::ev)
CALL ev%init(hmat%l_real,hmat%global_size1,hmat%global_size1,hmat%mpi_com,.FALSE.) CALL ev%init(hmat%l_real,hmat%global_size1,hmat%global_size1,hmat%blacsdata%mpi_com,.FALSE.)
CALL ev%copy(hmat,1,1) CALL ev%copy(hmat,1,1)
CLASS DEFAULT CLASS DEFAULT
call judft_error("Wrong type (1) in scalapack") call judft_error("Wrong type (1) in scalapack")
......
...@@ -69,8 +69,8 @@ CONTAINS ...@@ -69,8 +69,8 @@ CONTAINS
ALLOCATE(eig2(hmat%global_size1)) ALLOCATE(eig2(hmat%global_size1))
CALL MPI_COMM_RANK(hmat%mpi_com,myid,ierr) CALL MPI_COMM_RANK(hmat%blacsdata%mpi_com,myid,ierr)
CALL MPI_COMM_SIZE(hmat%mpi_com,np,ierr) CALL MPI_COMM_SIZE(hmat%blacsdata%mpi_com,np,ierr)
num=ne !no of states solved for num=ne !no of states solved for
...@@ -84,15 +84,15 @@ CONTAINS ...@@ -84,15 +84,15 @@ CONTAINS
!ev_dist%blacs_desc=hmat%blacs_desc !ev_dist%blacs_desc=hmat%blacs_desc
nb=hmat%blacs_desc(5)! Blocking factor nb=hmat%blacsdata%blacs_desc(5)! Blocking factor
IF (nb.NE.hmat%blacs_desc(6)) CALL judft_error("Different block sizes for rows/columns not supported") IF (nb.NE.hmat%blacsdata%blacs_desc(6)) CALL judft_error("Different block sizes for rows/columns not supported")
! !
nn=MAX(MAX(hmat%global_size1,nb),2) nn=MAX(MAX(hmat%global_size1,nb),2)
np0=numroc(nn,nb,0,0,hmat%nprow) np0=numroc(nn,nb,0,0,hmat%blacsdata%nprow)
mq0=numroc(MAX(MAX(ne,nb),2),nb,0,0,hmat%npcol) mq0=numroc(MAX(MAX(ne,nb),2),nb,0,0,hmat%blacsdata%npcol)
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
lwork2=5*hmat%global_size1+MAX(5*nn,np0*mq0+2*nb*nb)+ iceil(ne,hmat%nprow*hmat%npcol)*nn lwork2=5*hmat%global_size1+MAX(5*nn,np0*mq0+2*nb*nb)+ iceil(ne,hmat%blacsdata%nprow*hmat%blacsdata%npcol)*nn
ALLOCATE ( work2_r(lwork2+10*hmat%global_size1), stat=err ) ! Allocate more in case of clusters ALLOCATE ( work2_r(lwork2+10*hmat%global_size1), stat=err ) ! Allocate more in case of clusters
ELSE ELSE
lwork2=hmat%global_size1+MAX(nb*(np0+1),3) lwork2=hmat%global_size1+MAX(nb*(np0+1),3)
...@@ -103,7 +103,7 @@ CONTAINS ...@@ -103,7 +103,7 @@ CONTAINS
CALL juDFT_error('Failed to allocated "work2"', calledby ='chani') CALL juDFT_error('Failed to allocated "work2"', calledby ='chani')
ENDIF ENDIF
liwork=6*MAX(MAX(hmat%global_size1,hmat%nprow*hmat%npcol+1),4) liwork=6*MAX(MAX(hmat%global_size1,hmat%blacsdata%nprow*hmat%blacsdata%npcol+1),4)
ALLOCATE ( iwork(liwork), stat=err ) ALLOCATE ( iwork(liwork), stat=err )
IF (err.NE.0) THEN IF (err.NE.0) THEN
WRITE (*,*) 'iwork :',err,liwork WRITE (*,*) 'iwork :',err,liwork
...@@ -114,14 +114,14 @@ CONTAINS ...@@ -114,14 +114,14 @@ CONTAINS
WRITE (*,*) 'ifail :',err,hmat%global_size1 WRITE (*,*) 'ifail :',err,hmat%global_size1
CALL juDFT_error('Failed to allocated "ifail"', calledby ='chani') CALL juDFT_error('Failed to allocated "ifail"', calledby ='chani')
ENDIF ENDIF
ALLOCATE ( iclustr(2*hmat%nprow*hmat%npcol), stat=err ) ALLOCATE ( iclustr(2*hmat%blacsdata%nprow*hmat%blacsdata%npcol), stat=err )
IF (err.NE.0) THEN IF (err.NE.0) THEN
WRITE (*,*) 'iclustr:',err,2*hmat%nprow*hmat%npcol WRITE (*,*) 'iclustr:',err,2*hmat%blacsdata%nprow*hmat%blacsdata%npcol
CALL juDFT_error('Failed to allocated "iclustr"', calledby ='chani') CALL juDFT_error('Failed to allocated "iclustr"', calledby ='chani')
ENDIF ENDIF
ALLOCATE ( gap(hmat%nprow*hmat%npcol), stat=err ) ALLOCATE ( gap(hmat%blacsdata%nprow*hmat%blacsdata%npcol), stat=err )
IF (err.NE.0) THEN IF (err.NE.0) THEN
WRITE (*,*) 'gap :',err,hmat%nprow*hmat%npcol WRITE (*,*) 'gap :',err,hmat%blacsdata%nprow*hmat%blacsdata%npcol
CALL juDFT_error('Failed to allocated "gap"', calledby ='chani') CALL juDFT_error('Failed to allocated "gap"', calledby ='chani')
ENDIF ENDIF
! !
...@@ -130,9 +130,9 @@ CONTAINS ...@@ -130,9 +130,9 @@ CONTAINS
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
uplo='U' uplo='U'
CALL CPP_LAPACK_pdsygvx(1,'V','I','U',hmat%global_size1,hmat%data_r,1,1,& CALL CPP_LAPACK_pdsygvx(1,'V','I','U',hmat%global_size1,hmat%data_r,1,1,&
hmat%blacs_desc,smat%data_r,1,1,smat%blacs_desc,& hmat%blacsdata%blacs_desc,smat%data_r,1,1,smat%blacsdata%blacs_desc,&
0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_r,1,1,& 0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_r,1,1,&
ev_dist%blacs_desc,work2_r,-1,iwork,-1,ifail,iclustr, gap,ierr) ev_dist%blacsdata%blacs_desc,work2_r,-1,iwork,-1,ifail,iclustr, gap,ierr)
IF ( work2_r(1).GT.lwork2) THEN IF ( work2_r(1).GT.lwork2) THEN
lwork2 = work2_r(1) lwork2 = work2_r(1)
DEALLOCATE (work2_r) DEALLOCATE (work2_r)
...@@ -143,7 +143,7 @@ CONTAINS ...@@ -143,7 +143,7 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
ELSE ELSE
lrwork=4*hmat%global_size1+MAX(5*nn,np0*mq0)+ iceil(ne,hmat%nprow*hmat%npcol)*nn lrwork=4*hmat%global_size1+MAX(5*nn,np0*mq0)+ iceil(ne,hmat%blacsdata%nprow*hmat%blacsdata%npcol)*nn
! Allocate more in case of clusters ! Allocate more in case of clusters
ALLOCATE(rwork(lrwork+10*hmat%global_size1), stat=ierr) ALLOCATE(rwork(lrwork+10*hmat%global_size1), stat=ierr)
IF (err /= 0) THEN IF (err /= 0) THEN
...@@ -152,9 +152,9 @@ CONTAINS ...@@ -152,9 +152,9 @@ CONTAINS
ENDIF ENDIF
CALL CPP_LAPACK_pzhegvx(1,'V','I','U',hmat%global_size1,hmat%data_c,1,1,& CALL CPP_LAPACK_pzhegvx(1,'V','I','U',hmat%global_size1,hmat%data_c,1,1,&
hmat%blacs_desc,smat%data_c,1,1, smat%blacs_desc,& hmat%blacsdata%blacs_desc,smat%data_c,1,1, smat%blacsdata%blacs_desc,&
0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_c,1,1,& 0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_c,1,1,&
ev_dist%blacs_desc,work2_c,-1,rwork,-1,iwork,-1,ifail,iclustr,& ev_dist%blacsdata%blacs_desc,work2_c,-1,rwork,-1,iwork,-1,ifail,iclustr,&
gap,ierr) gap,ierr)
IF (ABS(work2_c(1)).GT.lwork2) THEN IF (ABS(work2_c(1)).GT.lwork2) THEN
lwork2=work2_c(1) lwork2=work2_c(1)
...@@ -190,14 +190,14 @@ CONTAINS ...@@ -190,14 +190,14 @@ CONTAINS
! !
CALL timestart("SCALAPACK call") CALL timestart("SCALAPACK call")
if (hmat%l_real) THEN if (hmat%l_real) THEN
CALL CPP_LAPACK_pdsygvx(1,'V','I','U',hmat%global_size1,hmat%data_r,1,1,hmat%blacs_desc,smat%data_r,1,1, smat%blacs_desc,& CALL CPP_LAPACK_pdsygvx(1,'V','I','U',hmat%global_size1,hmat%data_r,1,1,hmat%blacsdata%blacs_desc,smat%data_r,1,1, smat%blacsdata%blacs_desc,&
1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_r,1,1,& 1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_r,1,1,&
ev_dist%blacs_desc,work2_r,lwork2,iwork,liwork,ifail,iclustr,& ev_dist%blacsdata%blacs_desc,work2_r,lwork2,iwork,liwork,ifail,iclustr,&
gap,ierr) gap,ierr)
else else
CALL CPP_LAPACK_pzhegvx(1,'V','I','U',hmat%global_size1,hmat%data_c,1,1,hmat%blacs_desc,smat%data_c,1,1, smat%blacs_desc,& CALL CPP_LAPACK_pzhegvx(1,'V','I','U',hmat%global_size1,hmat%data_c,1,1,hmat%blacsdata%blacs_desc,smat%data_c,1,1, smat%blacsdata%blacs_desc,&
1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_c,1,1,& 1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,ev_dist%data_c,1,1,&
ev_dist%blacs_desc,work2_c,lwork2,rwork,lrwork,iwork,liwork,& ev_dist%blacsdata%blacs_desc,work2_c,lwork2,rwork,lrwork,iwork,liwork,&
ifail,iclustr,gap,ierr) ifail,iclustr,gap,ierr)
DEALLOCATE(rwork) DEALLOCATE(rwork)
endif endif
...@@ -255,7 +255,7 @@ CONTAINS ...@@ -255,7 +255,7 @@ CONTAINS
! having all eigenvectors corresponding to his eigenvalues as above ! having all eigenvectors corresponding to his eigenvalues as above
! !
ALLOCATE(t_mpimat::ev) ALLOCATE(t_mpimat::ev)
CALL ev%init(ev_dist%l_real,ev_dist%global_size1,ev_dist%global_size1,ev_dist%mpi_com,.FALSE.) CALL ev%init(ev_dist%l_real,ev_dist%global_size1,ev_dist%global_size1,ev_dist%blacsdata%mpi_com,.FALSE.)
CALL ev%copy(ev_dist,1,1) CALL ev%copy(ev_dist,1,1)
CLASS DEFAULT CLASS DEFAULT
call judft_error("Wrong type (1) in scalapack") call judft_error("Wrong type (1) in scalapack")
......
...@@ -38,22 +38,22 @@ CONTAINS ...@@ -38,22 +38,22 @@ CONTAINS
!up-up component (or only component in collinear case) !up-up component (or only component in collinear case)
IF (SIZE(mat)==1) THEN IF (SIZE(mat)==1) THEN
CALL mat_final%move(mat(1,1)) CALL mat_final%move(mat(1,1))
IF (PRESENT(mat_final_templ)) CALL mat(1,1)%free() CALL mat(1,1)%free()
RETURN RETURN
ENDIF ENDIF
CALL mat_final%copy(mat(1,1),1,1) CALL mat_final%copy(mat(1,1),1,1)
IF (PRESENT(mat_final_templ)) CALL mat(1,1)%free() CALL mat(1,1)%free()
!down-down component !down-down component
CALL mat_final%copy(mat(2,2),lapw%nv(1)+atoms%nlotot+1,lapw%nv(1)+atoms%nlotot+1) CALL mat_final%copy(mat(2,2),lapw%nv(1)+atoms%nlotot+1,lapw%nv(1)+atoms%nlotot+1)
IF (PRESENT(mat_final_templ)) CALL mat(2,2)%free() CALL mat(2,2)%free()
!Now collect off-diagonal parts !Now collect off-diagonal parts
CALL mat(1,2)%add_transpose(mat(2,1)) CALL mat(1,2)%add_transpose(mat(2,1))
CALL mat_final%copy(mat(1,2),1,lapw%nv(1)+atoms%nlotot+1) CALL mat_final%copy(mat(1,2),1,lapw%nv(1)+atoms%nlotot+1)
IF (PRESENT(mat_final_templ)) CALL mat(1,2)%free() CALL mat(1,2)%free()
IF (PRESENT(mat_final_templ)) CALL mat(2,1)%free() CALL mat(2,1)%free()
END SUBROUTINE eigen_redist_matrix END SUBROUTINE eigen_redist_matrix
END MODULE m_eigen_redist_matrix END MODULE m_eigen_redist_matrix
......
...@@ -42,7 +42,7 @@ ...@@ -42,7 +42,7 @@
REAL dmat(3,3),dmati(3,3) REAL dmat(3,3),dmati(3,3)
INTRINSIC sqrt,max,min
DO n = 1, n_u DO n = 1, n_u
......
...@@ -47,9 +47,7 @@ ...@@ -47,9 +47,7 @@
! .. Local Arrays .. ! .. Local Arrays ..
COMPLEX sf2(stars%ng2),sf3(stars%ng3),ylm((atoms%lmaxd+1)**2) COMPLEX sf2(stars%ng2),sf3(stars%ng3),ylm((atoms%lmaxd+1)**2)
REAL rcc(3),x(3) REAL rcc(3),x(3)
! ..
! .. Intrinsic Functions ..
INTRINSIC abs,real,sqrt
ivac=iv ivac=iv
......
...@@ -17,14 +17,23 @@ MODULE m_types_mpimat ...@@ -17,14 +17,23 @@ MODULE m_types_mpimat
!<It stores the additional mpi_communicator and sets up a blacs grid for the matrix. !<It stores the additional mpi_communicator and sets up a blacs grid for the matrix.
!<This can be used to perform scalapack calls on the matrix with little additional input. !<This can be used to perform scalapack calls on the matrix with little additional input.
!<The copy procedure is overwritten from t_mat to enable also redistribution of the matrix. !<The copy procedure is overwritten from t_mat to enable also redistribution of the matrix.
TYPE t_blacsdata
INTEGER:: no_use
INTEGER:: mpi_com !> mpi-communiator over which matrix is distributed
INTEGER:: blacs_desc(dlen_) !> blacs descriptor
!> 1: =1
!> 2: context
!> 3,4: global matrix size
!> 5,6: block sizes
!> 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
END TYPE t_blacsdata
TYPE,EXTENDS(t_mat):: t_mpimat TYPE,EXTENDS(t_mat):: t_mpimat
INTEGER:: mpi_com !> mpi-communiator over which matrix is distributed INTEGER :: global_size1,global_size2 !> this is the size of the full-matrix
INTEGER:: blacs_desc(dlen_) !> blacs descriptor TYPE(t_blacsdata),POINTER :: blacsdata
INTEGER:: blacs_ctext !> blacs context
INTEGER:: global_size1,global_size2 !> this is the size of the full-matrix
INTEGER:: npcol,nprow !> the number of columns/rows in the processor grid
CONTAINS CONTAINS
PROCEDURE,PASS :: copy => mpimat_copy !<overwriten from t_mat, also performs redistribution PROCEDURE,PASS :: copy => mpimat_copy !<overwriten from t_mat, also performs redistribution
PROCEDURE,PASS :: move => mpimat_move !<overwriten from t_mat, also performs redistribution PROCEDURE,PASS :: move => mpimat_move !<overwriten from t_mat, also performs redistribution
...@@ -35,7 +44,7 @@ MODULE m_types_mpimat ...@@ -35,7 +44,7 @@ MODULE m_types_mpimat
PROCEDURE,PASS :: generate_full_matrix ! construct full matrix if only upper triangle of hermitian matrix is given PROCEDURE,PASS :: generate_full_matrix ! construct full matrix if only upper triangle of hermitian matrix is given
PROCEDURE,PASS :: print_matrix PROCEDURE,PASS :: print_matrix
PROCEDURE,PASS :: from_non_dist PROCEDURE,PASS :: from_non_dist
FINAL :: finalize
END TYPE t_mpimat END TYPE t_mpimat
PUBLIC t_mpimat PUBLIC t_mpimat
...@@ -52,29 +61,29 @@ CONTAINS ...@@ -52,29 +61,29 @@ CONTAINS
CHARACTER(len=10)::filename CHARACTER(len=10)::filename
INTEGER :: irank,isize,i,j,npr,npc,r,c,tmp,err,status(MPI_STATUS_SIZE) INTEGER :: irank,isize,i,j,npr,npc,r,c,tmp,err,status(MPI_STATUS_SIZE)
CALL MPI_COMM_RANK(mat%mpi_com,irank,err) CALL MPI_COMM_RANK(mat%blacsdata%mpi_com,irank,err)
CALL MPI_COMM_SIZE(mat%mpi_com,isize,err) CALL MPI_COMM_SIZE(mat%blacsdata%mpi_com,isize,err)
tmp=0 tmp=0
IF (irank>0) CALL MPI_RECV(tmp,1,MPI_INTEGER,irank-1,0,mat%mpi_com,status,err) !lock IF (irank>0) CALL MPI_RECV(tmp,1,MPI_INTEGER,irank-1,0,mat%blacsdata%mpi_com,status,err) !lock
WRITE(filename,"(a,i0)") "out.",fileno WRITE(filename,"(a,i0)") "out.",fileno
OPEN(fileno,file=filename,access='append') OPEN(fileno,file=filename,access='append')
CALL blacs_gridinfo(mat%blacs_desc(2),npr,npc,r,c) CALL blacs_gridinfo(mat%blacsdata%blacs_desc(2),npr,npc,r,c)
DO i=1,mat%matsize1 DO i=1,mat%matsize1
DO j=1,mat%matsize2 DO j=1,mat%matsize2
IF (mat%l_real) THEN IF (mat%l_real) THEN
WRITE(fileno,"(5(i0,1x),2(f10.5,1x))") irank,i,j,indxl2g(i,mat%blacs_desc(5),r,0,npr),& WRITE(fileno,"(5(i0,1x),2(f10.5,1x))") irank,i,j,indxl2g(i,mat%blacsdata%blacs_desc(5),r,0,npr),&
indxl2g(j,mat%blacs_desc(6),c,0,npc),mat%data_r(i,j) indxl2g(j,mat%blacsdata%blacs_desc(6),c,0,npc),mat%data_r(i,j)
ELSE ELSE
WRITE(fileno,"(5(i0,1x),2(f10.5,1x))") irank,i,j,indxl2g(i,mat%blacs_desc(5),r,0,npr),& WRITE(fileno,"(5(i0,1x),2(f10.5,1x))") irank,i,j,indxl2g(i,mat%blacsdata%blacs_desc(5),r,0,npr),&
indxl2g(j,mat%blacs_desc(6),c,0,npc),mat%data_c(i,j) indxl2g(j,mat%blacsdata%blacs_desc(6),c,0,npc),mat%data_c(i,j)
END IF END IF
ENDDO ENDDO
ENDDO ENDDO
CLOSE(fileno) CLOSE(fileno)
IF (irank+1<isize) CALL MPI_SEND(tmp,1,MPI_INTEGER,irank+1,0,mat%mpi_com,err) IF (irank+1<isize) CALL MPI_SEND(tmp,1,MPI_INTEGER,irank+1,0,mat%blacsdata%mpi_com,err)
#endif #endif
END SUBROUTINE print_matrix END SUBROUTINE print_matrix
...@@ -89,18 +98,18 @@ CONTAINS ...@@ -89,18 +98,18 @@ CONTAINS
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
INTEGER, EXTERNAL :: numroc, indxl2g !SCALAPACK functions INTEGER, EXTERNAL :: numroc, indxl2g !SCALAPACK functions
CALL MPI_COMM_RANK(mat%mpi_com,myid,err) CALL MPI_COMM_RANK(mat%blacsdata%mpi_com,myid,err)
CALL MPI_COMM_SIZE(mat%mpi_com,np,err) CALL MPI_COMM_SIZE(mat%blacsdata%mpi_com,np,err)
CALL blacs_gridinfo(mat%blacs_desc(2),nprow,npcol,myrow,mycol) CALL blacs_gridinfo(mat%blacsdata%blacs_desc(2),nprow,npcol,myrow,mycol)
!Set lower part of matrix to zero !Set lower part of matrix to zero
DO i=1,mat%matsize1 DO i=1,mat%matsize1
DO j=1,mat%matsize2 DO j=1,mat%matsize2
! Get global column corresponding to i and number of local rows up to ! Get global column corresponding to i and number of local rows up to
! and including the diagonal, these are unchanged in A ! and including the diagonal, these are unchanged in A
i_glob = indxl2g(i, mat%blacs_desc(5), myrow, 0, nprow) i_glob = indxl2g(i, mat%blacsdata%blacs_desc(5), myrow, 0, nprow)
j_glob = indxl2g(j, mat%blacs_desc(6), mycol, 0, npcol) j_glob = indxl2g(j, mat%blacsdata%blacs_desc(6), mycol, 0, npcol)
IF (i_glob>j_glob) THEN IF (i_glob>j_glob) THEN
IF (mat%l_real) THEN IF (mat%l_real) THEN
...@@ -126,13 +135,13 @@ CONTAINS ...@@ -126,13 +135,13 @@ CONTAINS
ALLOCATE(tmp_c(mat%matsize1,mat%matsize2)) ALLOCATE(tmp_c(mat%matsize1,mat%matsize2))
tmp_c=mat%data_c tmp_c=mat%data_c
END IF END IF
CALL MPI_BARRIER(mat%mpi_com,i) CALL MPI_BARRIER(mat%blacsdata%mpi_com,i)
IF (mat%l_real) THEN IF (mat%l_real) THEN
#ifdef CPP_SCALAPACK #ifdef CPP_SCALAPACK
CALL pdgeadd('t',mat%global_size1,mat%global_size2,1.0,tmp_r,1,1,mat%blacs_desc,1.0,mat%data_r,1,1,mat%blacs_desc) CALL pdgeadd('t',mat%global_size1,mat%global_size2,1.0,tmp_r,1,1,mat%blacsdata%blacs_desc,1.0,mat%data_r,1,1,mat%blacsdata%blacs_desc)
ELSE ELSE
CALL pzgeadd('c',mat%global_size1,mat%global_size2,CMPLX(1.0,0.0),tmp_c,1,1,mat%blacs_desc,CMPLX(1.0,0.0),mat%data_c,1,1,mat%blacs_desc) CALL pzgeadd('c',mat%global_size1,mat%global_size2,CMPLX(1.0,0.0),tmp_c,1,1,mat%blacsdata%blacs_desc,CMPLX(1.0,0.0),mat%data_c,1,1,mat%blacsdata%blacs_desc)
#endif #endif
END IF END IF
...@@ -150,8 +159,8 @@ CONTAINS ...@@ -150,8 +159,8 @@ CONTAINS
SELECT TYPE(mat1) SELECT TYPE(mat1)
TYPE IS (t_mpimat) TYPE IS (t_mpimat)
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_COMM_RANK(mat%mpi_com,n_rank,i) CALL MPI_COMM_RANK(mat%blacsdata%mpi_com,n_rank,i)
CALL MPI_COMM_SIZE(mat%mpi_com,n_size,i) CALL MPI_COMM_SIZE(mat%blacsdata%mpi_com,n_size,i)
#endif #endif
!Set lower part of matrix to zero...