diff --git a/EPW/src/io_eliashberg.f90 b/EPW/src/io_eliashberg.f90 index 73a518c5c..baae50c83 100644 --- a/EPW/src/io_eliashberg.f90 +++ b/EPW/src/io_eliashberg.f90 @@ -2074,8 +2074,8 @@ USE io_epw, ONLY : iufilgap USE io_files, ONLY : prefix USE epwcom, ONLY : fsthick - USE eliashbergcom, ONLY : estemp, Agap, nkfs, nbndfs, ef0, ekfs - USE constants_epw, ONLY : kelvin2eV, zero + USE eliashbergcom, ONLY : estemp, Agap, nkfs, nbndfs, ef0, ekfs, w0g + USE constants_epw, ONLY : kelvin2eV, zero, eps5 ! IMPLICIT NONE ! @@ -2099,8 +2099,6 @@ !! Step size in nbin REAL(DP) :: delta_max !! Max value of superconducting gap - REAL(DP) :: sigma - !! Variable for smearing REAL(DP) :: weight !! Variable for weight REAL(DP), ALLOCATABLE :: delta_k_bin(:) @@ -2110,8 +2108,8 @@ ! temp = estemp(itemp) / kelvin2eV ! - delta_max = 1.25d0 * maxval(Agap(:,:,itemp)) - nbin = int(delta_max/(0.005d0/1000.d0)) + delta_max = 1.1d0 * maxval(Agap(:,:,itemp)) + nbin = NINT(delta_max / eps5) + 1 dbin = delta_max / dble(nbin) IF ( .not. ALLOCATED(delta_k_bin) ) ALLOCATE( delta_k_bin(nbin) ) delta_k_bin(:) = zero @@ -2119,11 +2117,9 @@ DO ik = 1, nkfs DO ibnd = 1, nbndfs IF ( abs( ekfs(ibnd,ik) - ef0 ) .lt. fsthick ) THEN - DO ibin = 1, nbin - sigma = 1.d0 * dbin - weight = w0gauss( ( Agap(ibnd,ik,itemp) - dble(ibin) * dbin) / sigma, 0 ) / sigma - delta_k_bin(ibin) = delta_k_bin(ibin) + weight - ENDDO + ibin = nint( Agap(ibnd,ik,itemp) / dbin ) + 1 + weight = w0g(ibnd,ik) + delta_k_bin(ibin) = delta_k_bin(ibin) + weight ENDIF ENDDO ENDDO diff --git a/EPW/src/superconductivity_aniso.f90 b/EPW/src/superconductivity_aniso.f90 index 7e56cf5a7..d75b304e1 100644 --- a/EPW/src/superconductivity_aniso.f90 +++ b/EPW/src/superconductivity_aniso.f90 @@ -1423,7 +1423,7 @@ degaussw, nkf1, nkf2, nkf3 USE eliashbergcom, ONLY : nkfs, nbndfs, g2, ixkqf, ixqfs, nqfs, w0g, ekfs, ef0, dosef, wsph, & wkfs, dwsph, a2f_iso, ixkff - USE constants_epw, ONLY : ryd2ev + USE constants_epw, ONLY : ryd2ev, eps2, zero, eps16 USE io_global, ONLY : ionode_id USE mp_global, ONLY : inter_pool_comm, my_pool_id, npool USE mp_world, ONLY : mpime @@ -1599,23 +1599,25 @@ IF ( ALLOCATED(a2f) ) DEALLOCATE( a2f ) IF ( ALLOCATED(a2f_modeproj) ) DEALLOCATE( a2f_modeproj ) ! - nbink = int( 1.25d0 * maxval(lambda_k(:,:)) / 0.005d0 ) - dbink = 1.25d0 * maxval(lambda_k(:,:)) / dble(nbink) + nbink = NINT( 1.1d0 * MAXVAL(lambda_k(:,:)) / eps2 ) + 1 + dbink = 1.1d0 * MAXVAL(lambda_k(:,:)) / DBLE(nbink) + ! IF ( .not. ALLOCATED(lambda_k_bin) ) ALLOCATE ( lambda_k_bin(nbink) ) - lambda_k_bin(:) = 0.d0 + lambda_k_bin(:) = zero ! !SP : Should be initialized nbin = 0 - dbin = 0.0_DP + dbin = zero ! IF ( iverbosity == 2 ) THEN - nbin = int( 1.25d0 * maxval(lambda_max(:)) / 0.005d0 ) - dbin = 1.25d0 * maxval(lambda_max(:)) / dble(nbin) - IF ( .not. ALLOCATED(lambda_pairs) ) ALLOCATE ( lambda_pairs(nbin) ) - lambda_pairs(:) = 0.d0 + nbin = nint( 1.1d0 * MAXVAL(lambda_max(:)) / eps2 ) + 1 + dbin = 1.1d0 * MAXVAL(lambda_max(:)) / dble(nbin) + IF ( .not. ALLOCATED(lambda_pairs) ) ALLOCATE ( lambda_pairs(nbin) ) + lambda_pairs(:) = zero ENDIF ! - WRITE(stdout,'(5x,a13,f21.7,a18,f21.7)') 'lambda_max = ', maxval(lambda_max(:)), ' lambda_k_max = ', maxval(lambda_k(:,:)) + WRITE(stdout,'(5x,a13,f21.7,a18,f21.7)') 'lambda_max = ', maxval(lambda_max(:)), & + ' lambda_k_max = ', maxval(lambda_k(:,:)) WRITE(stdout,'(a)') ' ' ! lambda_k(:,:) = 0.d0 @@ -1631,20 +1633,16 @@ CALL lambdar_aniso_ver1( ik, iq, ibnd, jbnd, 0.d0, lambda_eph ) lambda_k(ik,ibnd) = lambda_k(ik,ibnd) + weight * lambda_eph IF ( iverbosity == 2 ) THEN - DO ibin = 1, nbin - sigma = 1.d0 * dbin - weight = w0gauss( ( lambda_eph - dble(ibin) * dbin ) / sigma, 0 ) / sigma - lambda_pairs(ibin) = lambda_pairs(ibin) + weight - ENDDO + ibin = NINT( lambda_eph / dbin ) + 1 + weight = w0g(ibnd,ik) * w0g(jbnd,ixkqf(ik,iq0)) + lambda_pairs(ibin) = lambda_pairs(ibin) + weight ENDIF ENDIF ENDDO ! jbnd ENDDO ! iq - DO ibin = 1, nbink - sigma = 1.d0 * dbink - weight = w0gauss( ( lambda_k(ik,ibnd) - dble(ibin) * dbink ) / sigma, 0 ) / sigma - lambda_k_bin(ibin) = lambda_k_bin(ibin) + weight - ENDDO + ibin = NINT( lambda_k(ik,ibnd) / dbink ) + 1 + weight = w0g(ibnd,ik) + lambda_k_bin(ibin) = lambda_k_bin(ibin) + weight ENDIF ENDDO ! ibnd ENDDO ! ik @@ -1676,7 +1674,7 @@ OPEN(unit = iufillambda, file = TRIM(prefix)//".lambda_k_pairs", form = 'formatted') 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(:)) + WRITE(iufillambda,'(2f21.7)') dbink*dble(ibin), lambda_k_bin(ibin)/MAXVAL(lambda_k_bin(:)) ENDDO CLOSE(iufillambda) ! @@ -1761,9 +1759,4 @@ ! END SUBROUTINE evaluate_a2f_lambda ! - - - - - ! END MODULE superconductivity_aniso diff --git a/UtilXlib/mp.f90 b/UtilXlib/mp.f90 index f272a55b3..b6502626d 100644 --- a/UtilXlib/mp.f90 +++ b/UtilXlib/mp.f90 @@ -52,7 +52,7 @@ END INTERFACE INTERFACE mp_sum - MODULE PROCEDURE mp_sum_i1, mp_sum_iv, mp_sum_im, mp_sum_it, & + MODULE PROCEDURE mp_sum_i1, mp_sum_iv, mp_sum_im, mp_sum_it, mp_sum_i4, mp_sum_i5, & mp_sum_r1, mp_sum_rv, mp_sum_rm, mp_sum_rt, mp_sum_r4d, & mp_sum_c1, mp_sum_cv, mp_sum_cm, mp_sum_ct, mp_sum_c4d, & mp_sum_c5d, mp_sum_c6d, mp_sum_rmm, mp_sum_cmm, mp_sum_r5d, & @@ -1391,6 +1391,33 @@ #endif END SUBROUTINE mp_sum_it +!------------------------------------------------------------------------------! + + SUBROUTINE mp_sum_i4(msg,gid) + IMPLICIT NONE + INTEGER, INTENT (INOUT) :: msg(:,:,:,:) + INTEGER, INTENT (IN) :: gid +#if defined(__MPI) + INTEGER :: msglen + msglen = size(msg) + CALL reduce_base_integer( msglen, msg, gid, -1 ) +#endif + END SUBROUTINE mp_sum_i4 + +!------------------------------------------------------------------------------! + + SUBROUTINE mp_sum_i5(msg,gid) + IMPLICIT NONE + INTEGER, INTENT (INOUT) :: msg(:,:,:,:,:) + INTEGER, INTENT (IN) :: gid +#if defined(__MPI) + INTEGER :: msglen + msglen = size(msg) + CALL reduce_base_integer( msglen, msg, gid, -1 ) +#endif + END SUBROUTINE mp_sum_i5 + + !------------------------------------------------------------------------------! SUBROUTINE mp_sum_r1(msg,gid) diff --git a/test-suite/epw_super/benchmark.out.git.inp=epw_aniso.in.args=3 b/test-suite/epw_super/benchmark.out.git.inp=epw_aniso.in.args=3 index 35974f423..7f678e33f 100644 --- a/test-suite/epw_super/benchmark.out.git.inp=epw_aniso.in.args=3 +++ b/test-suite/epw_super/benchmark.out.git.inp=epw_aniso.in.args=3 @@ -27,7 +27,7 @@ Comput. Phys. Commun. 209, 116 (2016) - Program EPW v.5.0.0 starts on 17Oct2018 at 11:12:23 + Program EPW v.5.1.0 starts on 2Apr2019 at 14:20: 5 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -65,9 +65,6 @@ number of atomic types = 2 kinetic-energy cut-off = 40.0000 Ry charge density cut-off = 160.0000 Ry - convergence threshold = 0.0E+00 - beta = 0.0000 - number of iterations used = 0 Exchange-correlation = PZ ( 1 1 0 0 0 0) @@ -90,9 +87,9 @@ Cartesian axes site n. atom mass positions (a_0 units) - 1 Mg 24.3071 tau( 1) = ( 0.00000 0.00000 0.00000 ) - 2 B 10.8119 tau( 2) = ( -0.00000 0.57735 0.57103 ) - 3 B 10.8119 tau( 3) = ( 0.50000 0.28868 0.57103 ) + 1 Mg 24.3050 tau( 1) = ( 0.00000 0.00000 0.00000 ) + 2 B 10.8110 tau( 2) = ( -0.00000 0.57735 0.57103 ) + 3 B 10.8110 tau( 3) = ( 0.50000 0.28868 0.57103 ) 25 Sym.Ops. (with q -> -q+G ) @@ -129,8 +126,8 @@ k( 27) = ( 0.6666667 1.1547005 0.5837357), wk = 0.0740741 PseudoPot. # 1 for Mg read from file: - ./Mg.pz-n-vbc.UPF - MD5 check sum: 51ac066f8f4bf7da60c51ce0af5caf3d + ../../pseudo/Mg.pz-n-vbc.UPF + MD5 check sum: adf9ca49345680d0fd32b5bc0752f25b Pseudo is Norm-conserving + core correction, Zval = 2.0 Generated by new atomic code, or converted to UPF format Using radial grid of 171 points, 2 beta functions with: @@ -138,13 +135,13 @@ l(2) = 1 PseudoPot. # 2 for B read from file: - ./B.pz-vbc.UPF - MD5 check sum: b59596b5d63edeea6a2b3a0beace49c5 + ../../pseudo/B.pz-vbc.UPF + MD5 check sum: 57e6d61f6735028425feb5bdf19679fb Pseudo is Norm-conserving, Zval = 3.0 Generated by new atomic code, or converted to UPF format Using radial grid of 157 points, 1 beta functions with: l(1) = 0 - EPW : 0.06s CPU 0.06s WALL + EPW : 0.07s CPU 0.07s WALL EPW : 0.11s CPU 0.11s WALL @@ -250,17 +247,17 @@ ( 0.25000 0.43301 0.66488) : 1.07401 ------------------------------------------------------------------- - WANNIER : 4.72s CPU 4.73s WALL ( 1 calls) + WANNIER : 4.69s CPU 4.70s WALL ( 1 calls) ------------------------------------------------------------------- Dipole matrix elements calculated - Calculating kmap and kgmap - Progress kmap: ########################### + Calculating kgmap + Progress kgmap: ######################################## - kmaps : 0.66s CPU 0.66s WALL ( 1 calls) - Symmetries of bravais lattice: 24 + kmaps : 0.74s CPU 0.76s WALL ( 1 calls) + Symmetries of Bravais lattice: 24 Symmetries of crystal: 24 @@ -431,10 +428,6 @@ Number of ep-matrix elements per pool : 6300 ~= 49.22 Kb (@ 8 bytes/ DP) - - A selecq.fmt file was found but re-created because selecqread == .false. - We only need to compute 216 q-points - Nr. of irreducible k-points on the uniform grid: 28 @@ -447,8 +440,8 @@ Nr irreducible k-points within the Fermi shell = 28 out of 28 Progression iq (fine) = 100/ 216 Progression iq (fine) = 200/ 216 - Fermi level (eV) = 0.766449682995321D+01 - DOS(states/spin/eV/Unit Cell) = 0.913425062108237D+00 + Fermi level (eV) = 0.766449682987715D+01 + DOS(states/spin/eV/Unit Cell) = 0.913425062442885D+00 Electron smearing (eV) = 0.100000000000000D+00 Fermi window (eV) = 0.200000000000000D+02 @@ -466,8 +459,8 @@ Finish reading .freq file - Fermi level (eV) = 7.6644968300E+00 - DOS(states/spin/eV/Unit Cell) = 9.1342506211E-01 + Fermi level (eV) = 7.6644968299E+00 + DOS(states/spin/eV/Unit Cell) = 9.1342506244E-01 Electron smearing (eV) = 1.0000000000E-01 Fermi window (eV) = 2.0000000000E+01 Nr irreducible k-points within the Fermi shell = 28 out of 28 @@ -488,7 +481,7 @@ Finish reading .ephmat files - lambda_max = 126.3632786 lambda_k_max = 3.2077041 + lambda_max = 126.3632787 lambda_k_max = 3.2077041 Electron-phonon coupling strength = 0.8715788 @@ -505,51 +498,51 @@ Size of allocated memory per pool : ~= 0.1503 Gb - iter = 1 relerr = 2.3226492869E+00 abserr = 3.7868513587E-03 Znormi(1) = 1.8425204689E+00 Deltai(1) = 5.1023202661E-03 - iter = 2 relerr = 1.0382603316E-01 abserr = 1.7988573573E-04 Znormi(1) = 1.8384556113E+00 Deltai(1) = 5.7837080986E-03 - iter = 3 relerr = 1.1297818870E-01 abserr = 2.1742639752E-04 Znormi(1) = 1.8328771910E+00 Deltai(1) = 6.5988531244E-03 - iter = 4 relerr = 5.8057795346E-02 abserr = 1.1861891474E-04 Znormi(1) = 1.8301075444E+00 Deltai(1) = 6.9874927954E-03 - iter = 5 relerr = 1.2326147244E-01 abserr = 2.8723921772E-04 Znormi(1) = 1.8231761313E+00 Deltai(1) = 7.8813439967E-03 - iter = 6 relerr = 3.4567302238E-02 abserr = 8.3423187451E-05 Znormi(1) = 1.8212407163E+00 Deltai(1) = 8.1187946175E-03 - iter = 7 relerr = 6.0357211069E-03 abserr = 1.4649424202E-05 Znormi(1) = 1.8210144597E+00 Deltai(1) = 8.1526876799E-03 + iter = 1 relerr = 2.3226492868E+00 abserr = 3.7868513576E-03 Znormi(1) = 1.8425204688E+00 Deltai(1) = 5.1023202661E-03 + iter = 2 relerr = 1.0382603327E-01 abserr = 1.7988573589E-04 Znormi(1) = 1.8384556112E+00 Deltai(1) = 5.7837080994E-03 + iter = 3 relerr = 1.1297818883E-01 abserr = 2.1742639777E-04 Znormi(1) = 1.8328771909E+00 Deltai(1) = 6.5988531261E-03 + iter = 4 relerr = 5.8057795415E-02 abserr = 1.1861891489E-04 Znormi(1) = 1.8301075444E+00 Deltai(1) = 6.9874927977E-03 + iter = 5 relerr = 1.2326147270E-01 abserr = 2.8723921843E-04 Znormi(1) = 1.8231761313E+00 Deltai(1) = 7.8813440013E-03 + iter = 6 relerr = 3.4567302130E-02 abserr = 8.3423187212E-05 Znormi(1) = 1.8212407162E+00 Deltai(1) = 8.1187946214E-03 + iter = 7 relerr = 6.0357210983E-03 abserr = 1.4649424186E-05 Znormi(1) = 1.8210144596E+00 Deltai(1) = 8.1526876837E-03 Convergence was reached in nsiter = 7 - iaxis_imag : 40.20s CPU 40.24s WALL ( 1 calls) + iaxis_imag : 40.14s CPU 40.17s WALL ( 1 calls) Pade approximant of anisotropic Eliashberg equations from imaginary-axis to real-axis Cutoff frequency wscut = 0.5000 - pade = 56 error = 1.2540704181E+00 Re[Znorm(1)] = 1.6760048406E+00 Re[Delta(1)] = 7.5379702197E-03 - raxis_pade : 0.17s CPU 0.18s WALL ( 1 calls) + pade = 56 error = 1.3492023744E+00 Re[Znorm(1)] = 1.6759787082E+00 Re[Delta(1)] = 7.5379615438E-03 + raxis_pade : 0.16s CPU 0.16s WALL ( 1 calls) - itemp = 1 total cpu time : 40.42 secs + itemp = 1 total cpu time : 40.33 secs Unfolding on the coarse grid - elphon_wrap : 45.89s CPU 46.46s WALL ( 1 calls) + elphon_wrap : 46.97s CPU 47.68s WALL ( 1 calls) INITIALIZATION: - set_drhoc : 0.38s CPU 0.38s WALL ( 28 calls) - init_vloc : 0.04s CPU 0.04s WALL ( 29 calls) - init_us_1 : 0.13s CPU 0.13s WALL ( 29 calls) + set_drhoc : 0.38s CPU 0.39s WALL ( 28 calls) + init_vloc : 0.00s CPU 0.00s WALL ( 1 calls) + init_us_1 : 0.00s CPU 0.00s WALL ( 1 calls) Electron-Phonon interpolation - ephwann : 0.71s CPU 0.74s WALL ( 1 calls) - ep-interp : 0.54s CPU 0.57s WALL ( 216 calls) + ephwann : 0.70s CPU 0.74s WALL ( 1 calls) + ep-interp : 0.55s CPU 0.57s WALL ( 216 calls) Ham: step 1 : 0.00s CPU 0.00s WALL ( 1 calls) Ham: step 2 : 0.00s CPU 0.00s WALL ( 1 calls) ep: step 1 : 0.00s CPU 0.00s WALL ( 243 calls) ep: step 2 : 0.04s CPU 0.04s WALL ( 243 calls) DynW2B : 0.01s CPU 0.01s WALL ( 216 calls) - HamW2B : 0.09s CPU 0.09s WALL ( 12584 calls) - ephW2Bp : 0.08s CPU 0.09s WALL ( 216 calls) + HamW2B : 0.09s CPU 0.09s WALL ( 12152 calls) + ephW2Bp : 0.08s CPU 0.08s WALL ( 216 calls) - ELIASHBERG : 104.63s CPU 104.67s WALL ( 1 calls) + ELIASHBERG : 105.19s CPU 105.24s WALL ( 1 calls) Total program execution - EPW : 2m36.05s CPU 2m36.72s WALL + EPW : 2m37.66s CPU 2m38.47s WALL Please consider citing: diff --git a/test-suite/epw_super/benchmark.out.git.inp=epw_iso.in.args=3 b/test-suite/epw_super/benchmark.out.git.inp=epw_iso.in.args=3 index ffed776cd..fcb9d628a 100644 --- a/test-suite/epw_super/benchmark.out.git.inp=epw_iso.in.args=3 +++ b/test-suite/epw_super/benchmark.out.git.inp=epw_iso.in.args=3 @@ -27,7 +27,7 @@ Comput. Phys. Commun. 209, 116 (2016) - Program EPW v.5.0.0 starts on 17Oct2018 at 11:10:25 + Program EPW v.5.1.0 starts on 2Apr2019 at 14:18: 6 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -65,9 +65,6 @@ number of atomic types = 2 kinetic-energy cut-off = 40.0000 Ry charge density cut-off = 160.0000 Ry - convergence threshold = 0.0E+00 - beta = 0.0000 - number of iterations used = 0 Exchange-correlation = PZ ( 1 1 0 0 0 0) @@ -90,9 +87,9 @@ Cartesian axes site n. atom mass positions (a_0 units) - 1 Mg 24.3071 tau( 1) = ( 0.00000 0.00000 0.00000 ) - 2 B 10.8119 tau( 2) = ( -0.00000 0.57735 0.57103 ) - 3 B 10.8119 tau( 3) = ( 0.50000 0.28868 0.57103 ) + 1 Mg 24.3050 tau( 1) = ( 0.00000 0.00000 0.00000 ) + 2 B 10.8110 tau( 2) = ( -0.00000 0.57735 0.57103 ) + 3 B 10.8110 tau( 3) = ( 0.50000 0.28868 0.57103 ) 25 Sym.Ops. (with q -> -q+G ) @@ -129,8 +126,8 @@ k( 27) = ( 0.6666667 1.1547005 0.5837357), wk = 0.0740741 PseudoPot. # 1 for Mg read from file: - ./Mg.pz-n-vbc.UPF - MD5 check sum: 51ac066f8f4bf7da60c51ce0af5caf3d + ../../pseudo/Mg.pz-n-vbc.UPF + MD5 check sum: adf9ca49345680d0fd32b5bc0752f25b Pseudo is Norm-conserving + core correction, Zval = 2.0 Generated by new atomic code, or converted to UPF format Using radial grid of 171 points, 2 beta functions with: @@ -138,15 +135,15 @@ l(2) = 1 PseudoPot. # 2 for B read from file: - ./B.pz-vbc.UPF - MD5 check sum: b59596b5d63edeea6a2b3a0beace49c5 + ../../pseudo/B.pz-vbc.UPF + MD5 check sum: 57e6d61f6735028425feb5bdf19679fb Pseudo is Norm-conserving, Zval = 3.0 Generated by new atomic code, or converted to UPF format Using radial grid of 157 points, 1 beta functions with: l(1) = 0 - EPW : 0.05s CPU 0.05s WALL + EPW : 0.07s CPU 0.07s WALL - EPW : 0.10s CPU 0.11s WALL + EPW : 0.11s CPU 0.11s WALL No wavefunction gauge setting applied ------------------------------------------------------------------- @@ -250,17 +247,17 @@ ( 0.25000 0.43301 0.66488) : 1.07401 ------------------------------------------------------------------- - WANNIER : 4.69s CPU 4.69s WALL ( 1 calls) + WANNIER : 4.62s CPU 4.65s WALL ( 1 calls) ------------------------------------------------------------------- Dipole matrix elements calculated - Calculating kmap and kgmap - Progress kmap: ########################### + Calculating kgmap + Progress kgmap: ######################################## - kmaps : 0.65s CPU 0.65s WALL ( 1 calls) - Symmetries of bravais lattice: 24 + kmaps : 0.70s CPU 0.72s WALL ( 1 calls) + Symmetries of Bravais lattice: 24 Symmetries of crystal: 24 @@ -431,8 +428,6 @@ Number of ep-matrix elements per pool : 6300 ~= 49.22 Kb (@ 8 bytes/ DP) - We only need to compute 216 q-points - Nr. of irreducible k-points on the uniform grid: 28 @@ -445,8 +440,8 @@ Nr irreducible k-points within the Fermi shell = 28 out of 28 Progression iq (fine) = 100/ 216 Progression iq (fine) = 200/ 216 - Fermi level (eV) = 0.766449682995321D+01 - DOS(states/spin/eV/Unit Cell) = 0.913425062108237D+00 + Fermi level (eV) = 0.766449682987715D+01 + DOS(states/spin/eV/Unit Cell) = 0.913425062442885D+00 Electron smearing (eV) = 0.100000000000000D+00 Fermi window (eV) = 0.200000000000000D+02 @@ -464,8 +459,8 @@ Finish reading .freq file - Fermi level (eV) = 7.6644968300E+00 - DOS(states/spin/eV/Unit Cell) = 9.1342506211E-01 + Fermi level (eV) = 7.6644968299E+00 + DOS(states/spin/eV/Unit Cell) = 9.1342506244E-01 Electron smearing (eV) = 1.0000000000E-01 Fermi window (eV) = 2.0000000000E+01 Nr irreducible k-points within the Fermi shell = 28 out of 28 @@ -486,7 +481,7 @@ Finish reading .ephmat files - lambda_max = 126.3632786 lambda_k_max = 3.2077041 + lambda_max = 126.3632787 lambda_k_max = 3.2077041 Electron-phonon coupling strength = 0.8715788 @@ -500,20 +495,20 @@ Total number of frequency points nsiw ( 1 ) = 62 - iter = 1 error = 2.5322786302E+00 Znormi(1) = 1.8425565148E+00 Deltai(1) = 4.4511260668E-03 - iter = 2 error = 7.6350592879E-02 Znormi(1) = 1.8420086250E+00 Deltai(1) = 4.6843298938E-03 - iter = 3 error = 4.5214453230E-02 Znormi(1) = 1.8407880676E+00 Deltai(1) = 4.9302785074E-03 - iter = 4 error = 3.4114375039E-02 Znormi(1) = 1.8396470531E+00 Deltai(1) = 5.1142664866E-03 - iter = 5 error = 5.1084767495E-02 Znormi(1) = 1.8380345292E+00 Deltai(1) = 5.3737355714E-03 - iter = 6 error = 3.1593313222E-02 Znormi(1) = 1.8369970920E+00 Deltai(1) = 5.5352742661E-03 - iter = 7 error = 3.2735364515E-03 Znormi(1) = 1.8371188436E+00 Deltai(1) = 5.5172615936E-03 + iter = 1 error = 2.5322786302E+00 Znormi(1) = 1.8425565148E+00 Deltai(1) = 4.4511260663E-03 + iter = 2 error = 7.6350592879E-02 Znormi(1) = 1.8420086250E+00 Deltai(1) = 4.6843298933E-03 + iter = 3 error = 4.5214453227E-02 Znormi(1) = 1.8407880676E+00 Deltai(1) = 4.9302785068E-03 + iter = 4 error = 3.4114375040E-02 Znormi(1) = 1.8396470531E+00 Deltai(1) = 5.1142664860E-03 + iter = 5 error = 5.1084767499E-02 Znormi(1) = 1.8380345292E+00 Deltai(1) = 5.3737355707E-03 + iter = 6 error = 3.1593313230E-02 Znormi(1) = 1.8369970920E+00 Deltai(1) = 5.5352742655E-03 + iter = 7 error = 3.2735364530E-03 Znormi(1) = 1.8371188436E+00 Deltai(1) = 5.5172615930E-03 Convergence was reached in nsiter = 7 iaxis_imag : 0.00s CPU 0.00s WALL ( 1 calls) Pade approximant of isotropic Eliashberg equations from imaginary-axis to real-axis - pade = 50 error = 1.3383837700E+00 Re[Znorm(1)] = 1.8387340136E+00 Re[Delta(1)] = 5.5339316344E-03 + pade = 50 error = 1.3406540098E+00 Re[Znorm(1)] = 1.8386808671E+00 Re[Delta(1)] = 5.5339372998E-03 raxis_pade : 0.01s CPU 0.01s WALL ( 1 calls) @@ -522,41 +517,41 @@ Total number of frequency points nsw = 2000 - iter = 1 error = 1.0679396230E-01 Re[Znorm(1)] = 1.8388939124E+00 Re[Delta(1)] = 5.5362867563E-03 - iter = 2 error = 1.6731551840E-02 Re[Znorm(1)] = 1.8388939164E+00 Re[Delta(1)] = 5.5362867467E-03 - iter = 3 error = 9.9244125501E-03 Re[Znorm(1)] = 1.8388939179E+00 Re[Delta(1)] = 5.5362867432E-03 + iter = 1 error = 1.0626740068E-01 Re[Znorm(1)] = 1.8388939127E+00 Re[Delta(1)] = 5.5362867549E-03 + iter = 2 error = 1.6520911174E-02 Re[Znorm(1)] = 1.8388939165E+00 Re[Delta(1)] = 5.5362867458E-03 + iter = 3 error = 9.7445084331E-03 Re[Znorm(1)] = 1.8388939179E+00 Re[Delta(1)] = 5.5362867426E-03 Convergence was reached in nsiter = 3 - raxis_acon : 1.27s CPU 1.27s WALL ( 1 calls) + raxis_acon : 1.34s CPU 1.34s WALL ( 1 calls) - itemp = 1 total cpu time : 1.3 secs + itemp = 1 total cpu time : 1.4 secs Unfolding on the coarse grid - elphon_wrap : 46.19s CPU 46.87s WALL ( 1 calls) + elphon_wrap : 46.20s CPU 46.89s WALL ( 1 calls) INITIALIZATION: set_drhoc : 0.38s CPU 0.38s WALL ( 28 calls) - init_vloc : 0.04s CPU 0.04s WALL ( 29 calls) - init_us_1 : 0.13s CPU 0.13s WALL ( 29 calls) + init_vloc : 0.00s CPU 0.00s WALL ( 1 calls) + init_us_1 : 0.00s CPU 0.00s WALL ( 1 calls) Electron-Phonon interpolation - ephwann : 0.70s CPU 0.74s WALL ( 1 calls) - ep-interp : 0.55s CPU 0.57s WALL ( 216 calls) + ephwann : 0.71s CPU 0.73s WALL ( 1 calls) + ep-interp : 0.56s CPU 0.57s WALL ( 216 calls) Ham: step 1 : 0.00s CPU 0.00s WALL ( 1 calls) Ham: step 2 : 0.00s CPU 0.00s WALL ( 1 calls) ep: step 1 : 0.00s CPU 0.00s WALL ( 243 calls) ep: step 2 : 0.04s CPU 0.04s WALL ( 243 calls) DynW2B : 0.01s CPU 0.01s WALL ( 216 calls) - HamW2B : 0.09s CPU 0.09s WALL ( 12584 calls) + HamW2B : 0.09s CPU 0.09s WALL ( 12152 calls) ephW2Bp : 0.08s CPU 0.09s WALL ( 216 calls) - ELIASHBERG : 65.56s CPU 65.58s WALL ( 1 calls) + ELIASHBERG : 66.16s CPU 66.17s WALL ( 1 calls) Total program execution - EPW : 1m57.24s CPU 1m57.99s WALL + EPW : 1m57.80s CPU 1m58.56s WALL Please consider citing: