TREX/irpjast
1
0
Fork 0
mirror of https://github.com/TREX-CoE/irpjast.git synced 2025-01-03 18:16:31 +01:00
Code Issues Projects Releases Wiki Activity

Included subroutine to interface with CHAMP

Browse Source
This commit is contained in:
Panadestein 2021-01-17 15:34:06 +01:00
parent b9021dc2b4
commit 5b53a27800
22 changed files with 271 additions and 300 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@ -3,4 +3,5 @@ IRPF90_man/
irpf90.make irpf90.make
irpf90_entities irpf90_entities
tags tags
*.mod *.mod
jastrow

8
Makefile
View File

@ -1,12 +1,12 @@
IRPF90 = irpf90 #-a -d IRPF90 = irpf90 #-a -d
FC = ifort FC = gfortran
FCFLAGS= -O2 -I . FCFLAGS= -O2 -ffree-line-length-none -I .
NINJA = ninja NINJA = ninja
ARCHIVE= ar crs ARCHIVE= ar crs
RANLIB = ranlib RANLIB = ranlib
SRC=inputs.f90 SRC=jastrow_transirp.f
OBJ= OBJ=jastrow_transirp.o
LIB= LIB=
-include irpf90.make -include irpf90.make

3
README.org
View File

@ -1,3 +0,0 @@
* IRPJAST
CHAMP's Jastrow factor computation using the IRPF90 method

29
codelet_factor_een.f
View File

@ -1,29 +0,0 @@
program codelet_factor_een
implicit none
integer :: i
double precision :: ticks_0, ticks_1, cpu_0, cpu_1
integer, parameter :: irp_imax = 100000
call provide_factor_een
double precision :: irp_rdtsc
call cpu_time(cpu_0)
ticks_0 = irp_rdtsc()
do i=1,irp_imax
call bld_factor_een
enddo
ticks_1 = irp_rdtsc()
call cpu_time(cpu_1)
print *, 'factor_een'
print *, '-----------'
print *, 'Cycles:'
print *, (ticks_1-ticks_0)/dble(irp_imax)
print *, 'Seconds:'
print *, (cpu_1-cpu_0)/dble(irp_imax)
end

52
deriv_num.irp.f
View File

@ -1,52 +0,0 @@
program jastrow
implicit none
print *, 'Derivatives test'
integer :: k
double precision :: j1, j2, j0, deriv, dt, lapl
dt = 1.0d-4
BEGIN_TEMPLATE
lapl = 0.0d0
j0 = $X $Y
do k = 1, 3
elec_coord(1, k) -= dt
TOUCH elec_coord
j1 = $X $Y
elec_coord(1, k) += 2.0d0*dt
TOUCH elec_coord
j2 = $X $Y
deriv = (j2 - j1) / (2.0d0 * dt)
lapl += (j2 - 2.0d0*j0 + j1) / (dt*dt)
print *, 'Deriv $X '
print *, deriv
print *, $X_deriv_e(k, $Z)
print *, ''
elec_coord(1, k) -= dt
TOUCH elec_coord
enddo
print *, 'Lapl $X '
print *, lapl
print *, $X_deriv_e(4, $Z)
print *, ''
SUBST [X, Y, Z]
factor_ee ; ; 1;;
END_TEMPLATE
!factor_een ; ; 1;;
!rescale_een_e ; (1,3,1) ; 1,3,1 ;;
!rescale_een_n ; (1,1,2) ; 1,1,2 ;;
!rescale_een_e ; (1, 2, 2) ; 1, 2, 2 ;;
!factor_en ; ; 1;;
!rescale_en ; (1, 2) ; 1, 2 ;;
!factor_ee ; ; 1;;
!rescale_ee ; (1, 2) ; 1, 2 ;;
!elnuc_dist ; (1,1); 1,1 ;;
!elec_dist ; (1,2); 1,2 ;;
end program

10
elec_coord.txt
View File

@ -1,10 +0,0 @@
-0.250655104764153 0.503070975550133 -0.166554344502303
-0.587812193472177 -0.128751981129274 0.187773606533075
1.61335569047166 -0.615556732874863 -1.43165470979934
-4.901239896295210E-003 -1.120440036458986E-002 1.99761909330422
0.766647499681200 -0.293515395797937 3.66454589201239
-0.127732483187947 -0.138975497694196 -8.669850480215846E-002
-0.232271834949124 -1.059321673434182E-002 -0.504862241464867
1.09360863531826 -2.036103063808752E-003 -2.702796910818986E-002
-0.108090166832043 0.189161729653261 2.15398313919894
0.397978144318712 -0.254277292595981 2.54553335476344

