SUBROUTINE sigma_c(ik0) ! G TIMES W PRODUCT USE kinds, ONLY : DP USE lsda_mod, ONLY : nspin USE constants, ONLY : e2, fpi, RYTOEV, tpi, eps8, pi USE disp, ONLY : nqs, nq1, nq2, nq3, wq, x_q USE control_gw, ONLY : lgamma, eta USE klist, ONLY : wk, xk USE io_files, ONLY : prefix, iunigk USE wvfct, ONLY : nbnd, npw, npwx, igk, g2kin, et USE eqv, ONLY : evq, eprec USE freq_gw, ONLY : fpol, fiu, nfs, nfsmax,& nwcoul, nwgreen, nwalloc, nwsigma, wtmp, wcoul,& wgreen, wsigma, wsigmamin, wsigmamax,& deltaw, wcoulmax, ind_w0mw, ind_w0pw USE units_gw, ONLY : iuncoul, iungreen, iunsigma, lrsigma, lrcoul, lrgrn, iuwfc, lrwfc USE qpoint, ONLY : xq, npwq, igkq, nksq, ikks, ikqs USE gwsigma, ONLY : ngmsco, sigma, sigma_g, nrsco, nlsco, fft6_g2r, ecutsco, ngmsig USE gvect, ONLY : g, ngm, ecutwfc, nl USE cell_base, ONLY : tpiba2, tpiba IMPLICIT NONE COMPLEX(DP) :: ci, czero !For running PWSCF need some variables LOGICAL :: do_band, do_iq, setup_pw, exst !Pade arrays COMPLEX(DP), ALLOCATABLE :: z(:), u(:), a(:) !W arrays COMPLEX(DP), ALLOCATABLE :: scrcoul_g (:,:,:) COMPLEX(DP), ALLOCATABLE :: scrcoul_pade_g (:,:) COMPLEX(DP), ALLOCATABLE :: scrcoul(:,:) COMPLEX(DP) :: ZDOTC !G arrays: COMPLEX(DP), ALLOCATABLE :: greenf_g(:,:), greenfp(:,:), greenfm(:,:) !Integration Variable COMPLEX(DP) :: cprefac !FREQUENCY GRIDS/COUNTERS INTEGER :: iwim, iw INTEGER :: iw0, iwp, iw0mw, iw0pw REAL(DP) :: w_ryd(nwcoul) !COUNTERS INTEGER :: ig, igp, npe, irr, icounter, ir, irp INTEGER :: igstart, igstop, igpert INTEGER :: iq, ipol INTEGER :: ikmq, ik0, ik INTEGER :: rec0, ios INTEGER :: counter ! CHECK FOR NAN's REAL(DP) :: ar, ai ! #ifdef __PARA ! scrcoul_g = czero ! if (me.eq.1.and.mypool.eq.1) then ! #endif ! #ifdef __PARA ! endif ! use poolreduce to broadcast the results to every pool ! call poolreduce ( 2 * ngms * ngms * nwim, scrcoul_g) ! #endif ! iG(W-v) ALLOCATE ( scrcoul_g (ngmsco, ngmsco, nfs) ) ALLOCATE ( scrcoul_pade_g (ngmsco, ngmsco) ) ALLOCATE ( scrcoul (nrsco, nrsco) ) ALLOCATE ( greenf_g (ngmsco, ngmsco) ) ALLOCATE ( greenfp (nrsco, nrsco) ) ALLOCATE ( greenfm (nrsco, nrsco) ) ALLOCATE ( sigma (nrsco, nrsco, nwsigma) ) ALLOCATE ( sigma_g (ngmsco, ngmsco, nwsigma) ) ! Pade Approximants. ALLOCATE (z(nfs), a(nfs)) ! Array for coulomb frequencies. w_ryd(:) = wcoul(:)/RYTOEV WRITE(6," ") WRITE(6,'(4x,"Direct product GW for k0(",i3," ) = (",3f12.7," )")') ik0, (xk(ipol, ik0), ipol=1,3) WRITE(6," ") ci = (0.0d0, 1.d0) czero = (0.0d0, 0.0d0) sigma(:,:,:) = (0.0d0, 0.0d0) CALL start_clock('gwproduct') CALL allocate_fft() CALL ggen() allocate (igkq ( npwx)) allocate (g2kin ( npwx)) DO iq = 1, nqs CALL prepare_kmq(do_band, do_iq, setup_pw, iq, ik0) ! #ifdef __PARA ! scrcoul_g = czero ! if (me.eq.1.and.mypool.eq.1) then ! #endif ! lrcoul = 2 * ngmsig * ngmsig * nfs. CALL davcio(scrcoul_g, lrcoul, iuncoul, iq, -1 ) !#ifdef __PARA ! endif ! use poolreduce to broadcast the results to every pool ! call poolreduce ( 2 * ngms * ngms * nwim, scrcoul_g) !#endif !Start integration over iw +/- wcoul. DO iw = 1, nwcoul do ig = 1, ngmsco do igp = 1, ngmsco do iwim = 1, nfs z(iwim) = dcmplx( 0.d0, fiu(iwim)) a(iwim) = scrcoul_g (ig,igp,iwim) enddo do iwim = 1, nfs ar = real(a(iwim)) ai = aimag(a(iwim)) if ( ( ar .ne. ar ) .or. ( ai .ne. ai ) ) then ! write(6,*) (z(i),i=1,N) ! write(6,*) (u(i),i=1,N) ! write(6,*) (a(i),i=1,N) a(:) = (0.0d0, 0.0d0) write (6,'("pade-coeffs nan ", 3i4)')ig, igp, iq endif enddo call pade_eval ( nfs, z, a, dcmplx( w_ryd(iw), eta), scrcoul_pade_g (ig,igp)) enddo enddo call fft6_g2r (ngmsco, nrsco, nlsco, scrcoul_pade_g, scrcoul, 1, 2) cprefac = (deltaw/RYTOEV) * wq(iq) * (0.0d0, 1.0d0)/ tpi DO iw0 = 1, nwsigma iw0mw = ind_w0mw (iw0,iw) iw0pw = ind_w0pw (iw0,iw) ! #ifdef __PARA ! greenf_g = czero ! if (me.eq.1.and.mypool.eq.1) then ! #endif rec0 = (iw0mw-1) * 1 * nqs + (ik0-1) * nqs + (iq-1) + 1 CALL davcio( greenf_g, lrgrn, iungreen, rec0, -1 ) !#ifdef __PARA ! endif ! use poolreduce to broadcast the results to every pool ! call poolreduce ( 2 * ngms * ngms, greenf_g ) !#endif !using coulomb routine for fft because of way green_linsys is currently set up... ! CALL fft6_g2r (ngmsco, nrsco, nlsco, greenf_g, greenfm, 1, 1) CALL fft6_g2r (ngmsco, nrsco, nlsco, greenf_g, greenfm, 1, 2) ! #ifdef __PARA ! greenf_g = czero ! if (me.eq.1.and.mypool.eq.1) then ! #endif rec0 = (iw0pw-1) * 1 * nqs + (ik0-1) * nqs + (iq-1) + 1 CALL davcio( greenf_g, lrgrn, iungreen, rec0, -1 ) ! ! !#ifdef __PARA ! endif ! use poolreduce to broadcast the results to every pool ! call poolreduce ( 2 * ngms * ngms, greenf_g ) !#endif ! using coulomb routine for fft because of way green_linsys is currently set up... ! call fft6_g2r (ngmsco, nrsco, nlsco, greenf_g, greenfp, 1, 1) call fft6_g2r (ngmsco, nrsco, nlsco, greenf_g, greenfp, 1, 2) sigma (:,:,iw0) = sigma (:,:,iw0) + cprefac * (greenfp(:,:) + greenfm(:,:)) * scrcoul(:,:) ENDDO !on iw0 ENDDO ! on frequency convolution over w' ENDDO ! end loop on {k0-q} and {q} CALL clean_pw_gw(iq) WRITE(6,'(4x,"Sigma in G-Space")') CALL sigma_r2g_sco(sigma, sigma_g) ! Now write Sigma in G space to file. WRITE(6,'(4x,"Writing Sigma to File")') CALL davcio (sigma_g, lrsigma, iunsigma, ik0, 1) CALL stop_clock('gwproduct') DEALLOCATE ( igkq ) IF (ALLOCATED( g2kin ) ) DEALLOCATE ( g2kin ) DEALLOCATE (z,a) DEALLOCATE ( sigma_g ) DEALLOCATE ( sigma ) DEALLOCATE ( greenfm, greenfp ) DEALLOCATE ( greenf_g ) DEALLOCATE ( scrcoul ) DEALLOCATE ( scrcoul_pade_g ) DEALLOCATE ( scrcoul_g ) RETURN END SUBROUTINE sigma_c