1
0
mirror of https://github.com/TREX-CoE/irpjast.git synced 2024-08-25 06:31:46 +02:00

Fixed type problem in F77 external subroutine

This commit is contained in:
Panadestein 2021-01-17 22:03:42 +01:00
parent 5b53a27800
commit ce2194c719
5 changed files with 29 additions and 33 deletions

View File

@ -1,6 +1,6 @@
IRPF90 = irpf90 #-a -d
FC = gfortran
FCFLAGS= -O2 -ffree-line-length-none -I .
FCFLAGS= -O2 -ffree-form -ffree-line-length-none -I .
NINJA = ninja
ARCHIVE= ar crs
RANLIB = ranlib

View File

@ -20,7 +20,6 @@ BEGIN_PROVIDER [ double precision, elec_coord, (nelec, 3) ]
! Electron coordinates
END_DOC
call jast_elec_champ(nelec, elec_coord)
END_PROVIDER
BEGIN_PROVIDER [ integer, nnuc ]
@ -47,7 +46,6 @@ BEGIN_PROVIDER [ double precision, nuc_coord, (nnuc, 3) ]
! Nuclei coordinates
END_DOC
call jast_nuc_champ(nnuc, nuc_coord)
END_PROVIDER
BEGIN_PROVIDER [integer, naord]
@ -74,14 +72,14 @@ BEGIN_PROVIDER [integer, ncord]
ncord = 5
END_PROVIDER
BEGIN_PROVIDER [integer, dim_cord_vect]
BEGIN_PROVIDER [integer, ndim_cord_vect]
implicit none
BEGIN_DOC
! Recomputes the length of the unique C coefficients
END_DOC
integer :: k, p, l, lmax
dim_cord_vect = 0
ndim_cord_vect = 0
do p = 2, ncord
do k = 0, p - 1
@ -91,7 +89,7 @@ BEGIN_PROVIDER [integer, dim_cord_vect]
lmax = p - k - 2
end if
do l = iand(p - k, 1), lmax, 2
dim_cord_vect = dim_cord_vect + 1
ndim_cord_vect += 1
end do
end do
end do
@ -100,13 +98,12 @@ 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)]
&BEGIN_PROVIDER [double precision, cord_vect, (ndim_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)
call jast_pars_champ(naord, typenuc, aord_vect, nbord, bord_vect, ndim_cord_vect, cord_vect)
END_PROVIDER
BEGIN_PROVIDER [ double precision, cord_vect_lkp, (0:ncord-1, 0:ncord-1, 2:ncord, typenuc) ]

View File

@ -197,7 +197,6 @@ BEGIN_PROVIDER [double precision, rescale_een_n_deriv_e, (4, nelec, nnuc, 0:ncor
do ii = 1, 4
rescale_een_n_deriv_e(ii, i, a, l) = &
kappa_l * elnuc_dist_deriv_e(ii, i, a)
!print *, "pp", ii, i, a, elnuc_dist_deriv_e(ii, i, a)
enddo
! \left(r''(x)+r'(x)^2\right)

View File

@ -13,12 +13,12 @@
do j = 1, 3
do i = 1, nelec
elec_coord(i, j) = xold(j, i)
!elec_coord(i, j) = xold(j, i)
! Temporarily set some values for testing without champ
elec_coord(i, j) = dble(i + j) * 0.1d0
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)
@ -36,19 +36,19 @@
do j = 1, 3
do i = 1, nnuc
xnuc_coord(i, j) = cent(j, i)
!xnuc_coord(i, j) = cent(j, i)
! Temporarily set some values for testing without champ
xnuc_coord(i, j) = dble(i + j) * 0.01d0
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)
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)
implicit real*4(a-h, o-z)
! This files must be included when compiling in CHAMP
include 'vmc.h'
include 'force.h'
@ -57,30 +57,30 @@
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)
double precision aord_vect(naord + 1, ntypenuc)
double precision bord_vect(nbord + 1)
double precision cord_vect(ndim_cord_vect, ntypenuc)
do j = 1, ntypenuc
do i = 1, naord+1
aord_vect(i, j) = a4(i, j, 1)
do i = 1, naord + 1
!aord_vect(i, j) = a4(i, j, 1)
! Temporarily set some values for testing without champ
aord_vect(i, j) = 1.0d0
end do
end do
do i = 1, nbord+1
bord_vect(i) = b(i, 1, 1)
do i = 1, nbord + 1
!bord_vect(i) = b(i, 1, 1)
! Temporarily set some values for testing without champ
bord_vect(i) = 0.5d0
end do
do j = 1, ntypenuc
do i = 1, ndim_cord_vect
cord_vect(i, j) = c(i, j, 1)
!cord_vect(i, j) = c(i, j, 1)
! Temporarily set some values for testing without champ
cord_vect(i, j) = 1.0d0
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

Binary file not shown.