Make ChASE inclusion less invasive

...by turning chase_eig_id into a module variable

diagonalization/chase_diag.F90

@@ -30,9 +30,48 @@ IMPLICIT NONE
     end subroutine chase_r
   end interface
 
+  PRIVATE 
+
+    INTEGER :: chase_eig_id
+
+  PUBLIC init_chase, chase_diag
+
   CONTAINS
 
-  SUBROUTINE chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,zmat)
+  SUBROUTINE init_chase(mpi,dimension,input,atoms,kpts,noco,vacuum,banddos,l_real)
+
+    USE m_types
+    USE m_types_mpi
+    USE m_judft
+    USE m_eig66_io
+
+    IMPLICIT NONE
+
+    TYPE(t_mpi),               INTENT(IN)    :: mpi
+    TYPE(t_dimension),         INTENT(IN)    :: dimension
+    TYPE(t_input),             INTENT(IN)    :: input
+    TYPE(t_atoms),             INTENT(IN)    :: atoms
+    TYPE(t_kpts),              INTENT(IN)    :: kpts
+    TYPE(t_noco),              INTENT(IN)    :: noco
+    TYPE(t_vacuum),            INTENT(IN)    :: vacuum
+    TYPE(t_banddos),           INTENT(IN)    :: banddos
+
+    LOGICAL,                   INTENT(IN)    :: l_real
+
+    INTEGER                                  :: nevd, nexd
+
+    IF (juDFT_was_argument("-diag:chase")) THEN
+       nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
+       nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
+       chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
+                             atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
+                             mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
+                             nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
+                             l_orb=banddos%l_orb)
+    END IF
+  END SUBROUTINE init_chase
+
+  SUBROUTINE chase_diag(mpi,hmat,smat,ikpt,jsp,iter,ne,eig,zmat)
 
     USE m_types
     USE m_types_mpi
@@ -42,11 +81,11 @@ IMPLICIT NONE
 
     !Simple driver to solve Generalized Eigenvalue Problem using the ChASE library
     IMPLICIT NONE
+
     TYPE(t_mpi),               INTENT(IN)    :: mpi
     TYPE(t_mat),               INTENT(INOUT) :: hmat,smat
     INTEGER,                   INTENT(IN)    :: ikpt
     INTEGER,                   INTENT(IN)    :: jsp
-    INTEGER,                   INTENT(IN)    :: chase_eig_id
     INTEGER,                   INTENT(IN)    :: iter
     INTEGER,                   INTENT(INOUT) :: ne
     CLASS(t_mat), ALLOCATABLE, INTENT(OUT)   :: zmat

diagonalization/eigen_diag.F90

@@ -39,7 +39,7 @@ CONTAINS
     parallel_solver_available=any((/diag_elpa,diag_elemental,diag_scalapack/)>0)
   END FUNCTION parallel_solver_available
 
-  SUBROUTINE eigen_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,ev)
+  SUBROUTINE eigen_diag(mpi,hmat,smat,ikpt,jsp,iter,ne,eig,ev)
     USE m_lapack_diag
     USE m_magma
     USE m_elpa
@@ -57,7 +57,6 @@ CONTAINS
     CLASS(t_mat), ALLOCATABLE, INTENT(OUT)   :: ev
     INTEGER,                   INTENT(IN)    :: ikpt
     INTEGER,                   INTENT(IN)    :: jsp
-    INTEGER,                   INTENT(IN)    :: chase_eig_id
     INTEGER,                   INTENT(IN)    :: iter
     INTEGER,                   INTENT(INOUT) :: ne
     REAL,                      INTENT(OUT)   :: eig(:)
@@ -86,7 +85,7 @@ CONTAINS
        CALL lapack_diag(hmat,smat,ne,eig,ev)
     CASE (diag_chase)
 #ifdef CPP_CHASE
-       CALL chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,ev)
+       CALL chase_diag(mpi,hmat,smat,ikpt,jsp,iter,ne,eig,ev)
 #else
        CALL juDFT_error('ChASE eigensolver selected but not available', calledby = 'eigen_diag')
 #endif

eigen/eigen.F90

@@ -19,7 +19,7 @@ CONTAINS
   !> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat. 
   !>@author D. Wortmann
   SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,sym,kpts,DIMENSION,vacuum,input,&
-                   cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,chase_eig_id,results,inden,v,vx)
+                   cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inden,v,vx)
 
     USE m_constants, ONLY : pi_const,sfp_const
     USE m_types
@@ -69,7 +69,6 @@ CONTAINS
     !     .. Scalar Arguments ..
     INTEGER,INTENT(IN)    :: iter
     INTEGER,INTENT(INOUT) :: eig_id
-    INTEGER,INTENT(INOUT) :: chase_eig_id
     !     ..
     !-odim
     !+odim
@@ -163,7 +162,7 @@ CONTAINS
           l_wu=.FALSE.
           ne_all=DIMENSION%neigd
           if (allocated(zmat)) deallocate(zmat)
-          CALL eigen_diag(mpi,hmat,smat,nk,jsp,chase_eig_id,iter,ne_all,eig,zMat)
+          CALL eigen_diag(mpi,hmat,smat,nk,jsp,iter,ne_all,eig,zMat)
           DEALLOCATE(hmat,smat)
           !
           !--->         output results

main/fleur.F90

@@ -69,6 +69,7 @@ CONTAINS
     USE m_mpi_bc_potden
 #endif
     USE m_eig66_io,   ONLY : open_eig, close_eig
+    USE m_chase_diag
     IMPLICIT NONE
 
     INTEGER,INTENT(IN) :: mpi_comm
@@ -101,9 +102,9 @@ CONTAINS
     CLASS(t_forcetheo),ALLOCATABLE:: forcetheo
 
     !     .. Local Scalars ..
-    INTEGER:: eig_id,chase_eig_id, archiveType
-    INTEGER:: n,it,ithf,nevd,nexd
-    LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp, l_real
+    INTEGER:: eig_id, archiveType
+    INTEGER:: n,it,ithf
+    LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp
     REAL   :: fermiEnergyTemp, fix
 #ifdef CPP_MPI
     INCLUDE 'mpif.h'
@@ -133,17 +134,9 @@ CONTAINS
 
     !-Wannier
 
-    l_real = sym%invs.AND..NOT.noco%l_noco
-    IF (juDFT_was_argument("-diag:chase")) THEN
-       nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
-       nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
-       chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
-                             atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
-                             mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
-                             nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
-                             l_orb=banddos%l_orb)
-    END IF
-
+#ifdef CPP_CHASE
+    CALL init_chase(mpi,dimension,input,atoms,kpts,noco,vacuum,banddos,sym%invs.AND..NOT.noco%l_noco)
+#endif
 
     it     = 0
     ithf   = 0
@@ -261,7 +254,7 @@ CONTAINS
           CALL enpara%update(mpi,atoms,vacuum,input,vToT)
           CALL eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
                      sym,kpts,DIMENSION,vacuum,input,cell,enpara,banddos,noco,oneD,hybrid,&
-                     it,eig_id,chase_eig_id,results,inDen,vTemp,vx)
+                     it,eig_id,results,inDen,vTemp,vx)
           vTot%mmpMat = vTemp%mmpMat
 !!$          eig_idList(pc) = eig_id
           CALL timestop("eigen")