PGI 视觉 Fortran 中的 ACCESS_VIOLATION

Question

我正在使用 PGI Visual Fortran 编写一个 Fortran 程序。该代码由相当冗长的两个模块和一个主程序组成。在我看来没有什么问题，程序编译和构建成功，没有警告或错误。然而，在运行时或调试模式下会发生错误：

Signalled NONCONTINUABLE_EXCEPTION at 0x77d340f2 in function
RtlUnhandledExceptionFilter.
Cannot debug target program. This exception may be due to a
missing DLL required by the target program.

出现此错误后，程序的执行将停止。我尝试了所有我能想到的方法来解决这个问题。然而，问题仍然存在。变量似乎定义正确。在调试模式下，所有变量似乎都正常。虽然变量 x、y 和 z 将由模块中的函数正确计算，但它们不能在主程序中计算，如以下代码所示（通过文件 mainser.f90 中程序 main 第 14 行的断点获得） )：

x: Children Could not be evalauted

我无法理解错误或访问冲突的根源。这是一个我不熟悉的已知问题吗？或者这是一个错误？我将不胜感激你的任何帮助。先感谢您。 附上fortran语言代码如下。 mainser.f90 :

Program mainser
Use rand
Use ChainConfModule
Implicit NONE
Integer :: i, j, N, m, Nx, Ny, Nz, Nbox, box
Double Precision :: pi, eta, D, x(N,m), y(N,m), z(N,m)
! Definition of Constants
N=8;
m=6; ! Nx*Ny*Nz*4 must be equal to N*m
Nx=2; Ny=2; Nz=3;
Nbox=125; ! 1000 chains
pi=3.141592653589793D0
eta=pi/6.0D0*0.8D0
Call ChainConfig(N,m,Nx,Ny,Nz,eta,D,x,y,z)
End Program mainser

ChainConfModule.f90 :

Module ChainConfModule

Use rand

Implicit None
Contains

!********************************************************************
Subroutine ChainConfig(N,m,Nx,Ny,Nz,eta,D,x,y,z)

    Integer,          Intent(in) :: N, m, Nx, Ny, Nz
    Double Precision, Intent(in) :: eta
    Double Precision, Intent(out):: x(N,m), y(N,m), z(N,m), D
    Integer :: i,j,k,O
    Double Precision :: max_eta, Xseg(N*m), Yseg(N*m), Zseg(N*m), Lx, Ly, Lz, D2, r2(N*m,N*m)

    ! Arranging Nm=N*m segments in a close-packed FCC stucture
    max_eta=0.7404D0
    i=FCCconf(N*m,Nx,Ny,Nz,max_eta,Xseg,Yseg,Zseg,Lx,Ly,Lz,D2,r2)
    D=D2**(1.0D0/2.0D0);
    If (i==0) Then
        x=0; y=0; z=0;
        return
    End If

    ! Generating random config of PN chains (N chains each having m segments)
    i=ChainGrowth(N,m,Xseg,Yseg,Zseg,r2,x,y,z)
    If (i==0) Then
        x=0; y=0; z=0;
        return
    End If
    ! Expand the system to desired density
    Call expand(N,m,Lx,Ly,Lz,D,eta,x,y,z)

    ! Final Check for possible overlap of molecules
    k=1;
    Do i=1 , N
        Do j=1 , m
            Xseg(k)=x(i,j); Yseg(k)=y(i,j); Zseg(k)=z(i,j);
            k=k+1;
        End Do
    End Do
    O=checkoverlapall(Xseg,Yseg,Zseg,N*m,D2,r2);
    If (O==1) Then
        x=0; y=0; z=0;
        return
    End If

End Subroutine ChainConfig
!********************************************************************

