From fc68f23aaa91b27e173f59e1ccf1d857164be699 Mon Sep 17 00:00:00 2001
From: Eric Bylaska <bylaska@gmail.com>
Date: Thu, 26 Jan 2023 17:34:01 -0800
Subject: [PATCH] adding more filtering options to PAW...EJB

---
 src/nwpw/nwpwlib/control/control.F     | 25 +++++++++++++++++++++++++
 src/nwpw/pspw/kbpp/integrate_pawppv1.F |  7 ++++---
 src/nwpw/pspw/kbpp/pawppv1.F           |  6 +++++-
 3 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/src/nwpw/nwpwlib/control/control.F b/src/nwpw/nwpwlib/control/control.F
index 57dea31a5f..010f1e76d2 100644
--- a/src/nwpw/nwpwlib/control/control.F
+++ b/src/nwpw/nwpwlib/control/control.F
@@ -5513,6 +5513,31 @@ c      end if
       return
       end
 
+*     ***********************************
+*     *                                 *
+*     *    control_kbpp_filter_scale    *
+*     *                                 *
+*     ***********************************
+      real*8 function control_kbpp_filter_scale()
+      implicit none
+
+#include "bafdecls.fh"
+#include "btdb.fh"
+      
+*     **** control_rtdb common block ****
+      integer rtdb
+      common / control_rtdb1 / rtdb
+      
+      real*8 scal
+
+      scal = 1.0d0
+      if (.not.btdb_get(rtdb,'nwpw:kbpp_filter_scale',mt_dbl,1,scal))
+     >  scal=1.0d0
+      
+      control_kbpp_filter_scale = scal
+      return
+      end
+
 
 *     ***********************************
 *     *                                 *
diff --git a/src/nwpw/pspw/kbpp/integrate_pawppv1.F b/src/nwpw/pspw/kbpp/integrate_pawppv1.F
index db060fbedb..e3e7d149cf 100644
--- a/src/nwpw/pspw/kbpp/integrate_pawppv1.F
+++ b/src/nwpw/pspw/kbpp/integrate_pawppv1.F
@@ -22,7 +22,7 @@
      >                            comp_charge_matrix,comp_pot_matrix,
      >                            nray,G_ray,vl_ray,vlpaw_ray,vnl_ray,
      >                            tmp_ray,
-     >                            filter,
+     >                            filter,filter_scale,
      >                            ierr)
       implicit none
       integer          version
@@ -67,6 +67,7 @@
       double precision vnl_ray(nray,nbasis,2)
       double precision tmp_ray(nray)
       logical filter
+      double precision filter_scale
 
       integer ierr
 
@@ -509,8 +510,8 @@ c     >                                    f2,2,f4,log_amesh)
 
 *     **** filter the rays ****
       if (filter) then
-         ecut = control_ecut()
-         wcut = control_wcut()
+         ecut = control_ecut()*filter_scale
+         wcut = control_wcut()*filter_scale
          call kbpp_filter_ray(nray,G_ray,ecut,vl_ray)
          call kbpp_filter_ray(nray,G_ray,ecut,vlpaw_ray)
          do i=1,nbasis
diff --git a/src/nwpw/pspw/kbpp/pawppv1.F b/src/nwpw/pspw/kbpp/pawppv1.F
index f8c9a3bd58..da496a4c73 100644
--- a/src/nwpw/pspw/kbpp/pawppv1.F
+++ b/src/nwpw/pspw/kbpp/pawppv1.F
@@ -62,6 +62,7 @@
       integer vnl_ray_hndl,vl_ray_hndl,vlpaw_ray_hndl
       integer G_ray_indx,tmp_ray_indx
       integer vnl_ray_indx,vl_ray_indx,vlpaw_ray_indx
+      real*8 filter_scale
 
 
 *     **** other variables ****
@@ -77,6 +78,8 @@
       external log_integrate_def,log_coulomb0_energy,log_coulomb_energy
       integer  kbpp_calc_nray
       external kbpp_calc_nray
+      real*8   control_kbpp_filter_scale
+      external control_kbpp_filter_scale
 
 
       call Parallel_taskid(taskid)
@@ -292,6 +295,7 @@
       nfft3=ngrid(3)
       call setup_kbpp(nfft1,nfft2,nfft3,unita,unitg,dbl_mb(G_indx))
       filter = control_kbpp_filter()
+      filter_scale = control_kbpp_filter_scale()
 
       !**** allocate memory for rays ****
       nray = kbpp_calc_nray(nfft1,nfft2,nfft3,unita)
@@ -351,7 +355,7 @@
      >                                dbl_mb(vlpaw_ray_indx),
      >                                dbl_mb(vnl_ray_indx),
      >                                dbl_mb(tmp_ray_indx),
-     >                                filter,
+     >                                filter,filter_scale,
      >                      ierr)
         value = BA_free_heap(tmp_ray_hndl)
         value = value.and.BA_free_heap(vl_ray_hndl)