  !
  ! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
  ! Copyright (C) 2007-2009 Roxana Margine
  !
  ! This file is distributed under the terms of the GNU General Public
  ! License. See the file `LICENSE' in the root directory of the
  ! present distribution, or http://www.gnu.org/copyleft.gpl.txt .
  !
  !----------------------------------------------------------------------
  MODULE supercond
  !----------------------------------------------------------------------
  !!
  !! This module contains all the routines linked with superconductivity using
  !! the isotropic or anisotropic Eliashberg formalism.
  !!
  IMPLICIT NONE
  !
  CONTAINS
    !
    !-----------------------------------------------------------------------
    SUBROUTINE eliashberg_init()
    !-----------------------------------------------------------------------
    !!
    !! This routine initializes the control variables needed to solve the eliashberg
    !! equations
    !!
    USE kinds,            ONLY : DP
    USE mp_global,        ONLY : world_comm
    USE io_global,        ONLY : stdout, ionode_id
    USE mp_world,         ONLY : mpime
    USE mp,               ONLY : mp_barrier, mp_bcast
    USE epwcom,           ONLY : eliashberg, nkf1, nkf2, nkf3, nsiter, &
                                 nqf1, nqf2, nqf3, nswi, muc, lreal, lpade, &
                                 liso, limag, laniso, lacon, kerwrite, kerread, &
                                 imag_read, fila2f, wscut, rand_q, rand_k, &
                                 ep_coupling, tc_linear, tc_linear_solver, gridsamp, fbw
    USE noncollin_module, ONLY : noncolin
    USE ions_base,        ONLY : amass, ityp, nat, tau
    USE cell_base,        ONLY : at, bg
    USE constants_epw,    ONLY : ryd2ev
    USE elph2,            ONLY : gtemp, elph
    USE io_var,           ONLY : crystal
    !
    IMPLICIT NONE
    !
    INTEGER :: ierr
    !! Error status
    INTEGER :: ios
    !! Contains the state of the opened file
    !
    IF (eliashberg .AND. MINVAL(gtemp(:)) <= 0) &
      CALL errore('eliashberg_init', 'eliashberg requires min temperature > 0', 1)
    IF (eliashberg .AND. liso .AND. laniso) &
      CALL errore('eliashberg_init', 'liso or laniso needs to be true', 1)
    IF (.NOT. eliashberg .AND. liso) &
      CALL errore('eliashberg_init', 'liso requires eliashberg true', 1)
    IF (.NOT. eliashberg .AND. laniso) &
      CALL errore('eliashberg_init', 'laniso requires eliashberg true', 1)
    ! SH: on restarting aniso runs, a2f file can be used for initial gap estimate
    !IF (laniso .AND. (fila2f /= ' ')) &
    !  CALL errore('eliashberg_init', 'anisotropic case can not use fila2f', 1)
    IF (eliashberg .AND. lreal .AND. laniso) &
      CALL errore('eliashberg_init', 'lreal is implemented only for the isotriopic case', 1)
    IF (eliashberg .AND. lreal .AND. limag) &
      CALL errore('eliashberg_init', 'lreal or limag needs to be true', 1)
    IF (eliashberg .AND. lreal .AND. lacon) &
      CALL errore('eliashberg_init', 'lreal or lacon needs to be true', 1)
    IF (eliashberg .AND. lreal .AND.  lpade) &
      CALL errore('eliashberg_init', 'lreal or lpade needs to be true', 1)
    IF (eliashberg .AND. imag_read .AND. .NOT. limag .AND. .NOT. laniso) &
      CALL errore('eliashberg_init', 'imag_read requires limag true and laniso true', 1)
    IF (eliashberg .AND. lpade .AND. .NOT. limag) &
      CALL errore('eliashberg_init', 'lpade requires limag true', 1)
    IF (eliashberg .AND. lacon .AND. (.NOT. limag .OR. .NOT. lpade)) &
      CALL errore('eliashberg_init', 'lacon requires both limag and lpade true', 1)
    IF (eliashberg .AND. lreal .AND. (kerread .AND. kerwrite)) &
      CALL errore('eliashberg_init', 'kerread cannot be used with kerwrite', 1)
    IF (eliashberg .AND. lreal .AND. (.NOT. kerread .AND. .NOT. kerwrite)) &
      CALL errore('eliashberg_init', 'kerread or kerwrite must be true', 1)
    IF (eliashberg .AND. nswi > 0 .AND. .NOT. limag) &
      CALL errore('eliashberg_init', 'nswi requires limag true', 1)
    IF (eliashberg .AND. nswi < 0) &
      CALL errore('eliashberg_init', 'nswi should be > 0', 1)
    IF (eliashberg .AND. wscut < 0.d0 ) &
      CALL errore('eliashberg_init', 'wscut should be > 0.d0', 1)
    IF (eliashberg .AND. nsiter < 1) &
      CALL errore('eliashberg_init', 'wrong number of nsiter', 1)
    IF (eliashberg .AND. muc < 0.d0) &
      CALL errore('eliashberg_init', 'muc should be >= 0.d0', 1)
    IF (eliashberg .AND. (rand_k .OR. rand_q) .AND. (fila2f == ' ')) &
      CALL errore('eliashberg_init', 'eliashberg requires a uniform grid when fila2f is not used', 1)
    IF (eliashberg .AND. (MOD(nkf1, nqf1) /= 0 .OR. MOD(nkf2, nqf2) /= 0 .OR. MOD(nkf3, nqf3) /= 0 ) .AND. (fila2f == ' ')) &
      CALL errore('eliashberg_init', &
                  'eliashberg requires nkf1,nkf2,nkf3 to be multiple of nqf1,nqf2,nqf3 when fila2f is not used', 1)
    IF (eliashberg .AND. tc_linear .AND. (lreal .OR. laniso)) &
      CALL errore('eliashberg_init', 'tc_linear cannot be used with lreal or laniso true', 1)
    IF (eliashberg .AND. tc_linear .AND. fbw) &
      CALL errore('eliashberg_init', 'tc_linear cannot be used with fbw true', 1)
    IF (eliashberg .AND. fbw .AND. lacon) &
      CALL errore('eliashberg_init', &
                  'Analytic continuation of Eliashberg equations is not implemented for fbw true', 1)
    IF (eliashberg .AND. (gridsamp < -1 .OR. gridsamp > 1)) &
      CALL errore('eliashberg_init', 'gridsamp must be: -1, 0, or 1', 1)
    IF (eliashberg .AND. tc_linear .AND. .NOT. (tc_linear_solver == 'lapack' .OR. tc_linear_solver == 'power')) &
      CALL errore('eliashberg_init', 'tc_linear_solver must be either lapack or power', 1)
    !
    ! Ryd to eV
    gtemp(:) = gtemp(:) * ryd2ev
    !
    IF (.NOT. elph .AND. .NOT. ep_coupling) THEN
      !
      ! We need BZ info to write FS files
      IF (mpime == ionode_id) THEN
        !
        OPEN(UNIT = crystal, FILE = 'crystal.fmt', STATUS = 'old', IOSTAT = ios)
        IF (ios /= 0) CALL errore('eliashberg_init', 'error opening crystal.fmt', crystal)
        READ(crystal, *) nat
        READ(crystal, *) !nmodes
        READ(crystal, *) !nelec
        READ(crystal, *) at 
        READ(crystal, *) bg
        READ(crystal, *) !omega
        READ(crystal, *) !alat
        ALLOCATE(tau(3, nat), STAT = ierr)
        IF (ierr /= 0) CALL errore('eliashberg_init', 'Error allocating tau', 1)
        READ(crystal, *) tau
        READ(crystal, *) amass
        ALLOCATE(ityp(nat), STAT = ierr)
        IF (ierr /= 0) CALL errore('eliashberg_init', 'Error allocating ityp', 1)
        READ(crystal, *) ityp
        READ(crystal, *) noncolin
        READ(crystal, *) !w_centers
        !
        ! no need further
        DEALLOCATE(tau, STAT = ierr)
        IF (ierr /= 0) CALL errore('eliashberg_init', 'Error deallocating tau', 1)
        DEALLOCATE(ityp, STAT = ierr)
        IF (ierr /= 0) CALL errore('eliashberg_init', 'Error deallocating ityp', 1)
        CLOSE(crystal)
      ENDIF ! mpime == ionode_id
      CALL mp_bcast(noncolin, ionode_id, world_comm)
      CALL mp_bcast(bg, ionode_id, world_comm)
    ENDIF ! .not. elph .and. .not. ep_coupling
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE eliashberg_init
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE eliashberg_grid()
    !-----------------------------------------------------------------------
    !!
    !! This routine initializes the point grids to solve the
    !! eliashberg equations on real and imag axis
    !!
    !! SH: Modified for sparse sampling of Matsubara frequencies (Nov 2021).
    !! RM: Removed variables lunif, nswfc, nswc, wsfc, pwc (Nov 2021).
    !
    USE kinds,           ONLY : DP
    USE io_global,       ONLY : stdout
    USE epwcom,          ONLY : nqstep, nswi, nstemp, lreal, lpade, limag, & 
                                lacon, wscut, gridsamp
    USE elph2,           ONLY : gtemp
    USE constants_epw,   ONLY : eps6
    USE constants,       ONLY : pi
    USE eliashbergcom,   ONLY : nsw, nsiw, wsphmax
    USE io_var,          ONLY : iufilmat
    !
    IMPLICIT NONE
    !
    INTEGER :: itemp
    !! Counter on temperature values
    INTEGER :: ierr
    !! Error status
    !
    IF (lreal) THEN
      IF (ABS(wscut) < eps6) THEN
        wscut = 10.d0 * wsphmax
      ENDIF
      nsw = nqstep * NINT(wscut / wsphmax)
      IF (nsw == 0) CALL errore('eliashberg_grid', 'wrong number of nsw', 1)
    ENDIF
    !    
    IF (limag) THEN
      ! SH: Sparse sampling; gridsamp = -1 is a debug/development option
      !       once set, code reads in the Matsubara indices from file.
      IF (gridsamp == -1) THEN
        nswi = 0
        OPEN(UNIT = iufilmat, FILE = 'matsu-freq.in', STATUS = 'old', IOSTAT = ierr)
        IF (ierr /= 0) CALL errore('eliashberg_grid', 'Error opening matsu-freq.in', iufilmat)
        nswi = -1
        ierr = 0
        DO WHILE (ierr == 0)
          nswi = nswi + 1
          READ(iufilmat, *, IOSTAT = ierr)
        ENDDO
        CLOSE(iufilmat)
        nsiw(:) = nswi
        IF ((2.d0 * nswi + 1) * pi * gtemp(1) > wscut) THEN
          wscut = (2.d0 * DBLE(nswi) + 1.d0) * pi * gtemp(1)
        ENDIF
      ENDIF
      ! SH: Sparse sampling; with gridsamp = 0 a uniform grid will be generated,
      !       while the gridsamp = 1 generates a grid with points distanced exponentially
      !       from one another (so, sparse sampling!)
      IF (gridsamp >= 0) THEN
        ALLOCATE(nsiw(nstemp), STAT = ierr)
        IF (ierr /= 0) CALL errore('eliashberg_grid', 'Error allocating nsiw', 1)
        nsiw(:) = 0
        IF (nswi > 0) THEN
          nsiw(:) = nswi
        ELSEIF (wscut > 0.d0) THEN
          DO itemp = 1, nstemp
            nsiw(itemp) = INT(0.5d0 * (wscut / pi / gtemp(itemp) - 1.d0)) + 1
          ENDDO
        ELSEIF (nswi > 0 .AND. wscut > 0.d0) THEN
          nsiw(:) = nswi
          WRITE(stdout,'(5x,a)') 'when nswi > 0, wscut is not used for limag=.TRUE.'
        ENDIF
        IF (ABS(wscut) < eps6) THEN
          wscut = 10.d0 * wsphmax
        ENDIF
      ENDIF
    ENDIF
    !
    IF (lpade .OR. lacon) THEN
      nsw = nqstep * NINT(wscut / wsphmax)
      IF (nsw == 0) CALL errore('eliashberg_grid', 'wrong number of nsw', 1)
    ENDIF
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE eliashberg_grid
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE evaluate_a2f_lambda
    !-----------------------------------------------------------------------
    !!
    !! computes the isotropic spectral function a2F(w), total lambda, and
    !! distribution of lambda
    !!
    !! SH: The "phdos" parts are moved to write_phdos subroutine, and
    !!       "a2f_iso" file is not being written anymore (Nov 2021).
    !!
    !
    USE kinds,         ONLY : DP
    USE io_var,        ONLY : iua2ffil, iudosfil, iufillambda, iufillambdaFS
    USE io_files,      ONLY : prefix
    USE modes,         ONLY : nmodes
    USE cell_base,     ONLY : bg
    USE control_flags, ONLY : iverbosity
    USE elph2,         ONLY : nqtotf, wqf, wf
    USE epwcom,        ONLY : fsthick, eps_acustic, nqstep, degaussq, delta_qsmear, nqsmear, &
                              degaussw, nkf1, nkf2, nkf3
    USE eliashbergcom, ONLY : nkfs, nbndfs, g2, ixkqf, ixqfs, nqfs, w0g, ekfs, ef0, dosef, wsph, &
                              wkfs, dwsph, ixkff
    USE constants_epw, ONLY : ryd2ev, eps2, zero, eps16
    USE io_global,     ONLY : stdout, ionode_id
    USE mp_global,     ONLY : inter_pool_comm, my_pool_id, npool
    USE mp_world,      ONLY : mpime
    USE mp,            ONLY : mp_bcast, mp_barrier, mp_sum
    USE division,      ONLY : fkbounds
    !
    IMPLICIT NONE
    !
    CHARACTER(LEN = 256) :: name1
    !! file name
    !
    INTEGER :: ik
    !! Counter on k-points
    INTEGER :: iq
    !! Counter on q-points
    INTEGER :: iq0
    !! Index of iq on full q-mesh
    INTEGER :: ibnd, jbnd
    !! Counter on bands
    INTEGER :: imode
    !! Counter on mode
    INTEGER :: lower_bnd, upper_bnd
    !! Lower/upper bound index after k or q parallelization
    INTEGER :: iwph
    !! Counter over frequncy
    INTEGER :: ismear
    !! Counter on smearings
    INTEGER :: ibin
    !! Counter on bins
    INTEGER :: nbin, nbink
    !! Number of bins
    INTEGER :: i, j, k
    !! Counter on grid points nkf1, nkf2, nkf3
    INTEGER :: ios
    !! IO error message
    INTEGER :: ierr
    !! Error status
    !
    REAL(KIND = DP) :: dbin, dbink
    !! Step size in nbin/nbink
    REAL(KIND = DP):: l_sum
    !! total e-ph coupling strength
    REAL(KIND = DP):: l_a2f_tmp
    !! Temporary variable for total e-ph coupling strength
    REAL(KIND = DP):: lambda_eph
    !! total e-ph coupling strength (a2f integration)
    REAL(KIND = DP) :: x1, x2, x3
    !! Cartesian coordinates of grid points nkf1, nkf2, nkf3
    REAL(KIND = DP) :: weight, weight2, weight3, weightq
    !! factors in lambda_eph and a2f
    REAL(KIND = DP) :: sigma
    !! smearing in delta function
    REAL(KIND = DP), EXTERNAL :: w0gauss
    !! The derivative of wgauss:  an approximation to the delta function
    REAL(KIND = DP) :: lambda_max(npool)
    !! Max e-ph coupling strength among all pools
    REAL(KIND = DP), ALLOCATABLE :: l_a2f(:, :)
    !! total e-ph coupling strength for different ismear (a2f integration)
    REAL(KIND = DP), ALLOCATABLE :: lambda_pairs(:)
    !! Histogram lambda_nk,n'k
    REAL(KIND = DP), ALLOCATABLE :: lambda_k_bin(:)
    !! Histogram lambda_nk
    REAL(KIND = DP), ALLOCATABLE :: a2f(:, :)
    !! Eliashberg sperctral function for different ismear
    REAL(KIND = DP), ALLOCATABLE :: a2f_modeproj(:, :)
    !! Eliashberg sperctral function projected over modes for different ismear
    REAL(KIND = DP), ALLOCATABLE :: lambda_k(:, :)
    !! anisotropic e-ph coupling strength
    !
    ! This is only a quick fix since the routine was written for parallel execution - FG June 2014
#if !defined(__MPI)
    npool = 1
    my_pool_id = 0
#endif
    !
    ! degaussq is read from the input file in meV and converted to Ryd in epw_readin.f90
    ! go from Ryd to eV
    degaussq = degaussq * ryd2ev
    delta_qsmear = delta_qsmear * ryd2ev
    !
    CALL fkbounds(nkfs, lower_bnd, upper_bnd)
    !
    ALLOCATE(a2f(nqstep, nqsmear), STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error allocating a2f', 1)
    ALLOCATE(a2f_modeproj(nmodes, nqstep), STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error allocating a2f_modeproj', 1)
    a2f(:, :) = zero
    a2f_modeproj(:, :) = zero
    !
    ! RM - the 0 index in k is required when printing out values of lambda_k
    ! When the k-point is outside the Fermi shell, ixkff(ik)=0
    ALLOCATE(lambda_k(0:nkfs, nbndfs), STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error allocating lambda_k', 1)
    lambda_k(:, :) = zero
    !
    l_sum = zero
    lambda_max(:) = zero
    DO ismear = 1, nqsmear
      sigma = degaussq + (ismear - 1) * delta_qsmear
      DO ik = lower_bnd, upper_bnd
        DO ibnd = 1, nbndfs
          IF (ABS(ekfs(ibnd, ik) - ef0) < fsthick) THEN
            DO iq = 1, nqfs(ik)
              ! iq0 - index of q-point on the full q-mesh
              iq0 = ixqfs(ik, iq)
              DO jbnd = 1, nbndfs
                IF (ABS(ekfs(jbnd, ixkqf(ik, iq0)) - ef0) < fsthick) THEN
                  weight = wkfs(ik) * wqf(iq) * w0g(ibnd, ik) * w0g(jbnd, ixkqf(ik, iq0))
                  lambda_eph = 0.d0
                  DO imode = 1, nmodes
                    IF (wf(imode, iq0) > eps_acustic) THEN
                      IF (ismear == 1) THEN
                        lambda_eph = lambda_eph + g2(ik, iq, ibnd, jbnd, imode) / wf(imode, iq0)
                      ENDIF
                      weight2 = weight * g2(ik, iq, ibnd, jbnd, imode)
                      DO iwph = 1, nqstep
                        weightq  = w0gauss((wsph(iwph) - wf(imode, iq0)) / sigma, 0) / sigma
                        a2f(iwph, ismear) = a2f(iwph, ismear) + weight2 * weightq 
                        IF (ismear == 1) THEN
                          a2f_modeproj(imode, iwph) = a2f_modeproj(imode, iwph) + &
                                       weight2 * weightq 
                        ENDIF
                      ENDDO ! iwph
                    ENDIF ! wf
                  ENDDO ! imode
                  IF (ismear == 1 .AND. lambda_eph > 0.d0) THEN
                    l_sum = l_sum + weight * lambda_eph
                    weight3 = wqf(iq) * w0g(jbnd, ixkqf(ik, iq0))
                    lambda_k(ik, ibnd) = lambda_k(ik, ibnd) + weight3 * lambda_eph
                    IF (lambda_eph > lambda_max(my_pool_id + 1)) THEN
                      lambda_max(my_pool_id + 1) = lambda_eph
                    ENDIF
                  ENDIF
                ENDIF ! ekq
              ENDDO ! jbnd
            ENDDO ! iq
          ENDIF ! ekk
        ENDDO ! ibnd
      ENDDO ! ik
    ENDDO ! ismear
    !
    a2f(:, :) = 0.5d0 * a2f(:, :) / dosef
    a2f_modeproj(:, :) = 0.5d0 * a2f_modeproj(:, :) / dosef
    l_sum = l_sum / dosef
    lambda_k(:, :) = 2.d0 * lambda_k(:, :)
    lambda_max(:) = 2.d0 * dosef * lambda_max(:)
    !
    ! collect contributions from all pools (sum over k-points)
    CALL mp_sum(l_sum, inter_pool_comm)
    CALL mp_sum(a2f, inter_pool_comm)
    CALL mp_sum(a2f_modeproj, inter_pool_comm)
    CALL mp_sum(lambda_max, inter_pool_comm)
    CALL mp_sum(lambda_k, inter_pool_comm)
    CALL mp_barrier(inter_pool_comm)
    !
    IF (mpime == ionode_id) THEN
      !
      !
      name1 = TRIM(prefix) // '.a2f'
      OPEN(UNIT = iua2ffil, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
      IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iua2ffil)
      !
      ALLOCATE(l_a2f(nqstep, nqsmear), STAT = ierr)
      IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error allocating l_a2f', 1)
      l_a2f(:, :) = zero
      !
      DO ismear = 1, nqsmear
        IF (ismear == nqsmear) THEN
          WRITE(iua2ffil, '(" w[meV] a2f and integrated 2*a2f/w for ", i4, " smearing values")') ismear
        ENDIF
        l_a2f_tmp = zero
        DO iwph = 1, nqstep
          l_a2f_tmp = l_a2f_tmp + 2.0d0 * (a2f(iwph, ismear) / wsph(iwph)) * dwsph
          l_a2f(iwph, ismear) = l_a2f_tmp
          ! wsph in meV (from eV) 
          IF (ismear == nqsmear) THEN
            WRITE(iua2ffil, '(f12.7, 20f12.7)') wsph(iwph) * 1000.d0, a2f(iwph, :), l_a2f(iwph, :)
          ENDIF
        ENDDO
      ENDDO
      !
      WRITE(iua2ffil, *) "Integrated el-ph coupling"
      WRITE(iua2ffil, '("  #         ", 15f12.7)') l_a2f(nqstep, :)
      WRITE(iua2ffil, *) "Phonon smearing (meV)"
      WRITE(iua2ffil, '("  #         ", 15f12.7)') ((degaussq + (ismear - 1) * delta_qsmear) * 1000.d0, ismear = 1, nqsmear)
      WRITE(iua2ffil, '("Electron smearing (eV)", f12.7)') degaussw
      WRITE(iua2ffil, '("Fermi window (eV)", f12.7)') fsthick
      WRITE(iua2ffil, '("Summed el-ph coupling ", f12.7)') l_sum
      CLOSE(iua2ffil)
      !
      name1 = TRIM(prefix) // '.a2f_proj'
      OPEN(UNIT = iua2ffil, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
      IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iua2ffil)
      !
      WRITE(iua2ffil, '("w[meV] a2f a2f_modeproj")')
      DO iwph = 1, nqstep
        ! wsph in meV (from eV)
        WRITE(iua2ffil, '(f12.7, 100f12.7)') wsph(iwph) * 1000.d0, a2f(iwph, 1), a2f_modeproj(:, iwph)
      ENDDO
      WRITE(iua2ffil, '(a, f18.7, a, f18.7)') 'lambda_int = ', l_a2f(nqstep, 1), '   lambda_sum = ',l_sum
      CLOSE(iua2ffil)
      !
      DEALLOCATE(l_a2f, STAT = ierr)
      IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error deallocating l_a2f', 1)
      !
    ENDIF
    !
    DEALLOCATE(a2f, STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error deallocating a2f', 1)
    DEALLOCATE(a2f_modeproj, STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error deallocating a2f_modeproj', 1)
    !
    nbink = NINT(1.1d0 * MAXVAL(lambda_k(:, :)) / eps2) + 1
    dbink = 1.1d0 * MAXVAL(lambda_k(:, :)) / DBLE(nbink)
    !
    ALLOCATE(lambda_k_bin(nbink), STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error allocating lambda_k_bin', 1)
    lambda_k_bin(:) = zero
    !
    nbin = 0
    dbin = zero
    IF (iverbosity == 2) THEN
      nbin = NINT(1.1d0 * MAXVAL(lambda_max(:)) / eps2) + 1
      dbin = 1.1d0 * MAXVAL(lambda_max(:)) / DBLE(nbin)
      ALLOCATE(lambda_pairs(nbin), STAT = ierr)
      IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error allocating lambda_pairs', 1)
      lambda_pairs(:) = zero
    ENDIF
    !
    lambda_k(:, :) = zero
    DO ik = lower_bnd, upper_bnd
      DO ibnd = 1, nbndfs
        IF (ABS(ekfs(ibnd, ik) - ef0 ) < fsthick) THEN
          DO iq = 1, nqfs(ik)
            ! iq0 - index of q-point on the full q-mesh
            iq0 = ixqfs(ik, iq)
            DO jbnd = 1, nbndfs
              IF (ABS(ekfs(jbnd, ixkqf(ik, iq0)) - ef0) < fsthick) THEN
                weight = wqf(iq) * w0g(jbnd, ixkqf(ik, iq0)) / dosef
                lambda_eph = zero
                DO imode = 1, nmodes
                  IF (wf(imode, iq0) > eps_acustic) THEN
                    lambda_eph = lambda_eph + g2(ik, iq, ibnd, jbnd, imode) / wf(imode,iq0)
                  ENDIF
                ENDDO
                lambda_eph = 2.d0 * lambda_eph * dosef
                lambda_k(ik, ibnd) = lambda_k(ik, ibnd) +  weight * lambda_eph
                IF (iverbosity == 2) THEN
                  ibin = NINT(lambda_eph / dbin) + 1
                  weight2 =  w0g(ibnd, ik) * w0g(jbnd,ixkqf(ik, iq0))
                  lambda_pairs(ibin) = lambda_pairs(ibin) + weight2
                ENDIF
              ENDIF
            ENDDO ! jbnd
          ENDDO ! iq
          ibin = NINT(lambda_k(ik, ibnd) / dbink) + 1
          weight3 = w0g(ibnd, ik)
          lambda_k_bin(ibin) = lambda_k_bin(ibin) + weight3
        ENDIF
      ENDDO ! ibnd
    ENDDO ! ik
    !
    ! collect contributions from all pools
    CALL mp_sum(lambda_k, inter_pool_comm)
    IF (iverbosity == 2) THEN
      CALL mp_sum(lambda_pairs, inter_pool_comm)
    ENDIF
    CALL mp_sum(lambda_k_bin, inter_pool_comm)
    CALL mp_barrier(inter_pool_comm)
    !
    IF (mpime == ionode_id) THEN
      !
      ! SP: Produced if user really wants it
      IF (iverbosity == 2) THEN
        name1 = TRIM(prefix) // '.lambda_aniso'
        OPEN(UNIT = iufillambda, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
        IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iufillambda)
        WRITE(iufillambda, '(2a12, 2a7)') '# Enk-Ef[eV]', '  lambda_nk', '# kpt', '# band'
        DO ik = 1, nkfs
          DO ibnd = 1, nbndfs
            IF (ABS(ekfs(ibnd, ik) - ef0) < fsthick) THEN
              WRITE(iufillambda, '(2f12.7, 2i7)') ekfs(ibnd, ik) - ef0, lambda_k(ik, ibnd), ik, ibnd
            ENDIF
          ENDDO
        ENDDO
        CLOSE(iufillambda)
      ENDIF
      !
      name1 = TRIM(prefix) // '.lambda_k_pairs'
      OPEN(UNIT = iufillambda, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
      IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iufillambda)
      WRITE(iufillambda, '(a12, a30)') '# lambda_nk','  \rho(lambda_nk) scaled to 1'
      DO ibin = 1, nbink
        WRITE(iufillambda,'(2f21.7)') dbink * DBLE(ibin), lambda_k_bin(ibin) / MAXVAL(lambda_k_bin(:))
      ENDDO
      CLOSE(iufillambda)
      !
      ! SP: Produced if user really wants it
      IF (iverbosity == 2) THEN
        name1 = TRIM(prefix) // '.lambda_pairs'
        OPEN(UNIT = iufillambda, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
        IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iufillambda)
        WRITE(iufillambda, '(a12, a30)') "# lambda_nk,n'k'", "  \rho(lambda_nk,n'k') scaled to 1"
        DO ibin = 1, nbin
          WRITE(iufillambda, '(2f21.7)') dbin * DBLE(ibin), lambda_pairs(ibin) / MAXVAL(lambda_pairs(:))
        ENDDO
        CLOSE(iufillambda)
      ENDIF
      !
      ! SP & RM: .cube file for VESTA plotting (only if iverbosity = 2)
      !
      ! RM - If the k-point is outside the Fermi shell,
      ! ixkff(ik)=0 and lambda_k(0,ibnd) = 0.0
      !
      IF (iverbosity == 2) THEN
        !
        DO ibnd = 1, nbndfs
          !
          IF (ibnd < 10) THEN
            WRITE(name1, '(a, a8, i1, a5)') TRIM(prefix), '.lambda_', ibnd, '.cube'
          ELSEIF (ibnd < 100) THEN
            WRITE(name1, '(a, a8, i2, a5)') TRIM(prefix), '.lambda_', ibnd, '.cube'
          ELSEIF( ibnd < 1000) THEN
            WRITE(name1,'(a, a8, i3, a5)') TRIM(prefix), '.lambda_', ibnd, '.cube'
          ELSE
            CALL errore( 'eliashberg_setup', 'Too many bands ',1)
          ENDIF
          !
          OPEN(iufillambdaFS, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
          IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iufillambdaFS)
          WRITE(iufillambdaFS, *) 'Cubfile created from EPW calculation'
          WRITE(iufillambdaFS, *) 'lambda'
          WRITE(iufillambdaFS, '(i5, 3f12.6)') 1, 0.0d0, 0.0d0, 0.0d0
          WRITE(iufillambdaFS, '(i5, 3f12.6)') nkf1, (bg(i, 1) / DBLE(nkf1), i = 1, 3)
          WRITE(iufillambdaFS, '(i5, 3f12.6)') nkf2, (bg(i, 2) / DBLE(nkf2), i = 1, 3)
          WRITE(iufillambdaFS, '(i5, 3f12.6)') nkf3, (bg(i, 3) / DBLE(nkf3), i = 1, 3)
          WRITE(iufillambdaFS, '(i5, 4f12.6)') 1, 1.0d0, 0.0d0, 0.0d0, 0.0d0
          WRITE(iufillambdaFS, '(6f12.6)') (lambda_k(ixkff(ik), ibnd), ik = 1, nkf1 * nkf2 * nkf3)
          CLOSE(iufillambdaFS)
        ENDDO
        ! HP: Write in .frmsf format compatible with fermisurfer program
        WRITE(name1, '(a, a13)') TRIM(prefix), '.lambda.frmsf'
        OPEN(UNIT = iufillambdaFS, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
        IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iufillambdaFS)
        !
        WRITE(iufillambdaFS, '(3i5)') nkf1, nkf2, nkf3
        WRITE(iufillambdaFS, '(i5)') 1
        WRITE(iufillambdaFS, '(i5)') nbndfs
        WRITE(iufillambdaFS, '(3f12.6)') (bg(i, 1), i = 1, 3)
        WRITE(iufillambdaFS, '(3f12.6)') (bg(i, 2), i = 1, 3)
        WRITE(iufillambdaFS, '(3f12.6)') (bg(i, 3), i = 1, 3)
        WRITE(iufillambdaFS, '(6f12.6)') ((ekfs(ibnd, ixkff(ik)) - ef0, ik = 1, nkf1 * nkf2 * nkf3), ibnd = 1, nbndfs)
        WRITE(iufillambdaFS, '(6f12.6)') ((lambda_k(ixkff(ik), ibnd), ik = 1, nkf1 * nkf2 * nkf3), ibnd = 1, nbndfs)
        CLOSE(iufillambdaFS)
        !
      ENDIF
      !
      ! SP & RM : Write on file the lambda close to the Fermi surface along with
      ! Cartesian coordinate, band index, energy distance from Fermi level
      ! and lambda value.
      !
      name1 = TRIM(prefix) // '.lambda_FS'
      OPEN(iufillambdaFS, FILE = name1, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
      IF (ios /= 0) CALL errore('evaluate_a2f_lambda', 'error opening file ' // name1, iufillambdaFS)
      WRITE(iufillambdaFS,'(a75)') '#               k-point                  Band Enk-Ef [eV]            lambda'
      DO i = 1, nkf1
        DO j = 1, nkf2
          DO k = 1, nkf3
            ik = k + (j - 1) * nkf3 + (i - 1) * nkf2 * nkf3
            IF (ixkff(ik) > 0) THEN
              DO ibnd = 1, nbndfs
                ! SP: Here take a 0.2 eV interval around the FS.
                IF (ABS(ekfs(ibnd, ixkff(ik)) - ef0) < fsthick) THEN
                !IF (ABS(ekfs(ibnd, ixkff(ik)) - ef0) < 0.2) THEN
                  x1 = bg(1, 1) * (i - 1) / nkf1 + bg(1, 2) * (j - 1) / nkf2 + bg(1, 3) * (k - 1) / nkf3
                  x2 = bg(2, 1) * (i - 1) / nkf1 + bg(2, 2) * (j - 1) / nkf2 + bg(2, 3) * (k - 1) / nkf3
                  x3 = bg(3, 1) * (i - 1) / nkf1 + bg(3, 2) * (j - 1) / nkf2 + bg(3, 3) * (k - 1) / nkf3
                  WRITE(iufillambdaFS, '(3f12.6, i8, f12.6, f24.15)') x1, x2, x3, ibnd, &
                                   ekfs(ibnd, ixkff(ik)) - ef0, lambda_k(ixkff(ik), ibnd)
                ENDIF
              ENDDO ! ibnd
            ENDIF
          ENDDO  ! k
        ENDDO ! j
      ENDDO ! i
      CLOSE(iufillambdaFS)
      !
    ENDIF
    CALL mp_barrier(inter_pool_comm)
    !
    DEALLOCATE(lambda_k, STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error deallocating lambda_k', 1)
    DEALLOCATE(lambda_k_bin, STAT = ierr)
    IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error deallocating lambda_k_bin', 1)
    IF (iverbosity == 2) THEN
      DEALLOCATE(lambda_pairs, STAT = ierr)
      IF (ierr /= 0) CALL errore('evaluate_a2f_lambda', 'Error deallocating lambda_pairs', 1)
    ENDIF
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE evaluate_a2f_lambda
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE estimate_tc_gap()
    !-----------------------------------------------------------------------
    !!
    !! This routine estimates the Tc using Allen-Dynes formula and
    !! the BCS superconducting gap as the initial guess for delta
    !!
    !! SH: Updated to write the machine learning estimate for Tc, and
    !!       to limit the "gap0" to 6 decimal digits (Nov 2021).
    !!
    USE kinds,            ONLY : DP
    USE epwcom,           ONLY : nqstep, muc, nstemp
    USE elph2,            ONLY : gtemp
    USE eliashbergcom,    ONLY : wsph, dwsph, a2f_iso, gap0
    USE constants_epw,    ONLY : kelvin2eV, zero
    USE noncollin_module, ONLY : noncolin
    USE io_global,        ONLY : stdout, ionode_id
    USE mp_global,        ONLY : inter_pool_comm
    USE mp_world,         ONLY : mpime
    USE mp,               ONLY : mp_bcast, mp_barrier, mp_sum
    !
    IMPLICIT NONE
    !
    INTEGER :: iwph
    !! Counter on frequencies
    !
    REAL(KIND = DP):: l_a2f
    !! total e-ph coupling strength (a2f integration)
    REAL(KIND = DP):: logavg
    !! logavg phonon frequency
    REAL(KIND = DP):: tc
    !! superconding critical temperature
    REAL(KIND = DP):: tcml
    !! Estimated ML Tc
    REAL(KIND = DP):: momavg
    !! avg. of 2nd moment of frequencies
    REAL(KIND = DP):: fomega, fmu
    !! coefficients of ML-based Tc
    !
    IF (mpime == ionode_id) THEN
      l_a2f  = zero
      logavg = zero
      momavg = zero
      DO iwph = 1, nqstep
        l_a2f  = l_a2f  + a2f_iso(iwph) / wsph(iwph)
        logavg = logavg + a2f_iso(iwph) * log(wsph(iwph)) / wsph(iwph)
        momavg = momavg + a2f_iso(iwph) * wsph(iwph) * dwsph
      ENDDO
      l_a2f  = l_a2f  * 2.d0 * dwsph
      logavg = logavg * 2.d0 * dwsph
      logavg = EXP(logavg / l_a2f)
      momavg = DSQRT(2.d0 * momavg / l_a2f)
      WRITE(stdout,'(5x,a,f12.7)') 'Electron-phonon coupling strength = ', l_a2f
      WRITE(stdout,'(a)') ' '
      !
      ! Allen-Dynes estimate of Tc
      !
      tc = logavg / 1.2d0 * EXP(-1.04d0 * (1.d0 + l_a2f) &
                                / (l_a2f - muc * (1.d0 + 0.62d0 * l_a2f)))
      !
      ! SH: ML-based estimate of the Tc (Eqns. [6-8]; Xie et. al.; arXiv:2106.05235)
      !
      fomega = 1.92d0 * ((l_a2f + (logavg / momavg) - muc**(1.d0 / 3.d0)) / &
               (DSQRT(l_a2f) * EXP(logavg / momavg))) - 0.08d0
      fmu    = (6.86d0 * EXP(-l_a2f / muc)) / ((1.d0 / l_a2f) - muc - &
              (logavg / momavg)) + 1.d0
      tcml   = (fomega * fmu * logavg / 1.20d0) * EXP(- (1.04d0 * (1 + l_a2f)) / &
               (l_a2f - muc * (1 + 0.62d0 * l_a2f)))
      tcml   = tcml / kelvin2eV
      !
      ! initial guess for the gap edge using BCS superconducting ratio 3.52
      !
      ! SH: the "estimated gap" is restricted to 6 decimal places (in meV units) 
      !       for consistency with the gap_from_a2f function. That's, by applying
      !       NINT(gap[eV] * 1.d9) / 1.d9
      gap0 = NINT(3.52d0 * tc / 2.d0 * 1.d9) / 1.d9
      IF (gap0 <= 0.d0) &
        CALL errore('estimate_tc_gap', 'initial guess for gap edge should be > 0.d0', 1)
      !
      ! tc in K
      !
      tc = tc / kelvin2eV
      WRITE(stdout, '(5x, a, f12.6, a, f10.5)') 'Estimated Allen-Dynes Tc = ', tc, ' K for muc = ', muc
      WRITE(stdout, '(a)') '  '
      WRITE(stdout, '(5x, a, f12.6, a)') 'Estimated w_log in Allen-Dynes Tc = ', logavg * 1000.d0, ' meV'
      WRITE(stdout, '(a)') '  '
      WRITE(stdout, '(5x, a, f12.6, a)') 'Estimated BCS superconducting gap = ', gap0 * 1000.d0, ' meV'
      WRITE(stdout, '(a)') '  '
      WRITE(stdout, '(5x, a, f12.6, a)') 'Estimated Tc from machine learning model = ', tcml , ' K'
      WRITE(stdout, '(a)') '  '
      !
      IF (gtemp(1) / kelvin2eV > tc) THEN
        WRITE(stdout, '(a)') '  '
        WRITE(stdout, '(5x, a)') 'WARNING WARNING WARNING '
        WRITE(stdout, '(a)') '  '
        WRITE(stdout, '(5x, a, f9.3, a, f9.3, a)') 'The code may crash since tempsmin =', &
                        gtemp(1) / kelvin2eV, ' K is larger than Allen-Dynes Tc = ', tc, ' K'
      ELSEIF (gtemp(nstemp) / kelvin2eV > tc) THEN
        WRITE(stdout, '(a)') '  '
        WRITE(stdout, '(5x, a)') 'WARNING WARNING WARNING '
        WRITE(stdout, '(a)') '  '
        WRITE(stdout, '(5x, a, f9.3, a, f9.3, a)') 'The code may crash since tempsmax =', &
                        gtemp(nstemp) / kelvin2eV, ' K is larger than Allen-Dynes Tc = ', tc, ' K'
      ENDIF
      !
      ! HP: muc needs to be divided by 2 to make consistent with the el-ph contribution
      ! in the SOC calculation
      IF(noncolin) muc = muc / 2.d0
      !
    ENDIF
    CALL mp_bcast(muc, ionode_id, inter_pool_comm)
    CALL mp_bcast(gap0, ionode_id, inter_pool_comm)
    CALL mp_barrier(inter_pool_comm)
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE estimate_tc_gap
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE find_a2f()
    !-----------------------------------------------------------------------
    !!
    !! HP: Read the eliashberg spectral function from a2f file if present,
    !!     otherwise evaluate it and estimate the Tc and initial gap value.
    !!     This is to save time once starting the iso/aniso runs (3/2022).
    !!
    USE kinds,         ONLY : DP
    USE io_global,     ONLY : stdout
    USE io_files,      ONLY : prefix
    USE epwcom,        ONLY : fila2f, degaussq, delta_qsmear
    USE eliashbergcom, ONLY : wsphmax, wsph
    USE constants_epw, ONLY : ryd2ev
    !
    IMPLICIT NONE
    !
    ! Local variables
    LOGICAL :: exst
    !! Does the file exist
    INTEGER :: ierr
    !! Error status
    !
    IF (fila2f == ' ') WRITE(fila2f, '(a, a4)') TRIM(prefix), '.a2f'
    INQUIRE(FILE = fila2f, EXIST = exst)
    IF (exst) THEN
      WRITE(stdout, '(5x,a)') 'a2f file is found and will be used to estimate initial gap'
      WRITE(stdout, '(a)')    ' '
      !
      ! This is needed because we do not call evaluate_a2f_lambda
      degaussq = degaussq * ryd2ev
      delta_qsmear = delta_qsmear * ryd2ev
    ELSE
      WRITE(stdout, '(5x,a)') &
        'a2f file is not found to estimate initial gap: calculating a2f files'
      WRITE(stdout, '(a)')    ' '
      CALL evaluate_a2f_lambda
    ENDIF
    !
    ! HP: this is requred to make consistient in iso/aniso calculation
    IF (wsphmax > 0.d0) THEN
      ! read_frequencies
      DEALLOCATE(wsph, STAT = ierr)
      IF (ierr /= 0) CALL errore('find_a2f', 'Error deallocating wsph', 1)
    ENDIF
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE find_a2f
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE gen_freqgrid_raxis()
    !-----------------------------------------------------------------------
    !!
    !! Automatic generation of the frequency-grid for real-axis calculations.
    !!
    !
    USE io_global,     ONLY : stdout
    USE eliashbergcom, ONLY : nsw, ws, dwsph
    USE constants_epw, ONLY : zero
    !
    IMPLICIT NONE
    !
    INTEGER :: iw
    !! Counter over frequency
    INTEGER :: ierr
    !! Error status
    !
    ALLOCATE(ws(nsw), STAT = ierr)
    IF (ierr /= 0) CALL errore('gen_freqgrid_raxis', 'Error allocating ws', 1)
    ws(:) = zero
    !
    DO iw = 1, nsw
      ws(iw) = DBLE(iw) * dwsph
    ENDDO
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE gen_freqgrid_raxis
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE gen_freqgrid_iaxis(itemp)
    !-----------------------------------------------------------------------
    !!
    !! Automatic generation of the frequency-grid for imaginary-axis calculations.
    !!
    !! input
    !!
    !! itemp  - temperature point
    !!
    !! SH: Modified for sparse sampling of Matsubara frequencies (Nov 2021).
    !!
    !! =====================================================================
    !! SH: A note about definition of Matsubara indices/frequencies in epw
    !! RM: updated (Jan 2022)
    !! 
    !! In epw, the nsiw(itemp) is the cutoff for Matsubara indicies; i.e.,
    !!   the largest positive Matsubara index "n" is nsiw(itemp)-1.
    !! 
    !! nsiw(itemp) = INT(0.5d0 * (wscut / pi / gtemp(itemp) - 1.d0)) + 1
    !!
    !! So, for N=nsiw(itemp), indices are:
    !!
    !!     n=    -N, -(N-1), ..., -1, 0, 1, ...,  N-2,  N-1
    !!   and corresponding 2n+1 factor for frequencies are:
    !!     f= -2N+1,  -2N+3, ..., -1, 1, 3, ..., 2N-3, 2N-1
    !!
    !! The actual frequencies are non-symmetric with respect
    !!   to zero, i.e., the (2N-1)*pi*T has no negative counterpart, and
    !!   the rest are (in terms of 2n+1 factor):
    !!
    !!   F[-N] = -F[N-1]; ...; F[-1] = -F[0]
    !!
    !! With using the lambda_negative, the summations in Eliashberg eqns
    !!   in the epw run only over non-negative "n" indices. That's:
    !!
    !!   iw = 1, 2, ..., N
    !!   n  = 0, 1, ..., N-1
    !!   f  = 1, 3, ..., 2N+1
    !! =====================================================================
    !!
    !
    USE epwcom,        ONLY : lpade, lacon, laniso, gridsamp, griddens, tc_linear
    USE elph2,         ONLY : gtemp
    USE eliashbergcom, ONLY : nsw, nsiw, ws, wsi, dwsph, wsn
    USE constants_epw, ONLY : zero
    USE constants,     ONLY : pi
    USE low_lvl,       ONLY : mem_size_eliashberg
    USE io_var,        ONLY : iufilmat
    USE mp,            ONLY : mp_bcast, mp_barrier
    USE mp_global,     ONLY : inter_pool_comm
    USE io_global,     ONLY : stdout, ionode_id
    USE control_flags, ONLY : iverbosity
    USE mp_world,      ONLY : mpime
    !
    IMPLICIT NONE
    !
    INTEGER, INTENT(in) :: itemp
    !! Counter on temperature
    !
    ! Local variables
    CHARACTER(LEN = 7) :: schm
    !! Type of sampling
    INTEGER :: iw
    !! Counter over frequency
    INTEGER :: n
    !! Matsubara frequency index
    INTEGER(8) :: imelt
    !! Required allocation of memory
    INTEGER :: ierr
    !! Error status
    !
    IF (laniso) THEN
      ! memory allocated for wsi, wsn, and ws
      imelt = 2.d0 * nsiw(itemp) + nsw
      CALL mem_size_eliashberg(2, imelt)
    ENDIF
    !
    ALLOCATE(wsi(nsiw(itemp)), STAT = ierr)
    IF (ierr /= 0) CALL errore('gen_freqgrid_iaxis', 'Error allocating wsi', 1)
    !
    wsi(:) = zero
    !
    ! SH: Sparse sampling: 
    !       depending on gridsamp value generates a grid of Matsubara indices:
    !       (-1) read from file, (0) uniform grid, (1) sparse sampling.
    !     Note:
    !       - The wsn(nsiw(itemp)) array is introduces to keep the "indices"
    !       - The griddens (default=1.d0) controls grid density; larger values
    !         give denser mesh, and smaller than 1.d0 make the mesh more sparse
    !
    ALLOCATE(wsn(nsiw(itemp)), STAT = ierr)
    IF (ierr /= 0) CALL errore('gen_freqgrid_iaxis', 'Error allocating wsn', 1)
    !
    IF (mpime == ionode_id) THEN
      !
      ! Initiate sampling scheme names
      IF (gridsamp == -1) THEN
        schm = 'input  '
      ELSEIF (gridsamp == 0) THEN
        schm = 'uniform'
      ELSEIF (gridsamp == 1) THEN
        schm = 'sparse '
      END IF
      !
      ! input sampling
      IF (gridsamp == -1) THEN
        OPEN(UNIT = iufilmat, FILE = 'matsu-freq.in', STATUS = 'old', IOSTAT = ierr)
        IF (ierr /= 0) CALL errore('gen_freqgrid_iaxis', 'Error opening matsu-freq.in', iufilmat)
        DO iw = 1, nsiw(itemp)
          READ(iufilmat,*) n
          wsn(iw) = n
          wsi(iw) = DBLE(2 * n + 1) * pi * gtemp(itemp)
        ENDDO
        CLOSE(iufilmat)
      END IF
      ! uniform sampling
      IF (gridsamp == 0) THEN
        DO iw = 1, nsiw(itemp)
          n = iw - 1
          wsn(iw) = n
          wsi(iw) = DBLE(2 * n + 1) * pi * gtemp(itemp)
        END DO
      END IF
      ! sparse sampling
      IF (gridsamp == 1) THEN
        n  = 0
        iw = 0
        DO WHILE (n < nsiw(itemp))
          iw      = iw + 1
          wsn(iw) = n
          wsi(iw) = DBLE(2 * n + 1) * pi * gtemp(itemp)
          n = n + NINT(EXP(DBLE(n) / DBLE(nsiw(itemp)) / griddens))
        ENDDO
        ! update the number of freqs. to the true value
        nsiw(itemp) = iw
      END IF
      !
      ! output the indices to "matsu-freq*.out" file, if iverbosity = 2
      IF (iverbosity == 2) CALL write_matsubara_freq(itemp)
      !
      ! print actual number of Matsubara frequencies
      IF (.NOT. tc_linear) &
      WRITE(stdout, '(5x, a, i6, a, i6, a, a, a)') 'Actual number of frequency points (', &
        itemp, ') = ', nsiw(itemp), ' for ', schm, ' sampling'
      !
    ENDIF
    ! this is important! All cores should be aware of the grid.
    CALL mp_bcast(nsiw(itemp), ionode_id, inter_pool_comm)
    CALL mp_bcast(wsi, ionode_id, inter_pool_comm)
    CALL mp_bcast(wsn, ionode_id, inter_pool_comm)
    CALL mp_barrier(inter_pool_comm)
    !
    ! frequency-grid for real-axis ( Pade approximants and analytic continuation)
    !
    IF (lpade .OR. lacon) THEN
      ALLOCATE(ws(nsw), STAT = ierr)
      IF (ierr /= 0) CALL errore('gen_freqgrid_iaxis', 'Error allocating ws', 1)
      ws(:) = zero
      DO iw = 1, nsw
        ws(iw) = DBLE(iw) * dwsph
      ENDDO
    ENDIF
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE gen_freqgrid_iaxis
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE gamma_acont(omega, omegap, temp, rgammap, rgammam)
    !-----------------------------------------------------------------------
    !!
    !! computes gammam(w,wp)  (notes RM)
    !! reference F. Masiglio, M. Schossmann, and J. Carbotte, PRB 37, 4965 (1988)
    !!
    !
    USE kinds, ONLY : DP
    !
    IMPLICIT NONE
    !
    REAL(KIND = DP), INTENT(in) :: omega
    !! frequency w at point iw on the real-axis
    REAL(KIND = DP), INTENT(in) :: omegap
    !! frequency w' at point iwp on the real-axis
    REAL(KIND = DP), INTENT(in) :: temp
    !! temperature in eV
    REAL(KIND = DP), INTENT(out) :: rgammap
    !! - bose_einstein(w') - fermi_dirac(w + w')
    REAL(KIND = DP), INTENT(out) :: rgammam
    !! bose_einstein(w') + fermi_dirac(-w + w')
    !
    ! Local variables
    !
    REAL(KIND = DP) :: inv_temp
    !! Invese temperature inv_etemp = 1/temp. Defined for efficiency reason
    REAL(KIND = DP) :: coth
    !! coth = 1/tanh
    !
    inv_temp = 1.d0 / temp
    !
    coth = 1.d0 / TANH(0.5d0 * omegap * inv_temp)
    !
    rgammap = 0.5d0 * (TANH(0.5d0 * (omega + omegap) * inv_temp) - coth)
    rgammam = 0.5d0 * (TANH(0.5d0 * (omega - omegap) * inv_temp) + coth)
    !
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE gamma_acont
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE dos_quasiparticle(itemp)
    !-----------------------------------------------------------------------
    !!
    !! Computes the quasiparticle density of states in the superconducting state
    !!
    USE kinds,         ONLY : DP
    USE io_var,        ONLY : iuqdos
    USE io_files,      ONLY : prefix
    USE epwcom,        ONLY : lreal, limag, liso, laniso, fsthick
    USE elph2,         ONLY : gtemp
    USE eliashbergcom, ONLY : nsw, dwsph, ws, delta, adelta, &
                              wkfs, w0g, nkfs, nbndfs, ef0, ekfs
    USE constants_epw, ONLY : kelvin2eV, zero, ci
    USE io_global,     ONLY : ionode_id
    USE mp_global,     ONLY : inter_pool_comm
    USE mp,            ONLY : mp_barrier, mp_sum
    USE mp_world,      ONLY : mpime
    USE division,      ONLY : fkbounds
    !
    IMPLICIT NONE
    !
    INTEGER, INTENT(in) :: itemp
    !! Counter on temperature
    !
    CHARACTER(LEN = 256) :: fildos
    !! name dos file

    INTEGER :: iw
    !! Counter over frequency real-axis
    INTEGER :: ik
    !! Counter on k-points
    INTEGER :: ibnd
    !! Counter on bands
    INTEGER :: lower_bnd, upper_bnd
    !! Lower/upper bound index after k paral
    INTEGER :: ios
    !! IO error message
    INTEGER :: ierr
    !! Error status
    !
    REAL(KIND = DP) :: degaussw0
    !! variable to shift the freq. by a small imaginary value
    REAL(KIND = DP) :: weight
    !! quasi-dos factor
    REAL(KIND = DP) :: temp
    !! temperature in K
    REAL(KIND = DP), ALLOCATABLE :: dos_qp(:)
    !! superconducting quasi-particle dos
    !
    COMPLEX(KIND = DP) :: omega
    !! frequency
    !
    degaussw0 = dwsph
    !
    temp = gtemp(itemp) / kelvin2eV
    IF (temp < 10.d0) THEN
      WRITE(fildos, '(a, a8, f4.2)') TRIM(prefix), '.qdos_00', temp
    ELSEIF (temp >= 10.d0 .AND. temp < 100.d0) THEN
      WRITE(fildos, '(a, a7, f5.2)') TRIM(prefix), '.qdos_0', temp
    ELSEIF (temp >= 100.d0) THEN
      WRITE(fildos, '(a, a6, f6.2)') TRIM(prefix), '.qdos_', temp
    ENDIF
    !
    ALLOCATE(dos_qp(nsw), STAT = ierr)
    IF (ierr /= 0) CALL errore('dos_quasiparticle', 'Error allocating dos_qp', 1)
    dos_qp(:) = zero
    !
    IF (laniso) THEN
      !
      CALL fkbounds(nkfs, lower_bnd, upper_bnd)    
      !  
      DO ik = lower_bnd, upper_bnd
        DO ibnd = 1, nbndfs
          IF (ABS(ekfs(ibnd, ik) - ef0) < fsthick) THEN
            weight = 0.5d0 * wkfs(ik) * w0g(ibnd, ik)
            DO iw = 1, nsw
              omega = ws(iw) + ci * degaussw0
              dos_qp(iw) = dos_qp(iw) + weight &
                         * REAL(omega / SQRT(omega * omega - adelta(iw, ibnd, ik) * adelta(iw, ibnd, ik)))
            ENDDO
          ENDIF
        ENDDO
      ENDDO
      ! collect contributions from all pools
      CALL mp_sum(dos_qp, inter_pool_comm)
      CALL mp_barrier(inter_pool_comm)
      !
    ELSEIF (liso) THEN
      DO iw = 1, nsw
        omega = ws(iw) + ci * degaussw0
        dos_qp(iw) = dos_qp(iw) + REAL(omega / SQRT(omega * omega - delta(iw) * delta(iw)))
      ENDDO
    ENDIF
    !
    IF (mpime == ionode_id) THEN
      OPEN(iuqdos, FILE = fildos, STATUS = 'unknown', FORM = 'formatted', IOSTAT = ios)
      IF (ios /= 0) CALL errore('dos_quasiparticle', 'error opening file ' // fildos, iuqdos)      
      WRITE(iuqdos, '(5a20)') 'w [eV]', 'N_S/N_F'
      DO iw = 1, nsw
        WRITE(iuqdos, '(2ES20.10)') ws(iw), dos_qp(iw)
      ENDDO
      CLOSE(iuqdos)
    ENDIF
    !
    DEALLOCATE(dos_qp, STAT = ierr)
    IF (ierr /= 0) CALL errore('dos_quasiparticle', 'Error deallocating dos_qp', 1)
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE dos_quasiparticle
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE crit_temp_solver(adim, a, eigen, niter)
    !-----------------------------------------------------------------------
    !!
    !! SH: Routine for returning largest eigenvalue of a(adim, adim);
    !!       being used to solve linearized Eliashberg equation
    !! HP: updated 5/11/2021
    !
    USE kinds,         ONLY : DP
    USE constants_epw, ONLY : zero, two
    USE epwcom,        ONLY : tc_linear_solver, nsiter, conv_thr_iaxis
    USE io_global,     ONLY : stdout
    !
    IMPLICIT NONE
    !
    INTEGER, INTENT(in) :: adim
    !! Dimension of input matrix
    INTEGER, INTENT(out) :: niter
    !! Number of iterations of solver
    REAL(KIND = DP), INTENT(in) :: a(adim, adim)
    !! Matrix for solve
    REAL(KIND = DP), INTENT(out) :: eigen
    !! Maximum eigenvalue
    !
    ! Local variables
    CHARACTER(LEN = 10) :: jobvl, jobvr
    !! Eigenvalue problem-related variables
    LOGICAL :: conv
    !! True if calculation is converged
    INTEGER :: n
    !! Dimension of matrix a
    INTEGER :: ierr
    !! Error status
    INTEGER :: iter
    !! Counter on iteration steps
    INTEGER :: lda, ldvl, ldvr, lwork, ix, iy, ic
    !! Eigenvalue problem-related variables
    REAL(KIND = DP) :: wr(adim), wi(adim), vl(adim, adim), vr(adim, adim)
    !! Eigenvalue problem-related variables
    REAL(KIND = DP) :: alpha, x(adim), y(adim), norm
    !! Eigenvalue problem-related variables
    REAL(KIND = DP), ALLOCATABLE :: work(:)
    !! Eigenvalue problem-related variables
    !
    IF (tc_linear_solver == 'lapack') THEN
      n        = adim
      lwork    = 4 * n
      lda      = n
      ldvl     = n
      ldvr     = n
      jobvl    = 'n'
      jobvr    = 'n'
      wr(:)    = zero
      wi(:)    = zero
      vl(:, :) = zero
      vr(:, :) = zero
      work(:)  = zero
      !
      ! main solver
      ALLOCATE(work(lwork), STAT = ierr)
      IF (ierr /= 0) CALL errore('crit_temp_solver', 'Error allocating work', 1)
      lwork = -1
      CALL DGEEV(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, ierr)
      IF ( ierr /= 0) CALL errore('crit_temp_solver', 'Error eigenvalue solver failed!', 1)
      lwork = MIN(4 * n, INT(work(1)))
      DEALLOCATE(work, STAT = ierr)
      IF (ierr /= 0) CALL errore('crit_temp_solver', 'Error deallocating work', 1)
      ALLOCATE(work(lwork), STAT = ierr)
      IF (ierr /= 0) CALL errore('crit_temp_solver', 'Error allocating work', 1)
      CALL DGEEV(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, ierr)
      IF ( ierr /= 0) CALL errore('crit_temp_solver', 'Error eigenvalue solver failed!', 1)
      DEALLOCATE(work, STAT = ierr)
      IF (ierr /= 0) CALL errore('crit_temp_solver', 'Error deallocating work',1)
      !
      !! Find the largest eigenvalue
      eigen = wr(1)
      DO ic = 2, n
        IF (eigen < wr(ic))   eigen = wr(ic)
      ENDDO
      niter = 1
    ENDIF
    !
    IF (tc_linear_solver == 'power') THEN
      n    = adim
      norm = 3.d0 * conv_thr_iaxis
      y(:) = 1.d0
      iter = 1
      ! main solver
      conv = .FALSE.
      DO WHILE (.NOT. conv .AND. iter < nsiter)
        norm = SQRT(SUM(y(1:n) ** two))
        x    = y / norm
        y(:) = zero
        DO ix = 1, n
          DO iy = 1, n
            y(ix) = y(ix) + a(ix, iy) * x(iy)
          ENDDO
        ENDDO
        alpha = zero
        DO ix = 1, n
          alpha = alpha + x(ix) * y(ix)
        ENDDO
        x = y - alpha * x
        norm  = SQRT(SUM(x(1:n) ** two))
        iter  = iter + 1
        IF (norm < conv_thr_iaxis) conv = .TRUE.
      ENDDO
      eigen = alpha
      niter = iter
    ENDIF
    !
    IF (.NOT. conv .AND. iter == nsiter) THEN
      WRITE(stdout, '(/5x, a, i6)') 'Convergence (tc_linear) was not reached in nsiter = ', iter
      WRITE(stdout, '(5x, a)') 'Increase nsiter or reduce conv_thr_iaxis'
      CALL errore('crit_temp_solver', 'Convergence (tc_linear) was not reached', 1)
    ENDIF
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE crit_temp_solver
    !-----------------------------------------------------------------------
    !
    !-----------------------------------------------------------------------
    SUBROUTINE write_matsubara_freq(itemp)
    !-----------------------------------------------------------------------
    !!
    !! SH: If iverbosity = 2; this routine writes the matsubara indices to 
    !!       matsu-freq*.out file for each temperature (Nov 2021).
    !!
    USE kinds,         ONLY : DP
    USE eliashbergcom, ONLY : nsiw, wsn
    USE elph2,         ONLY : gtemp
    USE constants_epw, ONLY : kelvin2eV, pi
    USE io_var,        ONLY : iufilmat
    !
    IMPLICIT NONE
    !
    CHARACTER(LEN=256) :: filename
    !! Output file name
    INTEGER           :: itemp
    !! Counter for temperature
    INTEGER           :: iw
    !! Loop variable for frequencies
    INTEGER           :: ierr
    !! Error status
    REAL(KIND = DP)   :: temp
    !! Temperature
    !
    ! Initiate output file names
    temp = gtemp(itemp) / kelvin2eV
    IF (temp < 10.d0) THEN
      WRITE(filename, 104) 'matsu-freq','_00', temp,'.out'
    ELSEIF (temp >= 10.d0 .AND. temp < 100.d0 ) THEN
      WRITE(filename, 105) 'matsu-freq','_0' , temp,'.out'
    ELSEIF (temp >= 100.d0) THEN
      WRITE(filename, 106) 'matsu-freq','_'  , temp,'.out'
    ENDIF
    ! Write mats-freq*.out file
    OPEN(UNIT = iufilmat, FILE = filename, IOSTAT = ierr)
    IF (ierr /= 0) CALL errore('write_matsubara_freq', 'Error creating mats-freq.out', 1)
    DO iw =1, nsiw(itemp)
      WRITE(iufilmat,*) wsn(iw)
    ENDDO
    CLOSE(iufilmat)
    !
    104 FORMAT(a10, a3, f4.2, a4)
    105 FORMAT(a10, a2, f5.2, a4)
    106 FORMAT(a10, a1, f6.2, a4)
    RETURN
    !-----------------------------------------------------------------------
    END SUBROUTINE write_matsubara_freq
    !-----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    SUBROUTINE deallocate_eliashberg_elphon()
    !----------------------------------------------------------------------
    !!
    !!  deallocates the variables allocated by eliashberg_init,
    !!  read_frequencies, read_eigenvalues, read_kqmap, read_ephmat,
    !!  and evaluate_a2f_lambda
    !!
    USE epwcom,        ONLY : liso, laniso
    USE elph2,         ONLY : wf, wqf, xqf, gtemp
    USE eliashbergcom, ONLY : ekfs, xkfs, wkfs, g2, w0g, &
                              ixkff, ixkqf, ixqfs, nqfs, memlt_pool
    !
    IMPLICIT NONE
    !
    INTEGER :: ierr
    !! Error status
    !
    ! eliashberg_init
    IF (.NOT. liso .AND. .NOT. laniso) THEN
      DEALLOCATE(gtemp, STAT = ierr)
      IF (ierr /= 0) CALL errore('deallocate_eliashberg_aniso', 'Error deallocating gtemp', 1)
    ENDIF
    ! read_frequencies
    DEALLOCATE(wf, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating wf', 1)
    DEALLOCATE(wqf, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating wqf', 1)
    DEALLOCATE(xqf, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating xqf', 1)
    ! read_eigenvalues
    DEALLOCATE(ekfs, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating ekfs', 1)
    DEALLOCATE(xkfs, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating xkfs', 1)
    DEALLOCATE(wkfs, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating wkfs', 1)
    DEALLOCATE(w0g, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating w0g', 1)
    ! read_kqmap
    DEALLOCATE(ixkff, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating ixkff', 1)
    DEALLOCATE(ixkqf, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating ixkqf', 1)
    DEALLOCATE(ixqfs, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating ixqfs', 1)
    DEALLOCATE(nqfs, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating nqfs', 1)
    DEALLOCATE(memlt_pool, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating memlt_pool', 1)
    ! read_ephmat
    DEALLOCATE(g2, STAT = ierr)
    IF (ierr /= 0) CALL errore('deallocate_eliashberg_elphon', 'Error deallocating g2', 1)
    !
    RETURN
    !
    !-----------------------------------------------------------------------
    END SUBROUTINE deallocate_eliashberg_elphon
    !-----------------------------------------------------------------------
    !
  !----------------------------------------------------------------------
  END MODULE supercond
  !----------------------------------------------------------------------
