Bugfixes for parallel version

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 )

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)

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

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

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