2
force.h Normal file
View File

@ -0,0 +1,2 @@
c MFORCE must be >= 3. It is used also in the optimization for the multiple adiag step
parameter (MFORCE=3,MFORCE_WT_PRD=1000,MWF=3)

2
geometry.txt
View File

@ -1,2 +0,0 @@
0.000000 0.000000 0.000000
0.000000 0.000000 2.059801

21
input.irp.f
View File

@ -1,21 +0,0 @@
BEGIN_PROVIDER [ double precision, elec_coord, (nelec, 3) ]
&BEGIN_PROVIDER [ double precision, nuc_coord, (nnuc, 3) ]
&BEGIN_PROVIDER [double precision, aord_vect, (naord + 1, typenuc)]
&BEGIN_PROVIDER [double precision, bord_vect, (nbord + 1)]
&BEGIN_PROVIDER [double precision, cord_vect, (dim_cord_vect, typenuc)]
implicit none
BEGIN_DOC
! Reads all input requested for Jatrow computation from an external procedure.
! Can be be used to interface with CHAMP
END_DOC
call irpinp(nelec, elec_coord, nnuc, typenuc, nuc_coord, &
naord, nbord, dim_cord_vect, aord_vect, bord_vect, cord_vect)
TOUCH elec_coord
TOUCH nuc_coord
TOUCH aord_vect
TOUCH bord_vect
TOUCH cord_vect
END_PROVIDER

58
input.irp.f.backup
View File

@ -1,58 +0,0 @@
BEGIN_PROVIDER [ double precision, elec_coord, (nelec, 3) ]
implicit none
BEGIN_DOC
! Electron coordinates
END_DOC
character(len=*), parameter :: FILE_NAME = "elec_coord.txt"
integer :: fu, rc, i, j
open(action='read', file=FILE_NAME, iostat=rc, newunit=fu)
do i = 1, nelec
read(fu, *) elec_coord(i, :)
end do
close(fu)
END_PROVIDER
BEGIN_PROVIDER [ double precision, nuc_coord, (nnuc, 3) ]
implicit none
BEGIN_DOC
! Nuclei coordinates
END_DOC
character(len=*), parameter :: FILE_NAME = "geometry.txt"
integer :: fu, rc, i
open(action='read', file=FILE_NAME, iostat=rc, newunit=fu)
do i = 1, nnuc
read(fu, *) nuc_coord(i, :)
end do
close(fu)
END_PROVIDER
BEGIN_PROVIDER [double precision, aord_vect, (naord + 1, typenuc)]
&BEGIN_PROVIDER [double precision, bord_vect, (nbord + 1)]
&BEGIN_PROVIDER [double precision, cord_vect, (dim_cord_vect, typenuc)]
implicit none
BEGIN_DOC
! Read Jastow coefficients from file
END_DOC
PROVIDE naord
PROVIDE nbord
PROVIDE ncord
character(len=*), parameter :: FILE_NAME = "jast_coeffs.txt"
integer :: i, fu, rc
open(action='read', file=FILE_NAME, iostat=rc, newunit=fu)
read(fu, *) aord_vect
read(fu, *) bord_vect
read(fu, *) cord_vect
close(fu)
END_PROVIDER

16
inputs.f90
View File

@ -1,16 +0,0 @@
subroutine irpinp(nelec, elec_coord, nnuc, typenuc, nuc_coord, &
naord, nbord, ncord, aord_vect, bord_vect, cord_vect)
! This is a ghost subroutine to interop with CHAMP variables
implicit none
integer, intent(in) :: nelec
integer, intent(in) :: nnuc
integer, intent(in) :: typenuc
integer, intent(in) :: naord
integer, intent(in) :: nbord
integer, intent(in) :: ncord
double precision, dimension(nelec, 3), intent(inout) :: elec_coord
double precision, dimension(nnuc, 3), intent(inout) :: nuc_coord
double precision, dimension(naord + 1, typenuc), intent(inout) :: aord_vect
double precision, dimension(nbord + 1), intent(inout) :: bord_vect
double precision, dimension(ncord, typenuc), intent(inout) :: cord_vect
end subroutine irpinp

