Access_violation in PGI Visual Fortran
https://stackoverflow.com/questions/6087152
-
09-09-2020 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianDomanda
Sto scrivendo un programma Fortran utilizzando PGI Visual Fortran. Il codice è costituito da due moduli piuttosto lunghi e un programma principale. Niente sembra sbagliato per me e la compilazione del programma e la costruzione hanno successo senza avviso o errori. Tuttavia al runtime o in modalità debug si verifica un errore:
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.
Dopo questo errore l'esecuzione del programma si arresta. Ho provato in ogni modo che potevo indovinare a superare questo problema. Tuttavia, il problema persiste. Le variabili sembrano essere definite correttamente. Nella modalità di debug, tutte le variabili sembrano essere ok. Sebbene le variabili X, Y, e Z saranno valutate correttamente dalle funzioni nei moduli, non possono essere valutati nel programma principale poiché il seguente codice mostra (ottenuto da un punto di interruzione alla linea 14 del programma principale nel file mainser.f90 ):
x: Children Could not be evalauted
Non riesco a capire la fonte di errore o violazione di accesso. È un problema noto con cui non ho familiarità? o è un bug? Apprezzerò qualsiasi aiuto da parte tua. Grazie in anticipo. I codici in lingua Fortran sono allegati come segue. 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 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
Soluzione
Ho trovato la risposta. Il problema era con la definizione prematura delle variabili x, y e z:
Double Precision :: pi, eta, D, x(N,m), y(N,m), z(N,m)
Mentre N e M non sono inizializzati, questa dichiarazione variabile assegna una dimensione di zero a queste variabili che causa access_violation. Grazie per le tue risposte.
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
