开发者

ACCESS_VIOLATION in PGI visual fortran

I'm writing a fortran program using PGI visual fortran. The code consists of rather lengthy two modules and a main PROGRAM. Nothing seems wrong to me and the program compilation and build are successful with no warning or errors. However at the runtime or in debug mode an error occurs:

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.

After this error the execution of program stops. I tried every way that I could guess to overcome this issue. However, the problem persists. Variables seem to be defined properly. In the debug mode, all variables seem to be OK. Although the variables x, y, and z will be evaluated properly by the functions in modules, they can not be evaluated in the main PROGRAM as the following code shows (obtained by a breakpoint at line 14 of program main in the file mainser.f90):

x: Children Could not be evalauted

I can't understand the source of error or access violation. Is this a known issue which I'm not familiar with? Or is it a bug? I'll appreciate any help from you. Thank you in advance. The codes in fortran language are attached as follows. 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: matumoto@math.keio.ac.jp
! 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 开发者_StackOverflowfunction 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


I found the answer. The problem was with the premature definition of variables x, y, and z:

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

While N and m are not initialized, this variable declaration assigns a size of zero to these variables which causes access_violation. Thanks for your replies.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