我将我在化学教室中使用的程序从Matlab（非常宽容）移植到Fortran（错误，而不是那么多）。我看到的问题是，如果我在1个子程序中包含print语句，我的代码会返回与我不相同的值（包含print语句的那些正确）。
读取堆栈溢出后，我删除了print语句，使用gfortran和fcheck='bounds'重新编译，我的程序返回了正确的结果，编译时没有错误。
子程序存储在模块Basis_Subs中，并从主程序调用，我已在下面发布。该问题出现在4维矩阵Gabcd(nb,nb,nb,nb)中，该矩阵是使用Build_Electron_Repulsion中的子例程Basis_Subs module构造的。该子例程计算Gabcd的矩阵元素，并使用1个内部辅助函数Rntuv和1个内部子例程Gprod_1D，这两个函数也存储在Basis_Subs模块中
这些函数/例程在程序的另一部分中使用，程序的该部分不会显示任何错误或有趣的数组行为。这导致我认为问题必须在Build_Electron_Repulsion，我如何调用Build_Electron_Repulsion或我如何从Build_Electron_Repulsion内调用辅助函数。< / p>
我发布了主程序，以及Build_Electron_Repulsion，gprod_1D和函数Rntuv的子程序。我真正想知道的是，如果您有关于追踪错误可能的位置的任何提示。
我正在使用pico样式编辑器和gfortran。
主程序，Z.f08
program HF
use typedefs
use Basis_Subs
use SCF_Mod
implicit none
real(dp) :: output, start, finish
integer (kind=4) :: IFLAG , i, N, nb,j,k,l,natom
integer, allocatable, dimension(:) :: Z
real(dp), allocatable, dimension(:,:) :: AL, S,T, VAB, H0
real(dp), allocatable, dimension(:,:,:,:) :: Gabcd
real(dp), dimension(maxl) :: Ex=0
real(dp) :: Energy, Nuc
type(primitive) :: g1, Build_Primitive
type(Basis) :: b1
type(Basis), dimension(100) :: bases
character(LEN=20) :: fname
print *, 'Input the filename'
read (*,*), fname
open(unit=12, file=fname)
read(12,*) natom
allocate(Z(natom))
allocate(AL(natom,3))
read(12,*) Z
do i=1, natom
read(12,*) AL(i,1), AL(i,2), AL(i,3)
end do
print *, 'Atomic Coorinates = ', AL
print *, 'Z in the main routine = ', Z
call cpu_time(start)
%Calculate the energies that don't depend on electrons
call Nuclear_Repulsion(natom, Z, AL, Nuc)
N=Sum(Z)
%Build the atom specific basis set
call Build_Bases(Z, AL, nb, bases)
%Using nb, from Build_Basis, allocate matrices
allocate(S(nb,nb))
allocate(T(nb,nb))
allocate(VAB(nb,nb))
allocate(Gabcd(nb,nb,nb,nb))
call Build_Overlap(bases, nb, S)
call Build_Kinetic(bases, nb, T)
call Build_Nuclear_Attraction(Z, AL, bases, nb, VAB)
H0 = T+VAB
call Build_Electron_Repulsion(bases, nb, Gabcd)
call cpu_time(finish)
print *, 'Total time for Matrix Elements= ', finish - start
call SCF(N, nb, H0, S, Gabcd, Nuc, Energy)
end program HF
Build_Electron_Repulsion位于模块Basis_Subs：
内 subroutine Build_Electron_Repulsion(bases, nbases, Gabcd)
!!Calculate the 4 centered electron repulsion integrals. Loop over array of !!basis sets 1:nb 4 times. Each element of basis set is a defined type that !!includes and array of gaussian functions and contraction coefficients !!basis(a)%g(1:nga) and basis(a)%c(1:nga). For each gaussian in each basis set,
!!Calculate int(int(basis(a1)*basis(b1)*basis(c2)*basis(d2)*1/r12 dr1)dr2).
!!Uses helper function Rntuv listed below
implicit none
type(basis), dimension(100), intent(in) :: bases
integer, intent(in) :: nbases
real(dp), dimension(nbases, nbases,nbases,nbases), intent(out) :: Gabcd
integer :: a, b,c,d, nga, ngb, ngc, ngd, index, lx, ly, lz, llx, lly,llz
integer :: llxmax, llymax, llzmax, lxmax, lymax, lzmax, xmax, ymax, zmax
integer :: x, y, z
real(dp) :: p, q, midpoint, PX, PY, PZ, output
real(dp) :: pp, qq, midpoint2, PPX, PPY, PPZ, tmp
real(dp) :: alpha_a, alpha_b, alpha_c, alpha_d, alpha
real(dp) :: ax, ay, az, bx, by, bz, cx,cy,cz, dx,dy,dz
real(dp), dimension(maxl) ::EabX, EabY, EabZ, EcdX, EcdY, EcdZ
real(dp), dimension(2*maxl, 2*maxl, 2*maxl) :: R
R=0
Gabcd=0.0D0
print *, 'Calculating 4 centered integrals'
do a=1, nbases
do b=1, nbases
do c=1, nbases
do d=1, nbases
do nga = 1, bases(a)%n
do ngb = 1, bases(b)%n
alpha_a=bases(a)%g(nga)%alpha
alpha_b=bases(b)%g(ngb)%alpha
p=alpha_a + alpha_b
ax=bases(a)%g(nga)%x
ay=bases(a)%g(nga)%y
az=bases(a)%g(nga)%z
bx=bases(b)%g(ngb)%x
by=bases(b)%g(ngb)%y
bz=bases(b)%g(ngb)%z
PX=(alpha_a*ax + alpha_b*bx)/p
PY=(alpha_a*ay + alpha_b*by)/p
PZ=(alpha_a*az + alpha_b*bz)/p
call gprod_1D(ax, alpha_a, bases(a)%g(nga)%lx, bx, alpha_b, bases(b)%g(ngb)%lx, EabX)
call gprod_1D(ay, alpha_a, bases(a)%g(nga)%ly, by, alpha_b, bases(b)%g(ngb)%ly, EabY)
call gprod_1D(az, alpha_a, bases(a)%g(nga)%lz, bz, alpha_b, bases(b)%g(ngb)%lz, EabZ)
lxmax=bases(a)%g(nga)%lx + bases(b)%g(ngb)%lx
lymax=bases(a)%g(nga)%ly + bases(b)%g(ngb)%ly
lzmax=bases(a)%g(nga)%lz + bases(b)%g(ngb)%lz
do ngc= 1, bases(c)%n
do ngd = 1, bases(d)%n
alpha_c=bases(c)%g(ngc)%alpha
alpha_d=bases(d)%g(ngd)%alpha
pp=alpha_c + alpha_d
cx=bases(c)%g(ngc)%x
cy=bases(c)%g(ngc)%y
cz=bases(c)%g(ngc)%z
dx=bases(d)%g(ngd)%x
dx=bases(d)%g(ngd)%y
dz=bases(d)%g(ngd)%z
PPX=(alpha_c*cx + alpha_d*dx)/pp
PPY=(alpha_c*cy + alpha_d*dy)/pp
PPZ=(alpha_c*cz + alpha_d*dz)/pp
llxmax=bases(c)%g(ngc)%lx + bases(d)%g(ngd)%lx
llymax=bases(c)%g(ngc)%ly + bases(d)%g(ngd)%ly
llzmax=bases(c)%g(ngc)%lz + bases(d)%g(ngd)%lz
call gprod_1D(cx, alpha_c, bases(c)%g(ngc)%lx, dx, alpha_d, bases(d)%g(ngd)%lx, EcdX)
call gprod_1D(cy, alpha_c, bases(c)%g(ngc)%ly, dy, alpha_d, bases(d)%g(ngd)%ly, EcdY)
call gprod_1D(cz, alpha_c, bases(c)%g(ngc)%lz, dz, alpha_d, bases(d)%g(ngd)%lz, EcdZ)
alpha=p*pp/(p+pp)
tmp=0
xmax= lxmax + llxmax
ymax = lymax + llymax
zmax = lzmax + llzmax
do x = 0, xmax
do y =0, ymax
do z=0, zmax
R(x+1,y+1,z+1)=Rntuv(0,x,y,z,alpha, PX, PY, PZ, PPX, PPY, PPZ)
end do
end do
end do
!if (a ==1 .and. b==1 .and. c ==1 .and. d==1) then
! print *,' R = ', R(1,1,1)
!print *, xmax, ymax, zmax
!print *,a,b,c,d,nga,ngb,ngc,ngd, 'R = ', R(1,1,1)
!end if
! if (PZ ==PPZ) then
! ! print *, R(1,1,1)
! output = Rntuv(0,0,0,0,alpha, PX, PY, PZ, PPX, PPY, PPZ)
! print *, output
! print *, a,b,c,d , PY, PPY
!
! end if
do lx = 0, lxmax
do ly = 0, lymax
do lz = 0, lzmax
do llx= 0, llxmax
do lly= 0, llymax
do llz= 0, llzmax
tmp = tmp + EabX(lx+1)*EabY(ly+1)*EabZ(lz+1)*(-1.0D0)**(llx + lly + llz) * &
EcdX(llx+1)*EcdY(lly+1)*EcdZ(llz+1)*R(lx+ llx+1, ly+lly+1, lz+llz+1)
end do
end do
end do
end do
end do
end do
Gabcd(a,b,c,d) = Gabcd(a,b,c,d) + 2.0D0*pi**2.5D0/(p*pp*sqrt(p + pp))*tmp*bases(a)%g(nga)%N &
* bases(b)%g(ngb)%N * bases(c)%g(ngc)%N * bases(d)%g(ngd)%N * bases(a)%c(nga) &
* bases(b)%c(ngb) * bases(c)%c(ngc) * bases(d)%c(ngd)
end do
end do
end do
end do
end do
end do
end do
end do
end subroutine Build_Electron_Repulsion
real(dp) function Rntuv(n, tmax, umax, vmax, p, Px, Py, Pz, Ax, Ay, Az) result(out)
!Rntuv(n, t,u,v,p,P,A)Determine the helper integral Rntuv for the coulomb
!integral of order n, the t,u,v th Hermite polynomial with exponent p
!centered at [Px Py Pz] and charge centered at location [Ax Ay Az];
implicit none
integer, intent(in) :: n, tmax, umax, vmax
real(dp), intent(in) :: Px, Py, Pz, Ax, Ay, Az, p
real(dp) :: PA2, output
real(dp), dimension(n+tmax+umax+vmax+2, tmax+1, umax+1, vmax+1) :: R
integer :: nmax, t, u, v
integer :: i, IFLAG
R=0
nmax = n+ tmax + umax + vmax + 2
PA2 = (Px-Ax)**2.0D0 + (Py-Ay)**2.0D0 + (Pz-Az)**2.0D0
do i = 0, nmax-1
output=Boys(i, p*PA2)
R(i+1,1,1,1)= (-2*p)**(1.0D0*i)*Boys(i, p*PA2)
end do
do t=1, tmax
if (t==1) then
do i=1,nmax-1
R(i,2,1,1)=(Px - Ax)*R(i+1,1,1,1)
end do
else
do i=1,nmax-1
R(i,t+1,1,1)=(t-1)*R(i+1,t-1,1,1)+ (Px-Ax)*R(i+1,t,1,1)
end do
end if
end do
do u = 1,umax
if (u==1) then
do i = 1,nmax-1
R(i,tmax+1,2,1)=(Py-Ay)*R(i+1,tmax+1,1,1)
end do
else
do i = 1,nmax-1
R(i,tmax+1,u+1,1)=(u-1)*R(i+1,tmax+1,u-1,1) + (Py-Ay)*R(i+1,tmax+1,u,1)
end do
end if
end do
do v=1,vmax
if (v==1) then
do i = 1, nmax-1
R(i,tmax+1,umax+1,2)=(Pz-Az)*R(i+1,tmax+1,umax+1,1)
end do
else
do i = 1, nmax-1
R(i,tmax+1,umax+1,v+1)=(v-1)*R(i+1,tmax+1,umax+1,v-1) + (Pz-Az)*R(i+1,tmax+1,umax+1,v)
end do
end if
end do
out = R(n+1,tmax+1,umax+1,vmax+1)
end function Rntuv
subroutine gprod_1D(x1, alpha1, lx1, x2, alpha2, lx2, Ex)
real(dp), intent(in) :: x1, alpha1, x2, alpha2
integer, intent(in) :: lx1, lx2
integer :: tmax, i, j ,t, qint
real(dp) :: p, q, midpoint, weighted_middle, KAB
real(dp), dimension(maxl), intent(inout) :: Ex
real(dp), dimension(maxl, maxl, 2*maxl) ::coefficients
coefficients=0.0D0
tmax=lx1 + lx2
Ex=0
p=alpha1 + alpha2
q=alpha1*alpha2/p
midpoint = x1 - x2
weighted_middle=(alpha1*x1 + alpha2*x2)/p
KAB= e**(-q*midpoint**2.0D0)
coefficients(1,1,1) = KAB
i=0
j=0
do while (i < lx1)
do t= 0, i+j+1
if (t==0) then
coefficients(i+2,j+1,t+1)=(weighted_middle - x1)*coefficients(i+1,j+1,t+1) + (t+1)*coefficients(i+1,j+1,t+2)
else
coefficients(i+2,j+1,t+1)=1/(2*p)*coefficients(i+1,j+1,t) + (weighted_middle-x1)*coefficients(i+1,j+1,t+1) + &
(t+1)*coefficients(i+1,j+1,t+2)
end if
end do
i=i+1
end do
do while (j < lx2)
do t=0, i+j+1
if (t==0) then
coefficients(i+1,j+2,t+1) = (weighted_middle - x2)*coefficients(i+1,j+1,t+1) + (dble(t)+1.0d0)*coefficients(i+1,j+1,t+2)
else
coefficients(i+1,j+2,t+1)=1/(2*p)*coefficients(i+1,j+1,t) + (weighted_middle - x2)*coefficients(i+1,j+1,t+1) + &
(t+1)*coefficients(i+1,j+1,t+2)
end if
end do
j=j+1
end do
do qint=1, i+j+1
Ex(qint) = coefficients(i+1,j+1,qint)
end do
end subroutine gprod_1D