diff --git a/diagonalization/chani.F90 b/diagonalization/chani.F90 index b2f19e883c0468c88fd66b352c864e4ef4c860d5..6077450c1a0c4b2fd2191a97fde7c5146774e206 100644 --- a/diagonalization/chani.F90 +++ b/diagonalization/chani.F90 @@ -7,7 +7,7 @@ MODULE m_chani CONTAINS SUBROUTINE chani(M,N,Neigd, Myid,Np,Sub_comm,mpi_comm, & - Eig,Num,A_r,B_r,Z_r,A_c,B_c,Z_c) + Eig,Num,hamOvlp,zMat) ! !---------------------------------------------------- !- Parallel eigensystem solver - driver routine; gb99 @@ -33,6 +33,8 @@ CONTAINS !#include"cpp_arch.h" #include"cpp_double.h" USE m_juDFT + USE m_types + USE m_subredist1 IMPLICIT NONE INCLUDE 'mpif.h' @@ -40,11 +42,9 @@ CONTAINS INTEGER, INTENT (IN) :: SUB_COMM,np,myid,mpi_comm INTEGER, INTENT (INOUT) :: num REAL, INTENT (OUT) :: eig(neigd) - REAL,OPTIONAL, INTENT (INOUT) :: a_r(m,n),b_r(m,n) - REAL,OPTIONAL, INTENT (OUT) :: z_r(m,neigd) - COMPLEX, OPTIONAL,INTENT (INOUT) :: a_c(m,n),b_c(m,n) - COMPLEX, OPTIONAL,INTENT (OUT) :: z_c(m,neigd) - + TYPE(t_hamOvlp),INTENT(INOUT) :: hamOvlp + TYPE(t_zMat),INTENT(INOUT) :: zMat + !... Local variables ! INTEGER nc,ic,ir,n_sym,jsym,num_j,icm,n_bound @@ -74,13 +74,11 @@ CONTAINS REAL, ALLOCATABLE :: asca_r(:,:), bsca_r(:,:),work2_r(:) COMPLEX, ALLOCATABLE :: asca_c(:,:), bsca_c(:,:),work2_c(:) - EXTERNAL subredist1, subredist2, iceil, numroc + EXTERNAL subredist2, iceil, numroc EXTERNAL CPP_LAPACK_slamch, descinit EXTERNAL blacs_pinfo, blacs_gridinit EXTERNAL MPI_COMM_DUP - LOGICAL :: l_real - l_real=present(a_r) ! ! determine actual number of columns of input matrices A and B ! nc is number of columns the local processor will get, must be <=n @@ -132,17 +130,17 @@ CONTAINS mycolssca=(m-1)/(nb*npcol)*nb+ & MIN(MAX(m-(m-1)/(nb*npcol)*nb*npcol-nb*mycol,0),nb) ! Number of columns the local process gets in ScaLAPACK distribution - if (l_real) THEN + if (hamOvlp%l_real) THEN ALLOCATE ( asca_r(myrowssca,mycolssca), stat=err ) else ALLOCATE ( asca_c(myrowssca,mycolssca), stat=err ) - end + endif IF (err.NE.0) THEN WRITE (*,*) 'In chani an error occured during the allocation of' WRITE (*,*) 'asca: ',err,' size: ',myrowssca*mycolssca CALL juDFT_error("allocte in chani",calledby ="chani") ENDIF - if (l_real) THEN + if (hamOvlp%l_real) THEN asca_r=0.0 ALLOCATE ( bsca_r(myrowssca,mycolssca), stat=err ) else @@ -154,14 +152,14 @@ CONTAINS WRITE (*,*) 'bsca :',err CALL juDFT_error("allocate in chani",calledby ="chani") ENDIF - if (l_real) THEN + if (hamOvlp%l_real) THEN bsca_r=0.0 - CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,a_r,asca_r) - CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,b_r,bsca_r) + CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,achi_r=hamovlp%a_r,asca_r=asca_r) + CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,achi_r=hamovlp%b_r,asca_r=bsca_r) else bsca_c=0.0 - CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,a_c,asca_c) - CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,b_c,bsca_c) + CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,achi_c=hamovlp%a_c,asca_c=asca_c) + CALL subredist1(m,myrowssca,SUB_COMM, nprow, npcol, myid, ierr, nb ,achi_c=hamovlp%b_c,asca_c=bsca_c) end if CALL BLACS_PINFO(iamblacs,npblacs) ! iamblacs = local process rank (e.g. myid) ! npblacs = number of available processes @@ -243,7 +241,7 @@ CONTAINS CALL juDFT_error('Failed to allocated "eig2"', calledby ='chani') ENDIF ! write(*,*) 'c :',myrowssca,mycolssca,desceigv - if (l_real) THEN + if (hamovlp%l_real) THEN ALLOCATE ( eigvec_r(myrowssca,mycolssca), stat=err ) ! Eigenvectors for ScaLAPACK else ALLOCATE ( eigvec_c(myrowssca,mycolssca), stat=err ) ! Eigenvectors for ScaLAPACK @@ -257,7 +255,7 @@ CONTAINS nn=MAX(MAX(m,nb),2) np0=numroc(nn,nb,0,0,nprow) mq0=numroc(MAX(MAX(neigd,nb),2),nb,0,0,npcol) - if (l_real) THEN + if (hamovlp%l_real) THEN lwork2=5*m+MAX(5*nn,np0*mq0+2*nb*nb)+ iceil(neigd,nprow*npcol)*nn ALLOCATE ( work2_r(lwork2+10*m), stat=err ) ! Allocate more in case of clusters else @@ -293,7 +291,7 @@ CONTAINS ! ! Compute size of workspace ! - if (l_real) THEN + if (hamovlp%l_real) THEN uplo='U' CALL CPP_LAPACK_pdsygvx(1,'V','I','U',m,asca_r,1,1,desca,bsca_r,1,1, desca,& 0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_r,1,1,& @@ -352,7 +350,7 @@ endif ! ! Now solve generalized eigenvalue problem ! -if (l_real) THEN +if (hamovlp%l_real) THEN CALL CPP_LAPACK_pdsygvx(1,'V','I','U',m,asca_r,1,1,desca,bsca_r,1,1, desca,& 1.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec_r,1,1,& desceigv,work2_r,lwork2,iwork,liwork,ifail,iclustr,& @@ -425,15 +423,13 @@ endif ! Redistribute eigvec from ScaLAPACK distribution to each process ! having all eigenvectors corresponding to his eigenvalues as above ! - if (l_real) THEN - CALL subredist2(m,num2,myrowssca,SUB_COMM,nprow,npcol, myid,ierr,nb,z_r,eigvec_r) + if (hamovlp%l_real) THEN + CALL subredist2(m,num2,myrowssca,SUB_COMM,nprow,npcol, myid,ierr,nb,zmat%z_r,eigvec_r) ELSE - CALL subredist2(m,num2,myrowssca,SUB_COMM,nprow,npcol, myid,ierr,nb,z_c,eigvec_c) + CALL subredist2(m,num2,myrowssca,SUB_COMM,nprow,npcol, myid,ierr,nb,zmat%z_c,eigvec_c) end if ! !DEALLOCATE ( eigvec) - DEALLOCATE ( asca ) - DEALLOCATE ( bsca ) DEALLOCATE ( iblacsnums ) DEALLOCATE ( ihelp ) DEALLOCATE ( iusermap ) diff --git a/diagonalization/eigen_diag.F90 b/diagonalization/eigen_diag.F90 index 13ef79b9709bc8e285bce27814bfdb771a02ecc2..c3c46efce17e0a472ad49bf610cf604e45c8f3da 100644 --- a/diagonalization/eigen_diag.F90 +++ b/diagonalization/eigen_diag.F90 @@ -175,7 +175,7 @@ CONTAINS #endif #ifdef CPP_SCALAPACK CASE (diag_scalapack) - CALL chani(lapw%nmat,dimension%nbasfcn/n_size,ndim, n_rank,n_size,SUB_COMM,mpi%mpi_comm,eig,ne_found,hamOvlp%a_r,hamOvlp%b_r,zMat%z_r,hamOvlp%a_c,hamOvlp%b_c,zMat%z_c) + CALL chani(lapw%nmat,dimension%nbasfcn/n_size,ndim, n_rank,n_size,SUB_COMM,mpi%mpi_comm,eig,ne_found,hamOvlp,zMat) #endif #ifdef CPP_MAGMA CASE (diag_magma) diff --git a/diagonalization/ssubredist1.F90 b/diagonalization/ssubredist1.F90 index 5a164674562cfcd28b2c092544f13a9698c55de6..2667a2d4b88a1053e7ae9b0180566abbadd2b85d 100644 --- a/diagonalization/ssubredist1.F90 +++ b/diagonalization/ssubredist1.F90 @@ -3,7 +3,9 @@ ! This file is part of FLEUR and available as free software under the conditions ! of the MIT license as expressed in the LICENSE file in more detail. !-------------------------------------------------------------------------------- +MODULE m_subredist1 +CONTAINS !DEC$ FREEFORM SUBROUTINE subredist1(n,lda,SUB_COMM,nprow,npcol,iam,ierr,nb,achi_r,asca_r,achi_c,asca_c) USE m_juDFT @@ -666,3 +668,4 @@ SUBROUTINE subredist1(n,lda,SUB_COMM,nprow,npcol,iam,ierr,nb,achi_r,asca_r,achi_ DEALLOCATE(icommcol) RETURN END SUBROUTINE subredist1 +END \ No newline at end of file diff --git a/eigen/hlomat.F90 b/eigen/hlomat.F90 index ca447d7b69df26e60ced9898efa9173eb9f8e22b..d5444ed94abe73615113345b0dcecf2b44b49f5d 100644 --- a/eigen/hlomat.F90 +++ b/eigen/hlomat.F90 @@ -42,8 +42,8 @@ CONTAINS TYPE(t_tlmplm),INTENT(INOUT) :: tlmplm LOGICAL,INTENT(IN) :: l_real - REAL, OPTIONAL,INTENT (INOUT) :: aa_r(:)!(matsize) - COMPLEX, OPTIONAL,INTENT (INOUT) :: aa_c(:) + REAL, OPTIONAL,ALLOCATABLE,INTENT (INOUT) :: aa_r(:)!(matsize) + COMPLEX, OPTIONAL,ALLOCATABLE,INTENT (INOUT) :: aa_c(:) ! .. ! .. Local Scalars .. COMPLEX axx,bxx,cxx,dtd,dtu,dtulo,ulotd,ulotu,ulotulo,utd,utu, utulo,chihlp diff --git a/io/eig66_mpi.F90 b/io/eig66_mpi.F90 index b689eee7dd2479d18fb48049c14e44ffa314e7e7..3bab8092c7d707387e33e2a802402888a30500ca 100644 --- a/io/eig66_mpi.F90 +++ b/io/eig66_mpi.F90 @@ -39,7 +39,7 @@ CONTAINS TYPE(t_data_MPI),POINTER :: d CALL priv_find_data(id,d) - CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb) + CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real.and..not.l_soc,l_soc,l_dos,l_mcd,l_orb) IF (PRESENT(n_size_opt)) d%n_size=n_size_opt IF (ALLOCATED(d%pe_ev)) THEN @@ -48,7 +48,7 @@ CONTAINS d%eig_data=1E99 d%int_data=9999999 d%real_data=1E99 - if (l_real.and..not.l_soc) THEN + if (d%l_real.and..not.l_soc) THEN d%zr_data=0.0 else d%zc_data=0.0 @@ -193,10 +193,10 @@ CONTAINS IF (d%irank==0) THEN tmp_id=eig66_data_newid(DA_mode) IF (d%l_dos) CPP_error("Could not read DOS data") - CALL open_eig_DA(tmp_id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,.FALSE.,.FALSE.,l_real,l_soc,.FALSE.,.FALSE.,filename) + CALL open_eig_DA(tmp_id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,.FALSE.,.FALSE.,d%l_real,l_soc,.FALSE.,.FALSE.,filename) DO jspin=1,jspins DO nk=1,nkpts - if (l_real) THEN + if (d%l_real) THEN CALL read_eig_DA(tmp_id,nk,jspin,nv,i,k1,k2,k3,bk3,wk,ii,eig,el,ello,evac,kveclo,z=z_r) CALL write_eig(id,nk,jspin,ii,ii,nv,nmat,k1,k2,k3,bk3,wk,eig,el,ello,evac,nlotot,kveclo,z=z_r) ELSE