Integer Function ChainGrowth(N,m,Xseg,Yseg,Zseg,r2,x,y,z)

    Integer, intent(in) :: N, m
    Double Precision, intent(in) :: Xseg(N*m), Yseg(N*m), Zseg(N*m)
    Double Precision, intent(in) :: r2(N*m,N*m)
    Double Precision, intent(out) :: x(N,m), y(N,m), z(N,m)

    Integer :: i,j,Nm, neigh(N*m,N*m), XX(N*m,N*m), A(N*m), failed, iter, MaxIter, free(N*m), chain(N,m)
    Integer :: temp(N), iter2, count, complete, temp2(m), temp3(N*m)
    Double Precision :: minr

    ! Determine neighbor segments from their distances
    Nm=N*m;
    neigh=0;
    minr=minval( r2(2:Nm,1) );
    Do i=1 , Nm-1
        Do j=i+1 , Nm
            If (abs(r2(j,i)-minr)<1.0e-10) Then
                neigh(i,j)=1;
                neigh(j,i)=1;
            End If
        End Do
    End Do

    Do i=1,Nm
        A(i)=i
    End Do
    Do i=1,Nm
        XX(:,i)=A*neigh(:,i);
    End Do

    ! Put Random Bonds between the segments
    failed=1; iter=0;
    maxiter=500000;
    Do While (failed .AND. iter<maxiter)
        ! Select N segments randomly as heads of chains
        free=1;
        chain=0; temp=0;
        Do i=1,Nm
            j=0;
            Do While (j==0 .OR. any(temp==j))
                j=ceiling(grnd()*Nm);
            End Do
            temp(i)=j;
        End Do
        chain(:,1)=temp;
        free(temp)=0;

        ! Select the sequence of next segments for all chains (independent growth of chains)
        i=1; iter2=0; complete=0; count=0; A=0;
        Do While (.NOT. complete .AND. iter2<100 )
            j=chain(i,1)
            temp3=free;
            Call buildchain(j,N,m,XX,temp3,temp2)
            chain(i,:)=temp2
            If ( all(temp2 .NE. 0) .AND. different(A,temp2) ) Then
                A(count+1:count+m)=chain(i,:)
                count=count+m
                free(chain(i,:))=0;
                i=i+1;
                If (i==N+1) Then
                    complete=1;
                End If
            Else
                ! Destroy the previous chain
                If (i==1) Then
                    exit
                Else
                    i=i-1;
                    free(chain(i,2:m))=1;
                    A(count-1:count-m)=0
                    count=count-m
                    iter2=iter2+1;
                End If
            End If
        End Do
        If (all(A .NE. 0)) Then
            failed=0;
        End If
        iter=iter+1;
    End Do ! while failed

    ! Construct x, y, z matrices
    If (failed==0) Then
        ChainGrowth=1;
        Do i=1,N
            Do j=1,m
                x(i,j)=Xseg(chain(i,j));
                y(i,j)=Yseg(chain(i,j));
                z(i,j)=Zseg(chain(i,j));
            End Do
        End Do
    Else
        x=0; y=0; z=0;
        ChainGrowth=0
    End If

End Function ChainGrowth
!********************************************************************

Subroutine buildchain(i0,N,m,X,free,chain)

Integer, intent(in) :: i0, N, m, X(:,:)
Integer, intent(inout) :: free(:)
Integer, intent(out) :: chain(m)
Integer :: i, j, k, count, temp, c, alone

i=i0;
chain(1)=i0;
Do j=2,m
    count=0;
    alone=1;
    Do c=1, N*m
        temp=X(c,i)*free(c)
        If (temp .NE. 0) Then
            count=count+1;
            If (free(temp)==1) Then
                alone=0
            End If
        End If
    End Do
    If (alone==1) Then
        chain(j:m)=0;
        return
    Else
        k=ceiling(count*grnd())
        count=0
        Do c=1, N*m
            temp=X(c,i)*free(c)
            If (temp .NE. 0) Then
                count=count+1;
                If (count==k) Then
                    chain(j)=temp
                    i=temp
                    free(temp)=0
                End If
            End If
        End Do
    End If
End Do

End Subroutine buildchain

!********************************************************************
Integer function different(a,b)

Integer, intent(in) :: a(:),b(:)
Integer :: m,n,i,j

different=1;
m=size(a);
n=size(b);
Do i=1,m
    Do j=1,n
        If (a(i)==b(j)) Then
            different=0;
            return;
        End If
    End Do
End Do

End Function different
!********************************************************************

