mirror of
https://github.com/TREX-CoE/irpjast.git
synced 2024-11-03 20:54:10 +01:00
Fixed type problem in F77 external subroutine
This commit is contained in:
parent
5b53a27800
commit
ce2194c719
2
Makefile
2
Makefile
@ -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
|
||||
|
@ -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) ]
|
||||
|
@ -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)
|
||||
|
@ -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.
Loading…
Reference in New Issue
Block a user