35
jast_coeffs.txt
View File

@ -1,35 +0,0 @@
0.00000000
0.00000000
-0.380512
-0.157996
-0.031558
0.021512
0.5000000
0.153660
0.0672262
0.021570
0.0073096
0.002866
0.571702
-0.5142530
-0.513043
0.009486
-0.004205
0.4263258
0.0828815
0.0051186
-0.0029978
-0.0052704
-0.000075
-0.0830165
0.0145434
0.0514351
0.000925
-0.0040991
0.0043276
-0.00165447
0.002614
-0.001477
-0.0011370
-0.04010475
0.00610671

9
jastrow.irp.f
View File

@ -1,6 +1,7 @@
program jastrow program jastrow_irp
implicit none implicit none
print *, 'The total Jastrow factor' TOUCH elec_coord
print *, jastrow_full print *, "J_{IRP} = ", jastrow_full
print *, "\nabla J_{IRP} = ", jastrow_derivs(1:3, :)
print *, "\nabla^2 J_{IRP} = ", jastrow_derivs(4, :)
end program end program

63
orders.irp.f → jastrow_input.irp.f
View File

@ -1,3 +1,55 @@
BEGIN_PROVIDER [ integer, nelec ]
implicit none
BEGIN_DOC
! Number of electrons
END_DOC
nelec = 10
END_PROVIDER
BEGIN_PROVIDER [ integer, nelec_up ]
implicit none
BEGIN_DOC
! Number of alpha and beta electrons
END_DOC
nelec_up = 5
END_PROVIDER
BEGIN_PROVIDER [ double precision, elec_coord, (nelec, 3) ]
implicit none
BEGIN_DOC
! Electron coordinates
END_DOC
call jast_elec_champ(nelec, elec_coord)
END_PROVIDER
BEGIN_PROVIDER [ integer, nnuc ]
implicit none
BEGIN_DOC
! Number of nuclei
END_DOC
nnuc = 2
END_PROVIDER
BEGIN_PROVIDER [ integer, typenuc ]
&BEGIN_PROVIDER [integer, typenuc_arr, (nnuc)]
implicit none
BEGIN_DOC
! Type of the nuclei
END_DOC
typenuc = 1
typenuc_arr = (/1, 1/)
END_PROVIDER
BEGIN_PROVIDER [ double precision, nuc_coord, (nnuc, 3) ]
implicit none
BEGIN_DOC
! Nuclei coordinates
END_DOC
call jast_nuc_champ(nnuc, nuc_coord)
END_PROVIDER
BEGIN_PROVIDER [integer, naord] BEGIN_PROVIDER [integer, naord]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -45,6 +97,17 @@ BEGIN_PROVIDER [integer, dim_cord_vect]
end do end do
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [double precision, aord_vect, (naord + 1, typenuc)]
&BEGIN_PROVIDER [double precision, bord_vect, (nbord + 1)]
&BEGIN_PROVIDER [double precision, cord_vect, (dim_cord_vect, typenuc)]
implicit none
BEGIN_DOC
! Read Jastow coefficients from file
END_DOC
call jast_pars_champ(naord, typenuc, aord_vect, nbord, bord_vect, dim_cord_vect, cord_vect)
END_PROVIDER
BEGIN_PROVIDER [ double precision, cord_vect_lkp, (0:ncord-1, 0:ncord-1, 2:ncord, typenuc) ] BEGIN_PROVIDER [ double precision, cord_vect_lkp, (0:ncord-1, 0:ncord-1, 2:ncord, typenuc) ]
implicit none implicit none

35
electrons.irp.f → jastrow_jee.irp.f
View File