Integer Function FCCconf(N,Nx,Ny,Nz,eta,x,y,z,Lx,Ly,Lz,D2,r2)
    Integer,          Intent(in) :: N, Nx, Ny, Nz
    Double Precision, Intent(in) :: eta
    Double Precision, Intent(out):: x(N), y(N), z(N), Lx, Ly, Lz, D2, r2(N,N)
    Integer :: i, cx, cy, cz, O
    Double Precision :: pi, max_eta, a, V, D3, D

    FCCconf=1
    ! Check the packing fraction to be under the maximum allowed
    pi=3.141592653589793D0
    max_eta=sqrt(2.0D0)*pi/6.0D0
    If (eta>max_eta) Then
        FCCconf=0
        return;
    End If
    ! Calculation of No. of unit cells in the box
    If (N .NE. Nx*Ny*Nz*4) Then
        FCCconf=0
        return;
    End If

    ! Filling the box with spheres in the FCC arrangement
    a=1.0D0/DBLE(min(Nx, Ny, Nz)); ! length of a side of one cell
    Lx=a*DBLE(Nx); Ly=a*DBLE(Ny); Lz=a*DBLE(Nz); 
    V=DBLE(Nx*Ny*Nz)*a**3.0D0;
    D3=6.0D0*eta*V/(pi*DBLE(N));
    D2=D3**(2.0D0/3.0D0);
    D=D2**(1.0D0/2.0D0)

    i=1;
    Do cz=0 , Nz-1
        Do cy=0 , Ny-1
            Do cx=0 , Nx-1
                x(i)=cx*a+0;     y(i)=cy*a+0;      z(i)=cz*a+0;
                x(i+1)=cx*a+a/2; y(i+1)=cy*a+0;    z(i+1)=cz*a+a/2;
                x(i+2)=cx*a+0;   y(i+2)=cy*a+a/2;  z(i+2)=cz*a+a/2;
                x(i+3)=cx*a+a/2; y(i+3)=cy*a+a/2;  z(i+3)=cz*a+0;
                i=i+4;
            End Do
        End Do
    End Do
    x=x+D/2.0D0; y=y+D/2.0D0; z=z+D/2.0D0

    O=checkoverlapall(x,y,z,N,D2,r2);
    If (O==1) Then
        FCCconf=0
        return;
    End If

End Function FCCconf
!********************************************************************

Integer Function checkoverlapall(x,y,z,N,D2,r2)
! Check the overlap of all spheres in the box

Integer, intent(in) :: N
Double Precision, intent(in) :: D2, x(N), y(N), z(N)
Double Precision, intent(out) :: r2(N,N)
integer :: i, j
Double Precision :: dx, dy, dz

checkoverlapall=0;
! Check overlap of the generated configuration
Do i=1 , N-1
    Do j=i+1 , N
        dx=x(i)-x(j);
        dy=y(i)-y(j);
        dz=z(i)-z(j);
        ! NO minimum image convention
        r2(j,i)=dx**2.0D0+dy**2.0D0+dz**2.0D0;
        If (r2(j,i)-D2 < -1e-10) Then
            checkoverlapall=1;
        End If
    End Do
End Do

End Function checkoverlapall
!********************************************************************

Subroutine expand(N,m,Lx,Ly,Lz,D,eta,x,y,z)
! Expand the close-packed structure to the desired density using a MC algorithm

Integer, intent(in) :: N,m
Double Precision, intent(in) :: D, eta
Double Precision, intent(inout) :: Lx,Ly,Lz, x(N,m),y(N,m),z(N,m)
Integer :: i, acc, accpt, cycl, Nc
Double Precision :: r, d_max, X_CM(N), Y_CM(N), Z_CM(N), X_CM_new, Y_CM_new, Z_CM_new

r=(0.74D0/eta)**(1.0D0/3.0D0);
Lx=r*Lx;
Ly=r*Ly;
Lz=r*Lz;

! Calculate center of mass of molecules
Do i=1,N
    X_CM(i)=sum(x(i,:))/DBLE(m);
    Y_CM(i)=sum(y(i,:))/DBLE(m);
    Z_CM(i)=sum(z(i,:))/DBLE(m);
End Do

