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
......
This diff is collapsed.
...@@ -101,8 +101,6 @@ module m_VYukawaFilm ...@@ -101,8 +101,6 @@ module m_VYukawaFilm
real :: ga(vacuum%nmzd), gb(vacuum%nmzd) real :: ga(vacuum%nmzd), gb(vacuum%nmzd)
real :: delta(vacuum%nmzd,2), epsilon(vacuum%nmzd,2), zeta(vacuum%nmzd) real :: delta(vacuum%nmzd,2), epsilon(vacuum%nmzd,2), zeta(vacuum%nmzd)
intrinsic aimag, cmplx, conjg, exp, real, mod
! definitions / initialisations: ! definitions / initialisations:
do iz = 1, vacuum%nmz do iz = 1, vacuum%nmz
...@@ -239,8 +237,6 @@ module m_VYukawaFilm ...@@ -239,8 +237,6 @@ module m_VYukawaFilm
real :: z(3*stars%mx3) real :: z(3*stars%mx3)
real :: g_damped(stars%ng2), vcons2(stars%ng2) real :: g_damped(stars%ng2), vcons2(stars%ng2)
intrinsic abs, cmplx, conjg, cos, exp, sin, sqrt
! definitions / initialisations ! definitions / initialisations
ifft = 3 * stars%mx3 ifft = 3 * stars%mx3
......
...@@ -33,9 +33,6 @@ C .. Local Scalars .. ...@@ -33,9 +33,6 @@ C .. Local Scalars ..
COMPLEX em1f,em2f,ep1f,ep2f COMPLEX em1f,em2f,ep1f,ep2f
REAL cph,rxy,small,sph,x,xy,y REAL cph,rxy,small,sph,x,xy,y
C .. C ..
C .. Intrinsic Functions ..
INTRINSIC cmplx,conjg,sqrt
C ..
C .. Data Statements .. C .. Data Statements ..
DATA small/1.0e-12/ DATA small/1.0e-12/
c.....------------------------------------------------------------------ c.....------------------------------------------------------------------
......
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