Add many call provide in TC

configure

@@ -213,7 +213,7 @@ EOF
               wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
               tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
               cd trexio-${VERSION}
-              ./configure --prefix=\${QP_ROOT} --without-hdf5
+              ./configure --prefix=\${QP_ROOT} --without-hdf5 CFLAGS='-g'
               make -j 8 && make -j 8 check && make -j 8 install
               tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz 
               mv ninja "\${QP_ROOT}"/bin/
@@ -226,7 +226,7 @@ EOF
               wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
               tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
               cd trexio-${VERSION}
-              ./configure --prefix=\${QP_ROOT}
+              ./configure --prefix=\${QP_ROOT} CFLAGS="-g"
               make -j 8 && make -j 8 check && make -j 8 install
 EOF
     elif [[ ${PACKAGE} = qmckl ]] ; then
@@ -237,7 +237,7 @@ EOF
               wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz
               tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz
               cd qmckl-${VERSION}
-              ./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc
+              ./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc CFLAGS='-g'
               make && make -j 4 check && make install
 EOF
  

src/bi_ort_ints/three_body_ijm.irp.f

@@ -18,12 +18,13 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
   double precision :: integral, wall1, wall0
 
   PROVIDE mo_l_coef mo_r_coef
+  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
   three_e_3_idx_direct_bi_ort = 0.d0
   print *, ' Providing the three_e_3_idx_direct_bi_ort ...'
   call wall_time(wall0)
 
-  provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
 
   !$OMP PARALLEL                 &
   !$OMP DEFAULT (NONE)           &
@@ -79,6 +80,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_1_bi_ort, (mo_num, mo_num
 
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
  !$OMP PARALLEL                 &
  !$OMP DEFAULT (NONE)           &
  !$OMP PRIVATE (i,j,m,integral) & 
@@ -135,6 +137,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num
 
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
  !$OMP PARALLEL                 &
  !$OMP DEFAULT (NONE)           &
  !$OMP PRIVATE (i,j,m,integral) & 
@@ -191,6 +194,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num,
 
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
  !$OMP PARALLEL                 &
  !$OMP DEFAULT (NONE)           &
  !$OMP PRIVATE (i,j,m,integral) & 
@@ -247,6 +251,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num,
 
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
  !$OMP PARALLEL                 &
  !$OMP DEFAULT (NONE)           &
  !$OMP PRIVATE (i,j,m,integral) & 
@@ -303,6 +308,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num,
 
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
  !$OMP PARALLEL                 &
  !$OMP DEFAULT (NONE)           &
  !$OMP PRIVATE (i,j,m,integral) & 
@@ -349,6 +355,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort_new, (mo_num, mo_
 
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
 
+  call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
  !$OMP PARALLEL                 &
  !$OMP DEFAULT (NONE)           &
  !$OMP PRIVATE (i,j,m,integral) & 

src/bi_ort_ints/three_body_ints_bi_ort.irp.f

@@ -29,6 +29,9 @@ BEGIN_PROVIDER [ double precision, three_body_ints_bi_ort, (mo_num, mo_num, mo_n
 
   !provide x_W_ki_bi_ortho_erf_rk
   provide mos_r_in_r_array_transp mos_l_in_r_array_transp
+  provide int2_grad1_u12_ao_transp final_grid_points int2_grad1_u12_bimo_t
+  provide mo_l_coef mo_r_coef mos_l_in_r_array_transp mos_r_in_r_array_transp n_points_final_grid
+
 
  !$OMP PARALLEL                       &
  !$OMP DEFAULT (NONE)                 &

src/non_h_ints_mu/jast_deriv.irp.f

@@ -121,29 +121,32 @@
     double precision :: f
     f = 1.d0 / dble(elec_num - 1)
 
+    integer*8 :: n_points, k
+    n_points = n_points_extra_final_grid * n_points_final_grid
+
     double precision, allocatable :: rij(:,:,:)
-    allocate( rij(3, 2, n_points_extra_final_grid) )
+    allocate( rij(3, 2, n_points) )
 
     use qmckl
     integer(qmckl_exit_code) :: rc
 
-    integer*8 :: npoints
-    npoints = n_points_extra_final_grid
-
     double precision, allocatable :: gl(:,:,:)
-    allocate( gl(2,4,n_points_extra_final_grid) )
+    allocate( gl(2,4,n_points) )
 
+    k=0
     do ipoint = 1, n_points_final_grid  ! r1
-
       do jpoint = 1, n_points_extra_final_grid ! r2
-        rij(1:3, 1, jpoint) = final_grid_points      (1:3, ipoint)
+        k=k+1
-        rij(1:3, 2, jpoint) = final_grid_points_extra(1:3, jpoint)
+        rij(1:3, 1, k) = final_grid_points      (1:3, ipoint)
+        rij(1:3, 2, k) = final_grid_points_extra(1:3, jpoint)
+      enddo
     enddo
 
 
-      rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', npoints, rij, npoints*6_8)
+    rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', n_points, rij, n_points*6_8)
     if (rc /= QMCKL_SUCCESS) then
       print *, irp_here, 'qmckl error in set_electron_coord'
+      rc = qmckl_check(qmckl_ctx_jastrow, rc)
       stop -1
     endif
 
@@ -151,46 +154,60 @@
     ! ---
     ! e-e term
 
-      rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*npoints)
+    rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
     if (rc /= QMCKL_SUCCESS) then
       print *, irp_here, ' qmckl error in fact_ee_gl'
+      rc = qmckl_check(qmckl_ctx_jastrow, rc)
       stop -1
     endif
 
+    k=0
+    do ipoint = 1, n_points_final_grid  ! r1
       do jpoint = 1, n_points_extra_final_grid ! r2
-        grad1_u12_num(jpoint,ipoint,1) = gl(1,1,jpoint)
+        k=k+1
-        grad1_u12_num(jpoint,ipoint,2) = gl(1,2,jpoint)
+        grad1_u12_num(jpoint,ipoint,1) = gl(1,1,k)
-        grad1_u12_num(jpoint,ipoint,3) = gl(1,3,jpoint)
+        grad1_u12_num(jpoint,ipoint,2) = gl(1,2,k)
+        grad1_u12_num(jpoint,ipoint,3) = gl(1,3,k)
+      enddo
     enddo
 
     ! ---
     ! e-e-n term
 
-!    rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*npoints)
+!    rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
 !    if (rc /= QMCKL_SUCCESS) then
 !      print *, irp_here, 'qmckl error in fact_een_gl'
+!        rc = qmckl_check(qmckl_ctx_jastrow, rc)
 !      stop -1
 !    endif
 !
+!    k=0
+!    do ipoint = 1, n_points_final_grid  ! r1
 !    do jpoint = 1, n_points_extra_final_grid ! r2
-!        grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,jpoint)
+!        k=k+1
-!        grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,jpoint)
+!        grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,k)
-!        grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,jpoint)
+!        grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,k)
+!        grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,k)
+!    enddo
 !    enddo
 
       ! ---
       ! e-n term
 