! MC algorithm for moving chains
Nc=1e6; ! No. of cycles
d_max=dble(D)/10.0D0;
Do cycl=1,Nc
    accpt=0;
    Do i=1,N
        X_CM_new=X_CM(i)+(2*grnd()-1)*d_max;
        Y_CM_new=Y_CM(i)+(2*grnd()-1)*d_max;
        Z_CM_new=Z_CM(i)+(2*grnd()-1)*d_max;

        acc=checkoverlapchain(N,m,i,X_CM_new,Y_CM_new,Z_CM_new,X_CM,Y_CM,Z_CM,x,y,z,D**2.0D0,Lx,Ly,Lz)
        If (acc==1) Then
            accpt=accpt+1;
        End If
    End Do

    If (accpt/DBLE(N) < 0.5 ) Then
        d_max=d_max*0.95;
    Else
        d_max=d_max*1.05;
    End If
End Do

End Subroutine expand
!********************************************************************

Integer Function checkoverlapchain(N,m,index,X_CM_new,Y_CM_new,Z_CM_new,X_CM,Y_CM,Z_CM,x,y,z,D2,Lx,Ly,Lz)
! chain index moved with new CM coordinates

Integer, intent(in) :: N,m,index
Double Precision, intent(in) :: Lx, Ly, Lz, D2, X_CM_new, Y_CM_new, Z_CM_new
Double Precision, intent(inout) :: X_CM(N),Y_CM(N),Z_CM(N),x(N,m),y(N,m),z(N,m)
Integer :: i, j, k, O
Double Precision :: x_new(m),y_new(m),z_new(m), Xseg(N*m), Yseg(N*m), Zseg(N*m), r2(N*m,N*m), D

! Calculate new coordinates of chain segments
Do j=1,m
    x_new(j)=x(index,j)-X_CM(index)+X_CM_new;
    y_new(j)=y(index,j)-Y_CM(index)+Y_CM_new;
    z_new(j)=z(index,j)-Z_CM(index)+Z_CM_new;
End Do
If ( any(x_new>Lx-D/2.0D0) .OR. any(x_new<D/2.0D0) .OR. any(y_new>Ly-D/2.0D0) .OR. any(y_new<D/2.0D0) &
     .OR. any(z_new>Lz-D/2.0D0) .OR. any(z_new<D/2.0D0) ) Then
    ! Reject move
    checkoverlapchain=0;
    return
End If

k=1;
Do i=1 , N
    If (i==index) Then
        Do j=1 , m
            Xseg(k)=x_new(j); Yseg(k)=y_new(j); Zseg(k)=z_new(j);
            k=k+1;
        End Do
    Else
        Do j=1 , m
            Xseg(k)=x(i,j); Yseg(k)=y(i,j); Zseg(k)=z(i,j);
            k=k+1;
        End Do
    End If
End Do

O=checkoverlapall(Xseg,Yseg,Zseg,N*m,D2,r2);
If (O==1) Then
    ! Reject move
    checkoverlapchain=0;
Else
    ! Accept move
    checkoverlapchain=1;
    X_CM(index)=X_CM_new; Y_CM(index)=Y_CM_new; Z_CM(index)=Z_CM_new;
    x(index,:)=x_new; y(index,:)=y_new; z(index,:)=z_new;
End If

End Function checkoverlapchain
!********************************************************************

End Module ChainConfModule

rand.f90 :

