palful · savio-laricchia · Sep 27, 2023 · Nov 13, 2023 · Nov 15, 2023 · Nov 15, 2023
diff --git a/configure b/configure
@@ -2823,10 +2823,11 @@ static char *f (char * (*g) (char **, int), char **p, ...)
    that is true only with -std.  */
 int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1];
 
-/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
-   inside strings and character constants.  */
-#define FOO(x) '\''x'\''
-int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1];
+SVERSION="5"
+SSUBVERSION="1"
+SPATCHLEVEL="0"
+SREVISION="21574"
+SHASH="08ac288ff"
 
 int test (int i, double x);
 struct s1 {int (*f) (int a);};

diff --git a/driver/yambo.F b/driver/yambo.F
@@ -187,7 +187,7 @@ integer function yambo(np,pid,lnstr,iinf,iind,iod,icd,ijs,instr,inf,ind,od,com_d
  !
  driver_now=l_HF_and_locXC.and..not.any((/l_sc_run,l_eval_collisions,l_real_time/))
  !
- if (driver_now) call XCo_driver(en,k,Xk,q)
+ if (driver_now) call XCo_driver(en,k,Xk,q,Dip)
  if (driver_now) call mem_manager_report
  !
  ! EXTENDED COLLISIONS 

diff --git a/include/driver/version.h b/include/driver/version.h
@@ -0,0 +1,30 @@
+/*
+         Copyright (C) 2000-2022 the YAMBO team
+               http://www.yambo-code.org
+
+  Authors (see AUTHORS file for details): AM
+
+  This file is distributed under the terms of the GNU 
+  General Public License. You can redistribute it and/or 
+  modify it under the terms of the GNU General Public 
+  License as published by the Free Software Foundation; 
+  either version 2, or (at your option) any later version.
+
+  This program is distributed in the hope that it will 
+  be useful, but WITHOUT ANY WARRANTY; without even the 
+  implied warranty of MERCHANTABILITY or FITNESS FOR A 
+  PARTICULAR PURPOSE.  See the GNU General Public License 
+  for more details.
+
+  You should have received a copy of the GNU General Public 
+  License along with this program; if not, write to the Free 
+  Software Foundation, Inc., 59 Temple Place - Suite 330,Boston, 
+  MA 02111-1307, USA or visit http://www.gnu.org/copyleft/gpl.txt.
+*/
+
+#define YAMBO_VERSION 5
+#define YAMBO_SUBVERSION 1
+#define YAMBO_PATCHLEVEL 0
+#define YAMBO_REVISION 21786
+#define YAMBO_HASH "995236b2a" 
+
diff --git a/interfaces/int_modules/mod_com2y.F b/interfaces/int_modules/mod_com2y.F
@@ -16,6 +16,7 @@ module mod_com2y
  logical :: force_noSYMM
  logical :: artificial_spin_pol
  logical :: verboseIO
+ logical :: write_Vloc_Vnl
  !
  integer :: ng_vec_abinit, wf_nb_io_user
  !
@@ -47,6 +48,7 @@ subroutine interface_presets(in_string)
      force_noWFs          =index(in_string,'nowf')>0
      artificial_spin_pol  =index(in_string,'dupl')>0
      verboseIO            =index(in_string,'verb')>0
+     write_Vloc_Vnl       =index(in_string,'pseu')>0
      !
      alat_mult_factor=1.
      wf_nb_io_user=0

diff --git a/interfaces/p2y/mod_p2y.F b/interfaces/p2y/mod_p2y.F
@@ -14,7 +14,7 @@ module P2Ym
  use pars,                  ONLY : lchlen,SP,DP,rZERO
  use electrons,             ONLY : levels
  use R_lattice,             ONLY : bz_samp
- use mod_com2y,             ONLY : verboseIO
+ use mod_com2y,             ONLY : verboseIO,write_Vloc_Vnl
  use parallel_m,            ONLY : myid
  use parallel_int,          ONLY : PP_bcast   
  use units,                 ONLY : Da2AU
@@ -851,7 +851,9 @@ subroutine get_xc
       if (ierr/=0) call errore('qexml_read_xc','IOTK error',abs(ierr))
       !
       if (trim(pw_dft)=="B3LYP") call warning('For a full compatible B3LYP calculation consider to use input_dft=B3LYP-V1R')
-      if(pw_lda_plus_u) call error(' LDA+U. Hubbard correction is not considered in yambo.')
+      if (pw_lda_plus_u.and..not.write_Vloc_Vnl) then
+        call error(' DFT+U. Rerun p2y with "-p" flag and use the BareHfromScratch flag for GW runs.')
+      endif
       GS_xc_FUNCTIONAL = XC_yamboID('pwscf_',pw_func=pw_dft)
       if (GS_xc_FUNCTIONAL.eq.XC_HYB_GGA_XC_GAUPBE*XC_FACTOR) then
         GS_xc_KIND = 3
@@ -890,7 +892,9 @@ subroutine get_xc
       if (ierr/=0) call errore('qexsd_read_xc','fmt error',abs(ierr))
       !
       if (trim(pw_dft)=="B3LYP") call warning('For a full compatible B3LYP calculation consider to use input_dft=B3LYP-V1R')
-      if(pw_lda_plus_u) call error(' LDA+U. Hubbard correction is not considered in yambo.')
+      if (pw_lda_plus_u.and..not.write_Vloc_Vnl) then
+        call error(' DFT+U. Rerun p2y with "-p" flag and use the BareHfromScratch flag for GW runs.')
+      endif
       GS_xc_FUNCTIONAL = XC_yamboID('pwscf_',pw_func=pw_dft)
       if (GS_xc_FUNCTIONAL.eq.XC_HYB_GGA_XC_GAUPBE*XC_FACTOR) then
         GS_xc_KIND = 3

diff --git a/interfaces/p2y/p2y_pseudo.F b/interfaces/p2y/p2y_pseudo.F
@@ -22,6 +22,9 @@ subroutine p2y_pseudo(k)
  use IO_int,                ONLY:io_control
  use IO_m,                  ONLY:OP_WR_CL,OP_APP_CL,REP
  use read_pseudo_mod,       ONLY:readpp
+ use mod_com2y,             ONLY:write_Vloc_Vnl
+ use pw_data,               ONLY:ngm_,nsp_
+ use vlocal,                ONLY:vloc_yambo
  !
  implicit none
  !
@@ -33,12 +36,14 @@ subroutine p2y_pseudo(k)
  !
  ! Work space
  !
- integer        :: ngmax,ID,ibeta,ik,io_err,itype
+ integer        :: ngmax,ID,ibeta,ik,io_err,itype,ID_vloc
  character(64)  :: input_dft="none"
+ logical        :: l_Vnl
  !
  integer, external :: io_KB_pwscf
  integer, external :: io_NLCC_pwscf
  integer, external :: io_USPP_pwscf
+ integer, external :: io_VLOC_pwscf
  !
  interface
     subroutine fill_basis(basis,struct,ik,ngmax)
@@ -71,57 +76,67 @@ end subroutine fill_basis_rho
  !
  call pw_basis_init(basis_con,struct)
  !
- if( all(atoms%pseudo(:)%nbeta==0) ) return
- pp_n_l_times_proj_max=maxval((/atoms%pseudo(:)%nbeta/))
- !
- allocate(pp_table(3,n_atomic_species,pp_n_l_times_proj_max))
- allocate(pp_n_l_comp(n_atomic_species))
- call PP_alloc_PWscf()
- pp_table=0
- !
- pp_n_l_max=0
- do itype=1,n_atomic_species
-   pp_n_l_comp(itype)=maxval((/atoms%pseudo(itype)%lbeta(:)/))
-   if(atoms%pseudo(itype)%nbeta==0) pp_n_l_comp(itype)=0   
-   do ibeta=1,atoms%pseudo(itype)%nbeta
-     pp_n_l_max=(max(pp_n_l_max,atoms%pseudo(itype)%lbeta(ibeta)+1))
-     pp_table(1,itype,ibeta) = atoms%pseudo(itype)%lbeta(ibeta)+1               ! l+1
-     pp_table(2,itype,ibeta) = 0
-     if(atoms%pseudo(itype)%has_so) &
-&      pp_table(2,itype,ibeta) = nint(2._SP*atoms%pseudo(itype)%jbeta(ibeta))   ! 2j
-   enddo
- enddo
- pp_table(3,:,:)=1                                                              ! pp_spin
+ l_Vnl=.true.
+ if( all(atoms%pseudo(:)%nbeta==0) ) l_Vnl=.false. 
  !
- call io_control(ACTION=OP_WR_CL,COM=REP,SEC=(/1/),ID=ID)
- io_err=io_KB_pwscf(ID)
+ if(.not.l_Vnl.and..not.write_Vloc_Vnl) return
  !
- do ik=1,k%nibz
+ if(l_Vnl) then
    !
-   call fill_basis(basis_con,struct,ik,ngmax)
-   call PP_PWscf_comp(basis_con,atoms)
+   pp_n_l_times_proj_max=maxval((/atoms%pseudo(:)%nbeta/))
    !
-   ! Write pseudovelocity to disk
-   !
-   call io_control(ACTION=OP_APP_CL,COM=REP,SEC=(/ik+1/),ID=ID)
-   io_err=io_KB_pwscf(ID)
+   allocate(pp_table(3,n_atomic_species,pp_n_l_times_proj_max))
+   allocate(pp_n_l_comp(n_atomic_species))
+   call PP_alloc_PWscf()
+   pp_table=0
    !
- end do
- !
- ! write NLCC info if needed
- !
- if( any(atoms%pseudo(:)%has_nlcc) ) then
+   pp_n_l_max=0
+   do itype=1,n_atomic_species
+     pp_n_l_comp(itype)=maxval((/atoms%pseudo(itype)%lbeta(:)/))
+     if(atoms%pseudo(itype)%nbeta==0) pp_n_l_comp(itype)=0   
+     do ibeta=1,atoms%pseudo(itype)%nbeta
+       pp_n_l_max=(max(pp_n_l_max,atoms%pseudo(itype)%lbeta(ibeta)+1))
+       pp_table(1,itype,ibeta) = atoms%pseudo(itype)%lbeta(ibeta)+1               ! l+1
+       pp_table(2,itype,ibeta) = 0
+       if(atoms%pseudo(itype)%has_so) &
+&        pp_table(2,itype,ibeta) = nint(2._SP*atoms%pseudo(itype)%jbeta(ibeta))   ! 2j
+     enddo
+   enddo
+   pp_table(3,:,:)=1                                                              ! pp_spin
    !
-   call PP_nlcc_alloc()
+   call io_control(ACTION=OP_WR_CL,COM=REP,SEC=(/1/),ID=ID)
+   io_err=io_KB_pwscf(ID)
    !
-   call fill_basis_rho(basis_con,struct,ng_vec)
-   call PP_PWscf_comp_nlcc(basis_con,atoms)
+   do ik=1,k%nibz
+     !
+     call fill_basis(basis_con,struct,ik,ngmax)
+     call PP_PWscf_comp(basis_con,atoms)
+     !
+     ! Write pseudovelocity to disk
+     !
+     call io_control(ACTION=OP_APP_CL,COM=REP,SEC=(/ik+1/),ID=ID)
+     io_err=io_KB_pwscf(ID)
+     !
+   end do
    !
-   call io_control(ACTION=OP_WR_CL,COM=REP,SEC=(/1/),ID=ID)
-   io_err=io_NLCC_pwscf(ID)
+   ! write NLCC info if needed
    !
-   call PP_nlcc_free()
+   if( any(atoms%pseudo(:)%has_nlcc) ) then
+     !
+     call PP_nlcc_alloc()
+     !
+     call fill_basis_rho(basis_con,struct,ng_vec)
+     call PP_PWscf_comp_nlcc(basis_con,atoms)
+     !
+     call io_control(ACTION=OP_WR_CL,COM=REP,SEC=(/1/),ID=ID)
+     io_err=io_NLCC_pwscf(ID)
+     !
+     call PP_nlcc_free()
+     !
+   endif
    !
+ else
+   call warning(' Pseudo-potentials contain only local part!! ')
  endif
  !
  ! write USPP data
@@ -131,14 +146,25 @@ end subroutine fill_basis_rho
  !
  call pre_init()
  call allocate_nlpot()
- !
- if ( any(atoms%pseudo(:)%is_uspp) ) then
+ ! [FP]
+ if ( any(atoms%pseudo(:)%is_uspp) .or. write_Vloc_Vnl ) then
    !
 #ifndef _USPP
-   call error("[PPs] Ultrasoft PP not supported")
+   if (.not. write_Vloc_Vnl) call error("[PPs] Ultrasoft PP not supported")
 #endif
+   ! [FP]
    call init_us_1()
    !
+   if (write_Vloc_Vnl) then
+     !
+     allocate(vloc_yambo(ngm_,nsp_))
+     call set_vloc_yambo()
+     !
+     call io_control(ACTION=OP_WR_CL,COM=REP,SEC=(/1/),ID=ID_vloc)
+     io_err = io_VLOC_pwscf(ID_vloc)
+     !
+   endif
+   !
    call io_control(ACTION=OP_WR_CL,COM=REP,SEC=(/1/),ID=ID)
    io_err=io_USPP_pwscf(ID)
    !
@@ -149,7 +175,8 @@ end subroutine fill_basis_rho
  ! cleanup
  !
  call PP_free()
- deallocate(pp_table,pp_n_l_comp)
+ if (allocated(pp_table))   deallocate(pp_table,pp_n_l_comp)
+ if (allocated(vloc_yambo)) deallocate(vloc_yambo) 
  !
  return
  !
@@ -309,3 +336,32 @@ subroutine fill_basis_rho(basis,struct,ngmax)
  ! 
  return
 end subroutine fill_basis_rho
+!
+subroutine set_vloc_yambo()
+ use gvect,     ONLY: ngl,igtongl,gshells
+ use pw_data,   ONLY: ngm_,nsp_
+ use vlocal,    ONLY: vloc,vloc_yambo
+ implicit none
+ integer :: ig
+ !
+ ! Allocate shells: gl, ngl, igtongl
+ !
+ call gshells()
+ !
+ ! QE vloc without strf is dimensioned over |G|^2 shells (ngl)
+ !
+ allocate(vloc(ngl,nsp_))
+ !
+ ! Calculate QE vloc
+ !
+ call init_vloc()
+ !
+ ! Set up vloc as a function of Gvects and not Gshells
+ !
+ do ig=1,ngm_
+   vloc_yambo(ig,:) = vloc(igtongl(ig),:)
+ enddo
+ !
+ deallocate(vloc)
+ !
+end subroutine set_vloc_yambo 
diff --git a/lib/qe_pseudo/.objects b/lib/qe_pseudo/.objects
@@ -5,4 +5,5 @@ PP_objects = atom.o becmod.o constants.o kind.o parameters.o pseudo_types.o s_ps
              sph_ind.o spinor.o sph_bes.o qvan2.o setqf.o matches.o erf.o allocate_nlpot.o \
              init_run.o qe_pseudo_module.o qe_errore.o addusdens.o sum_bec.o \
              d_matrix.o
-objs = $(PP_objects)
+VLOC_objects = vlocal.o init_vloc.o vloc_of_g.o
+objs = $(PP_objects) $(VLOC_objects)
diff --git a/lib/qe_pseudo/DOUBLE_project.dep b/lib/qe_pseudo/DOUBLE_project.dep
@@ -9,6 +9,7 @@
  init_us_0.o
  init_us_1.o
  init_us_2.o
+ init_vloc.o
  invmat.o
  kind.o
  matches.o
@@ -38,5 +39,7 @@
  upf_to_internal.o
  us_module.o
  uspp.o
+ vloc_of_g.o
+ vlocal.o
  ylmr2.o
 
diff --git a/lib/qe_pseudo/init_vloc.F b/lib/qe_pseudo/init_vloc.F
@@ -0,0 +1,49 @@
+!
+! Copyright (C) 2001-2007 Quantum ESPRESSO group
+! 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 .
+!
+!
+!----------------------------------------------------------------------
+SUBROUTINE init_vloc()
+  !----------------------------------------------------------------------
+  !! This routine computes the fourier coefficient of the local
+  !! potential vloc(ig,it) for each type of atom.
+  !
+  USE atom,           ONLY : msh, rgrid
+  !USE m_gth,          ONLY : vloc_gth
+  USE kinds,          ONLY : DP
+  USE uspp_param,     ONLY : upf
+  USE ions_base,      ONLY : ntyp => nsp
+  USE cell_base,      ONLY : omega, tpiba ! [FP] tpiba2 not in module
+  USE vlocal,         ONLY : vloc
+  USE gvect,          ONLY : ngl, gl, gshells
+  !USE Coul_cut_2D,    ONLY : do_cutoff_2D, cutoff_lr_Vloc
+  !
+  IMPLICIT NONE
+  !
+  INTEGER :: nt
+  ! counter on atomic types
+  !
+  vloc(:,:) = 0._DP
+  !
+  do nt = 1, ntyp
+     !
+     ! compute V_loc(G) for a given type of atom
+     !
+     ! [FP] We only consider the normal case. Check the original
+     !      QE subroutine of the same name for more options
+     !
+     ! normal case
+     !
+     call vloc_of_g( rgrid(nt)%mesh, msh(nt), rgrid(nt)%rab, rgrid(nt)%r, &
+                     upf(nt)%vloc(1), upf(nt)%zp, tpiba**2._DP, ngl, gl, omega, vloc(1,nt) )
+     !
+  enddo
+  !
+  ! [FP] QE cutoff_2D goes here. Not supported so far
+  !
+END SUBROUTINE init_vloc
+
diff --git a/lib/qe_pseudo/qe_pseudo_module.F b/lib/qe_pseudo/qe_pseudo_module.F
@@ -44,7 +44,7 @@ subroutine qe_pseudo_allocate()
     allocate(tau(3,nat))
     !
     call allocate_nlpot()
-    ! 
+    !
   end subroutine
 
   subroutine qe_pseudo_deallocate()