-      rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*npoints)
+    rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
     if (rc /= QMCKL_SUCCESS) then
       print *, irp_here, 'qmckl error in fact_en_gl'
+      rc = qmckl_check(qmckl_ctx_jastrow, rc)
       stop -1
     endif
 
+    k=0
+    do ipoint = 1, n_points_final_grid  ! r1
       do jpoint = 1, n_points_extra_final_grid ! r2
-        grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,jpoint)
+        k = k+1
-        grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,jpoint)
+        grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,k)
-        grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,jpoint)
+        grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,k)
+        grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,k)
       enddo
 
       do jpoint = 1, n_points_extra_final_grid ! r2
@@ -199,7 +216,6 @@
         dz = grad1_u12_num(jpoint,ipoint,3)
         grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz
       enddo
-
     enddo
 
     deallocate(gl, rij)

src/non_h_ints_mu/qmckl.irp.f

@@ -59,6 +59,10 @@ BEGIN_PROVIDER [ integer*8, qmckl_ctx_jastrow ]
   if (rc /= QMCKL_SUCCESS) stop -1
 
 
+  rc =  qmckl_set_jastrow_champ_cord_num(qmckl_ctx_jastrow, jast_qmckl_cord_num*1_8)
+  rc = qmckl_check(qmckl_ctx_jastrow, rc)
+  if (rc /= QMCKL_SUCCESS) stop -1
+
   if (jast_qmckl_cord_num > 0) then
     rc =  qmckl_set_jastrow_champ_c_vector(qmckl_ctx_jastrow, jast_qmckl_c_vector, 1_8*jast_qmckl_c_vector_size)
     rc = qmckl_check(qmckl_ctx_jastrow, rc)

src/tc_bi_ortho/tc_bi_ortho.irp.f

@@ -13,6 +13,17 @@ program tc_bi_ortho
   my_n_pt_a_grid = tc_grid1_a
   touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
 
+  if(j1b_type .ge. 100) then
+    my_extra_grid_becke  = .True.
+    PROVIDE tc_grid2_a tc_grid2_r
+    my_n_pt_r_extra_grid = tc_grid2_r
+    my_n_pt_a_extra_grid = tc_grid2_a
+    touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid
+
+    call write_int(6, my_n_pt_r_extra_grid, 'radial  internal grid over')
+    call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over')
+  endif
+
   read_wf = .True.
   touch read_wf
 

src/tc_scf/tc_petermann_factor.irp.f

@@ -30,9 +30,22 @@ subroutine main()
 
   allocate(Sl(mo_num,mo_num), Sr(mo_num,mo_num), Pf(mo_num,mo_num))
 
-  call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0                       &
+
-            , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
+  call LTxSxR(ao_num, mo_num, mo_l_coef, ao_overlap, mo_r_coef, Sl)
-            , 0.d0, Sl, size(Sl, 1) )
+  !call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0                       &
+  !          , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
+  !          , 0.d0, Sl, size(Sl, 1) )
+
+  print *, ''
+  print *, ' left-right orthog matrix:'
+  do i = 1, mo_num
+    write(*,'(100(F8.4,X))') Sl(:,i)
+  enddo
+
+  call LTxSxR(ao_num, mo_num, mo_l_coef, ao_overlap, mo_l_coef, Sl)
+  !call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0                       &
+  !          , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
+  !          , 0.d0, Sl, size(Sl, 1) )
 
   print *, ''
   print *, ' left-orthog matrix:'
@@ -40,9 +53,10 @@ subroutine main()
     write(*,'(100(F8.4,X))') Sl(:,i)
   enddo
 
-  call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0                       &
+  call LTxSxR(ao_num, mo_num, mo_r_coef, ao_overlap, mo_r_coef, Sr)
-            , mo_r_coef, size(mo_r_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
+!  call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0                       &
-            , 0.d0, Sr, size(Sr, 1) )
+!            , mo_r_coef, size(mo_r_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
+!            , 0.d0, Sr, size(Sr, 1) )
 
   print *, ''
   print *, ' right-orthog matrix:'