! A C-program for MT19937: Real number version
!   genrand() generates one pseudorandom real number (double)
! which is uniformly distributed on [0,1]-interval, for each
! call. sgenrand(seed) set initial values to the working area
! of 624 words. Before genrand(), sgenrand(seed) must be
! called once. (seed is any 32-bit integer except for 0).
! Integer generator is obtained by modifying two lines.
!   Coded by Takuji Nishimura, considering the suggestions by
! Topher Cooper and Marc Rieffel in July-Aug. 1997.
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Library General Public
! License as published by the Free Software Foundation; either
! version 2 of the License, or (at your option) any later
! version.
! This library is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
! See the GNU Library General Public License for more details.
! You should have received a copy of the GNU Library General
! Public License along with this library; if not, write to the
! Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
! 02111-1307  USA
!
! Copyright (C) 1997 Makoto Matsumoto and Takuji Nishimura.
! When you use this, send an email to: [email protected]
! with an appropriate reference to your work.
!
!***********************************************************************
! Fortran translation by Hiroshi Takano.  Jan. 13, 1999.
!
!   genrand()      -> double precision function grnd()
!   sgenrand(seed) -> subroutine sgrnd(seed)
!                     integer seed
!
! This program uses the following non-standard intrinsics.
!   ishft(i,n): If n>0, shifts bits in i by n positions to left.
!               If n<0, shifts bits in i by n positions to right.
!   iand (i,j): Performs logical AND on corresponding bits of i and j.
!   ior  (i,j): Performs inclusive OR on corresponding bits of i and j.
!   ieor (i,j): Performs exclusive OR on corresponding bits of i and j.
!
!***********************************************************************

 module rand

 contains

    subroutine sgrnd(seed)

        implicit integer(a-z)
        parameter(N     =  624)
        dimension mt(0:N-1)
        ! the array for the state vector
        common /block/mti,mt
        save   /block/

        !      setting initial seeds to mt[N] using
        !      the generator Line 25 of Table 1 in
        !      [KNUTH 1981, The Art of Computer Programming
        !         Vol. 2 (2nd Ed.), pp102]
        mt(0)= iand(seed,-1)
        do 1000 mti=1,N-1
            mt(mti) = iand(69069 * mt(mti-1),-1)
        1000 continue
        return

    end subroutine sgrnd
!***********************************************************************
    double precision function grnd()

        implicit integer(a-z)
        parameter(N     =  624)
        parameter(N1    =  N+1)
        parameter(M     =  397)
        parameter(MATA  = -1727483681)
        ! constant vector a
        parameter(UMASK = -2147483648)
        ! most significant w-r bits
        parameter(LMASK =  2147483647)
        ! least significant r bits
        ! Tempering parameters
        parameter(TMASKB= -1658038656)
        parameter(TMASKC= -272236544)

        dimension mt(0:N-1)
        ! the array for the state vector
        common /block/mti,mt
        save   /block/
        data   mti/N1/
        ! mti==N+1 means mt[N] is not initialized
        dimension mag01(0:1)
        data mag01/0, MATA/
        save mag01
        ! mag01(x) = x * MATA for x=0,1
        TSHFTU(y)=ishft(y,-11)
        TSHFTS(y)=ishft(y,7)
        TSHFTT(y)=ishft(y,15)
        TSHFTL(y)=ishft(y,-18)
        if(mti.ge.N) then
            ! generate N words at one time
            if(mti.eq.N+1) then
                ! if sgrnd() has not been called,
                call sgrnd(4357)
                ! a default initial seed is used
            endif

            do 1000 kk=0,N-M-1
                y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK))
                mt(kk)=ieor(ieor(mt(kk+M),ishft(y,-1)),mag01(iand(y,1)))
            1000   continue

            do 1100 kk=N-M,N-2
                y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK))
                mt(kk)=ieor(ieor(mt(kk+(M-N)),ishft(y,-1)),mag01(iand(y,1)))
            1100   continue

            y=ior(iand(mt(N-1),UMASK),iand(mt(0),LMASK))
            mt(N-1)=ieor(ieor(mt(M-1),ishft(y,-1)),mag01(iand(y,1)))
            mti = 0
        endif

        y=mt(mti)
        mti=mti+1
        y=ieor(y,TSHFTU(y))
        y=ieor(y,iand(TSHFTS(y),TMASKB))
        y=ieor(y,iand(TSHFTT(y),TMASKC))
        y=ieor(y,TSHFTL(y))

        if(y.lt.0) then
            grnd=(dble(y)+2.0d0**32)/(2.0d0**32-1.0d0)
        else
            grnd=dble(y)/(2.0d0**32-1.0d0)
        endif

        return

    end function grnd

end module rand

Answer 1

我找到了答案。
问题在于变量 x、y 和 z 的过早定义：

Double Precision :: pi, eta, D, x(N,m), y(N,m), z(N,m)

虽然 N 和 m 未初始化，但此变量声明为这些变量分配了零大小，这会导致 access_violation。
感谢您的回复。