@ -1,19 +1,3 @@
BEGIN_PROVIDER [ integer, nelec ]
implicit none
BEGIN_DOC
! Number of electrons
END_DOC
nelec = 10
END_PROVIDER
BEGIN_PROVIDER [ integer, nelec_up ]
implicit none
BEGIN_DOC
! Number of alpha and beta electrons
END_DOC
nelec_up = 5
END_PROVIDER
BEGIN_PROVIDER [ double precision, elec_dist, (nelec, nelec) ] BEGIN_PROVIDER [ double precision, elec_dist, (nelec, nelec) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -60,20 +44,18 @@ BEGIN_PROVIDER [double precision, factor_ee]
! Electron-electron contribution to Jastrow factor ! Electron-electron contribution to Jastrow factor
END_DOC END_DOC
integer :: i, j, p, ipar integer :: i, j, p, ipar
double precision :: pow_ser, x, spin_fact double precision :: pow_ser, spin_fact
factor_ee = 0.0d0 factor_ee = 0.0d0
do j = 1, nelec do j = 1, nelec
do i = 1, j - 1 do i = 1, j - 1
x = rescale_ee(i, j)
pow_ser = 0.0d0 pow_ser = 0.0d0
spin_fact = 1.0d0 spin_fact = 1.0d0
ipar = 1 ipar = 1
do p = 2, nbord do p = 2, nbord
x = x * rescale_ee(i, j) pow_ser = pow_ser + bord_vect(p + 1) * rescale_ee_stored(p, i, j)
pow_ser = pow_ser + bord_vect(p + 1) * x
end do end do
if (j.le.nelec_up .or. i.gt.nelec_up) then if (j.le.nelec_up .or. i.gt.nelec_up) then
@ -96,7 +78,7 @@ BEGIN_PROVIDER [double precision, factor_ee_deriv_e, (4, nelec) ]
! Dimension 4 : d2x + d2y + d2z ! Dimension 4 : d2x + d2y + d2z
END_DOC END_DOC
integer :: i, ii, j, p integer :: i, ii, j, p
double precision :: x, x_inv, y, den, invden, lap1, lap2, lap3, third, spin_fact double precision :: y, den, invden, lap1, lap2, lap3, third, spin_fact
double precision, dimension(3) :: pow_ser_g double precision, dimension(3) :: pow_ser_g
double precision, dimension(4) :: dx double precision, dimension(4) :: dx
@ -109,7 +91,6 @@ BEGIN_PROVIDER [double precision, factor_ee_deriv_e, (4, nelec) ]
spin_fact = 1.0d0 spin_fact = 1.0d0
den = 1.0d0 + bord_vect(2) * rescale_ee(i, j) den = 1.0d0 + bord_vect(2) * rescale_ee(i, j)
invden = 1.0d0 / den invden = 1.0d0 / den
x_inv = 1.0d0 / (rescale_ee(i, j) + 1.0d-18)
do ii = 1, 4 do ii = 1, 4
dx(ii) = rescale_ee_deriv_e(ii, j, i) dx(ii) = rescale_ee_deriv_e(ii, j, i)
@ -124,16 +105,14 @@ BEGIN_PROVIDER [double precision, factor_ee_deriv_e, (4, nelec) ]
lap2 = 0.0d0 lap2 = 0.0d0
lap3 = 0.0d0 lap3 = 0.0d0
do ii = 1, 3 do ii = 1, 3
x = rescale_ee(i, j)
do p = 2, nbord do p = 2, nbord
! p a_{p+1} r[i,j]^(p-1) ! p b_{p+1} r[i,j]^(p-1)
y = p * bord_vect(p + 1) * x y = p * bord_vect(p + 1) * rescale_ee_stored(p - 1, i, j)
pow_ser_g(ii) += y * dx(ii) pow_ser_g(ii) += y * dx(ii)
! (p-1) p a_{p+1} r[i,j]^(p-2) r'[i,j]^2 ! (p-1) p b_{p+1} r[i,j]^(p-2) r'[i,j]^2
lap1 += (p - 1) * y * x_inv * dx(ii) * dx(ii) lap1 += (p - 1) * p * bord_vect(p + 1) * rescale_ee_stored(p - 2, i, j) * dx(ii) * dx(ii)
! p a_{p+1} r[i,j]^(p-1) r''[i,j] ! p a_{p+1} r[i,j]^(p-1) r''[i,j]
lap2 += y lap2 += y
x = x * rescale_ee(i, j)
end do end do
! (a1 (-2 a2 r'[i,j]^2+(1+a2 r[i,j]) r''[i,j]))/(1+a2 r[i,j])^3 ! (a1 (-2 a2 r'[i,j]^2+(1+a2 r[i,j]) r''[i,j]))/(1+a2 r[i,j])^3

4
el_nuc_el.irp.f → jastrow_jeen.irp.f
View File

@ -41,8 +41,8 @@ END_PROVIDER
BEGIN_PROVIDER [ double precision, factor_een_deriv_e, (4, nelec) ] BEGIN_PROVIDER [ double precision, factor_een_deriv_e, (4, nelec) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Dimensions 1-3: dx, dy, dz ! Dimensions 1-3 : dx, dy, dz
! Dimension 4: d2x + d2y + d2z ! Dimension 4 : d2x + d2y + d2z
END_DOC END_DOC
integer :: i, ii, j, a, p, k, l, lmax, m integer :: i, ii, j, a, p, k, l, lmax, m
double precision :: riam, rjam_cn, rial, rjal, rijk double precision :: riam, rjam_cn, rial, rjal, rijk

35
nuclei.irp.f → jastrow_jen.irp.f
View File

@ -1,22 +1,3 @@
BEGIN_PROVIDER [ integer, nnuc ]
implicit none
BEGIN_DOC
! Number of nuclei
END_DOC
nnuc = 2
END_PROVIDER
BEGIN_PROVIDER [ integer, typenuc ]
&BEGIN_PROVIDER [integer, typenuc_arr, (nnuc)]
implicit none
BEGIN_DOC
! Type of the nuclei
END_DOC
typenuc = 1
typenuc_arr = (/1, 1/)
END_PROVIDER
BEGIN_PROVIDER [ double precision, elnuc_dist, (nelec, nnuc) ] BEGIN_PROVIDER [ double precision, elnuc_dist, (nelec, nnuc) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -40,18 +21,16 @@ BEGIN_PROVIDER [double precision, factor_en]
! Electron-nuclei contribution to Jastrow factor ! Electron-nuclei contribution to Jastrow factor
END_DOC END_DOC
integer :: i, a, p integer :: i, a, p
double precision :: pow_ser, x double precision :: pow_ser
factor_en = 0.0d0 factor_en = 0.0d0
do a = 1 , nnuc do a = 1 , nnuc
do i = 1, nelec do i = 1, nelec
x = rescale_en(i, a)
pow_ser = 0.0d0 pow_ser = 0.0d0
do p = 2, naord do p = 2, naord
x = x * rescale_en(i, a) pow_ser = pow_ser + aord_vect(p + 1, typenuc_arr(a)) * rescale_en_stored(p, i, a)
pow_ser = pow_ser + aord_vect(p + 1, typenuc_arr(a)) * x
end do end do
factor_en = factor_en + aord_vect(1, typenuc_arr(a)) * rescale_en(i, a) & factor_en = factor_en + aord_vect(1, typenuc_arr(a)) * rescale_en(i, a) &
@ -69,7 +48,7 @@ BEGIN_PROVIDER [double precision, factor_en_deriv_e, (4, nelec) ]
! Dimension 4 : d2x + d2y + d2z ! Dimension 4 : d2x + d2y + d2z
END_DOC END_DOC
integer :: i, ii, a, p integer :: i, ii, a, p
double precision :: x, x_inv, y, den, invden, lap1, lap2, lap3, third double precision :: y, den, invden, lap1, lap2, lap3, third
double precision, dimension(3) :: pow_ser_g double precision, dimension(3) :: pow_ser_g
double precision, dimension(4) :: dx double precision, dimension(4) :: dx
@ -81,7 +60,6 @@ BEGIN_PROVIDER [double precision, factor_en_deriv_e, (4, nelec) ]
pow_ser_g = 0.0d0 pow_ser_g = 0.0d0
den = 1.0d0 + aord_vect(2, typenuc_arr(a)) * rescale_en(i, a) den = 1.0d0 + aord_vect(2, typenuc_arr(a)) * rescale_en(i, a)
invden = 1.0d0 / den invden = 1.0d0 / den
x_inv = 1.0d0 / rescale_en(i, a)
do ii = 1, 4 do ii = 1, 4
dx(ii) = rescale_en_deriv_e(ii, i, a) dx(ii) = rescale_en_deriv_e(ii, i, a)
@ -91,16 +69,15 @@ BEGIN_PROVIDER [double precision, factor_en_deriv_e, (4, nelec) ]
lap2 = 0.0d0 lap2 = 0.0d0
lap3 = 0.0d0 lap3 = 0.0d0
do ii = 1, 3 do ii = 1, 3
x = rescale_en(i, a)
do p = 2, naord do p = 2, naord
! p a_{p+1} r[i,a]^(p-1) ! p a_{p+1} r[i,a]^(p-1)
y = p * aord_vect(p + 1, typenuc_arr(a)) * x y = p * aord_vect(p + 1, typenuc_arr(a)) * rescale_en_stored(p - 1, i, a)
pow_ser_g(ii) += y * dx(ii) pow_ser_g(ii) += y * dx(ii)
! (p-1) p a_{p+1} r[i,a]^(p-2) r'[i,a]^2 ! (p-1) p a_{p+1} r[i,a]^(p-2) r'[i,a]^2
lap1 += (p - 1) * y * x_inv * dx(ii) * dx(ii) lap1 += (p - 1) * p * aord_vect(p + 1, typenuc_arr(a)) * &
rescale_en_stored(p - 2, i, a) * dx(ii) * dx(ii)
! p a_{p+1} r[i,a]^(p-1) r''[i,a] ! p a_{p+1} r[i,a]^(p-1) r''[i,a]
lap2 += y lap2 += y
x = x * rescale_en(i, a)
end do end do
! (a1 (-2 a2 r'[i,a]^2+(1+a2 r[i,a]) r''[i,a]))/(1+a2 r[i,a])^3 ! (a1 (-2 a2 r'[i,a]^2+(1+a2 r[i,a]) r''[i,a]))/(1+a2 r[i,a])^3

34
jastrow_provider.irp.f
View File

@ -3,13 +3,35 @@ BEGIN_PROVIDER [ double precision, jastrow_full ]
BEGIN_DOC BEGIN_DOC
! Complete jastrow factor ! Complete jastrow factor
END_DOC END_DOC
integer :: i, j
print *, "J_ee = ", factor_ee if (ncord == 0) then
print *, "J_en = ", factor_en jastrow_full = factor_ee + factor_en
print *, "J_een = ", factor_een else
print *, "J = J_ee + J_en + J_een = ", factor_ee + factor_en + factor_een jastrow_full = factor_ee + factor_en + factor_een
endif
jastrow_full = dexp(factor_ee + factor_en + factor_een) !print *, "J_ee = ", factor_ee
!print *, "J_en = ", factor_en
!print *, "J_een = ", factor_een
!print *, "J = J_ee + J_en + J_een = ", factor_ee + factor_en + factor_een
END_PROVIDER
BEGIN_PROVIDER [ double precision, jastrow_derivs, (4, nelec) ]
implicit none
BEGIN_DOC
! Gradient and Laplacian
! Dimensions 1-3 : dx, dy, dz
! Dimension 4 : d2x + d2y + d2z
END_DOC
if (ncord == 0) then
jastrow_derivs = factor_ee_deriv_e + factor_en_deriv_e
else
jastrow_derivs = factor_ee_deriv_e + factor_en_deriv_e + factor_een_deriv_e
endif
!print *, "\nabla J", jastrow_derivs(1:3, :)
!print *, "\nabla^2 J = ", jastrow_derivs(4, :)
END_PROVIDER END_PROVIDER

40
rescale.irp.f → jastrow_rescaledist.irp.f
View File

@ -28,6 +28,26 @@ BEGIN_PROVIDER [ double precision, rescale_ee, (nelec, nelec) ]
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [double precision, rescale_ee_stored, (0:nbord, nelec, nelec)]
implicit none
BEGIN_DOC
! Stores the powers of the rescaled r_ee
END_DOC
integer :: i, j, p
double precision :: x
do j = 1, nelec
do i = 1, nelec
x = 1.0d0
do p = 0, nbord
rescale_ee_stored(p, i, j) = x
x = x * rescale_ee(i, j)
end do
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, rescale_ee_deriv_e, (4, nelec, nelec) ] BEGIN_PROVIDER [ double precision, rescale_ee_deriv_e, (4, nelec, nelec) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -68,6 +88,26 @@ BEGIN_PROVIDER [ double precision, rescale_en, (nelec, nnuc) ]
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [double precision, rescale_en_stored, (0:naord, nelec, nnuc)]
implicit none
BEGIN_DOC
! Stores the powers of the rescaled r_ee
END_DOC
integer :: i, a, p
double precision :: x
do a = 1, nnuc
do i = 1, nelec
x = 1.0d0
do p = 0, naord
rescale_en_stored(p, i, a) = x
x = x * rescale_en(i, a)
end do
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, rescale_en_deriv_e, (4, nelec, nnuc) ] BEGIN_PROVIDER [ double precision, rescale_en_deriv_e, (4, nelec, nnuc) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC

86
jastrow_transirp.f Normal file
View File

@ -0,0 +1,86 @@
subroutine jast_elec_champ(nelec, elec_coord)
! This subroutine allows for a correct interfacing between
! the Jastrow IRPF90 files and the CHAMP variables
implicit real*8(a-h, o-z)
! This files must be included when compiling in CHAMP
include 'vmc.h'
include 'force.h'
! This common blocks are defined in CHAMP
common /config/ xold(3, MELEC), xnew(3, MELEC), vold(3, MELEC)
! Electron coordinates
dimension elec_coord(nelec, 3)
do j = 1, 3
do i = 1, nelec
elec_coord(i, j) = xold(j, i)
end do
end do
! Temporarily set some values for the testing without champ
call random_number(elec_coord)
end subroutine jast_elec_champ
subroutine jast_nuc_champ(nnuc, xnuc_coord)
! This subroutine allows for a correct interfacing between
! the Jastrow IRPF90 files and the CHAMP variables
implicit real*8(a-h, o-z)
! This files must be included when compiling in CHAMP
include 'vmc.h'
include 'force.h'
! This common blocks are defined in CHAMP
common/atom/znuc(MCTYPE), cent(3, MCENT), pecent
! Nuclear coordinates
dimension xnuc_coord(nnuc, 3)
do j = 1, 3
do i = 1, nnuc
xnuc_coord(i, j) = cent(j, i)
end do
end do
! Temporarily set some values for the testing without champ
call random_number(xnuc_coord)
end subroutine jast_nuc_champ
subroutine jast_pars_champ(naord, ntypenuc, aord_vect, nbord, bord_vect,
& ndim_cord_vect, cord_vect)
! This subroutine allows for a correct interfacing between
! the Jastrow IRPF90 files and the CHAMP variables
implicit real*8(a-h, o-z)
! This files must be included when compiling in CHAMP
include 'vmc.h'
include 'force.h'
! This common blocks are defined in CHAMP
common/jaspar3/a(MORDJ1,MWF),b(MORDJ1,2,MWF),c(83,MCTYPE,MWF)
common/jaspar4/a4(MORDJ1,MCTYPE,MWF),norda,nordb,nordc
! Jastrow parameters
dimension aord_vect(naord+1, ntypenuc)
dimension bord_vect(nbord+1)
dimension cord_vect(ndim_cord_vect, ntypenuc)
do j = 1, ntypenuc
do i = 1, naord+1
aord_vect(i, j) = a4(i, j, 1)
end do
end do
do i = 1, nbord+1
bord_vect(i) = b(i, 1, 1)
end do
do j = 1, ntypenuc
do i = 1, ndim_cord_vect
cord_vect(i, j) = c(i, j, 1)
end do
end do
! Temporarily set some values for the testing without champ
call random_number(aord_vect)
call random_number(bord_vect)
call random_number(cord_vect)
print *, aord_vect
end subroutine jast_pars_champ

BIN
jastrow_transirp.o Normal file
View File

Binary file not shown.

26
vmc.h Normal file
View File

@ -0,0 +1,26 @@
c MELEC >= number of electrons
c MORB >= number of orbitals
c MBASIS >= number of basis functions
c MDET >= number of determinants
c MCENT >= number of centers
c MCTYPE >= number of center types
c MCTYP3X=max(3,MCTYPE)
c Slater matrices are dimensioned (MELEC/2)**2 assuming
c equal numbers of up and down spins. MELEC has to be
c correspondingly larger if spin polarized calculations
c are attempted.
integer MELEC,MORB,MBASIS,MDET,MCENT,MCTYPE,MCTYP3X,
&NSPLIN,nrad,MORDJ,MORDJ1,MMAT_DIM,MMAT_DIM2
real*8 radmax,delri
character*20 method
parameter(MELEC=50,MORB=550,MBASIS=550,MDET=15000,MCENT=20,
&MCTYP3X=5,NSPLIN=1001,MORDJ=7,radmax=10.d0,nrad=3001,MCTYPE=3,
&MMAT_DIM=(MELEC*MELEC)/4,MMAT_DIM2=(MELEC*(MELEC-1))/2,
&MORDJ1=MORDJ+1,delri=(nrad-1)/radmax)
common /method_opt/ method