jast2

Makefile

@@ -1,6 +1,6 @@
-IRPF90 = irpf90  #-a -d
+IRPF90 = irpf90  --codelet=factor_een_2:100000 #--codelet=factor_een:10000 
 FC     = gfortran
-FCFLAGS= -O2 -ffree-line-length-none -I .
+FCFLAGS= -O2 -march=native -ffree-line-length-none -I .
 NINJA  = ninja
 ARCHIVE= ar crs
 RANLIB = ranlib

el_nuc_el.irp.f

@@ -11,13 +11,13 @@ BEGIN_PROVIDER [double precision, factor_een]
 
  do alpha = 1, nnuc
     do j = 1, nelec
-       b = rescale_een_n(j, alpha)
+       b = rescale_een_n(j, alpha, 1)
        do i = 1, nelec
-          u = rescale_een_e(i, j)
-          a = rescale_een_n(i, alpha)
+          u = rescale_een_e(i, j, 1)
+          a = rescale_een_n(i, alpha, 1)
           a2 = a * a
           b2 = b * b
-          c = rescale_een_n(i, alpha) * rescale_een_n(j, alpha)
+          c = rescale_een_n(i, alpha, 1) * rescale_een_n(j, alpha, 1)
           c_inv = 1.0d0 / c
           cindex = 0
           do p = 2, ncord
@@ -64,3 +64,50 @@ BEGIN_PROVIDER [double precision, factor_een]
  factor_een = 0.5d0 * factor_een
 
 END_PROVIDER
+
+
+
+BEGIN_PROVIDER [ double precision, factor_een_2 ]
+ implicit none
+ BEGIN_DOC
+ !
+ END_DOC
+ integer :: i,j,a,p,k,l,lmax,m
+ double precision :: riam, rjam_cn, rial, rjal, rijk
+ double precision :: cn
+
+ factor_een_2 = 0.0d0
+
+ do p=2,ncord
+   do k=0,p-1
+     if (k /= 0) then
+       lmax = p-k
+     else
+       lmax = p-k-2
+     endif
+
+     do l=0,lmax
+       if ( iand(p-k-l,1) == 1) cycle
+       m = (p-k-l)/2
+
+       do a=1, nnuc
+         cn = cord_vect_lkp(l,k,p,typenuc_arr(a))
+         do j=1, nelec
+           rjal    = rescale_een_n(j,a,l)
+           rjam_cn = rescale_een_n(j,a,m) * cn
+           do i=1, j-1
+             rial = rescale_een_n(i,a,l)
+             riam = rescale_een_n(i,a,m)
+             rijk = rescale_een_e(i,j,k)
+             factor_een_2 = factor_een_2 + &
+                            rijk * (rial+rjal) * riam * rjam_cn
+           enddo
+         enddo
+       enddo
+
+     enddo
+   enddo
+ enddo
+
+END_PROVIDER
+

jastrow.irp.f

@@ -2,5 +2,7 @@ program jastrow
   implicit none
   print *, 'The total Jastrow factor'
   print *, jastrow_full
+  print *, factor_een
+  print *, factor_een_2
 
 end program

orders.irp.f

@@ -69,3 +69,31 @@ BEGIN_PROVIDER [double precision, aord_vect, (naord + 1, typenuc)]
  close(fu)
 
 END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, cord_vect_lkp, (0:ncord-1, 0:ncord-1, 2:ncord, typenuc) ]
+ implicit none
+ BEGIN_DOC
+ ! 
+ END_DOC
+ integer :: alpha, l,k,p,lmax,cindex
+
+ cord_vect_lkp = 0.d0
+ cindex = 0
+ do alpha=1,typenuc
+   do p = 2, ncord
+     do k = p-1, 0, -1
+       if ( k /= 0 ) then
+         lmax = p - k
+       else
+         lmax = p - k - 2
+       end if
+       do l = lmax, 0, -1
+         if (iand(p-k-l,1) == 1) cycle
+         cindex = cindex + 1
+         cord_vect_lkp(l,k,p,alpha) = cord_vect(cindex, alpha)
+       end do
+     end do
+   end do
+ end do
+
+END_PROVIDER

rescale.irp.f

@@ -42,30 +42,40 @@ BEGIN_PROVIDER [ double precision, rescale_en, (nelec, nnuc) ]
  enddo
 END_PROVIDER
 
-BEGIN_PROVIDER [double precision, rescale_een_e, (nelec, nelec)]
+BEGIN_PROVIDER [double precision, rescale_een_e, (nelec, nelec, 0:ncord)]
  implicit none
  BEGIN_DOC
  ! R = exp(-kappa r) for electron-electron for $J_{een}$
  END_DOC
- integer :: i, j
+ integer :: i, j, l
+ double precision :: kappa_l
 
- do j = 1, nelec
-   do i = 1, nelec
-     rescale_een_e(i, j) = dexp(-kappa * elec_dist(i, j))
-   enddo
+ do l=0,ncord
+  kappa_l = -dble(l) * kappa
+  do j = 1, nelec
+    do i = 1, nelec
+      rescale_een_e(i, j, l) = kappa_l * elec_dist(i, j)
+    enddo
+  enddo
  enddo
+ rescale_een_e = dexp(rescale_een_e)
 END_PROVIDER
 
-BEGIN_PROVIDER [double precision, rescale_een_n, (nelec, nnuc)]
+BEGIN_PROVIDER [double precision, rescale_een_n, (nelec, nnuc, 0:ncord)]
  implicit none
  BEGIN_DOC
  ! R = exp(-kappa r) for electron-electron for $J_{een}$
  END_DOC
- integer :: i, j
+ integer :: i, j, l
+ double precision :: kappa_l
 
- do j = 1, nnuc
-   do i = 1, nelec
-      rescale_een_n(i, j) = dexp(-kappa * elnuc_dist(i, j))
+ do l=0,ncord
+   kappa_l = - dble(l) * kappa
+   do j = 1, nnuc
+     do i = 1, nelec
+       rescale_een_n(i, j, l) = kappa_l * elnuc_dist(i, j)
+     enddo
    enddo
  enddo
+ rescale_een_n = dexp(rescale_een_n)
 END_PROVIDER