回 帖 发 新 帖 刷新版面

主题:程序错误请指教

程序运行错误提示:请问如何修改


--------------------Configuration: gongetidufa - Win32 Debug--------------------
Linking...
gongetidufa.obj : error LNK2001: unresolved external symbol _A@8
Debug/gongetidufa.exe : fatal error LNK1120: 1 unresolved externals
Error executing link.exe.

gongetidufa.exe - 2 error(s), 0 warning(s)


subroutine sparse(b,n,asub,atsub,x,rsq)
parameter(nmax=500,eps=1.e-6)
dimension b(n),x(n),g(nmax),h(nmax),xi(nmax),xj(nmax)
logical done
eps2=n*eps**2
irst=0
do
done=-1
irst=irst+1
call asub(x,xi)
rp=0.0
bsq=0.0
do j=1,n
bsq=bsq+b(j)**2
xi(j)=xi(j)-b(j)
rp=rp+xi(j)**2
enddo
call atsub(xi,g)
do j=1,n
g(j)=-g(j)
h(j)=g(j)
enddo
do iter=1,10*n
call asub(h,xi)
anum=0.
aden=0.
do j=1,n
anum=anum+g(j)*h(j)
aden=aden+xi(j)**2
enddo
if(aden==0.0)pause'very singular matrix'
anum=anum/aden
do j=1,n
xi(j)=x(j)
x(j)=x(j)+anum*h(j)
enddo
call asub(x,xj)
rsq=0.
do j=1,n
xj(j)=xj(j)-b(j)
rsq=rsq+xj(j)**2
enddo
if(rsq==rp.or.rsq<=bsq*eps2)return
if(rsq>rp)then
do j=1,n+1
x(j)=xi(j)
enddo
if(irst>=3)return
done=0
endif
if(.not.done)exit
rp=rsq
call atsub(xj,xi)
gg=0.0
dgg=0.0
do j=1,n
gg=gg+g(j)**2
dgg=dgg+(xi(j)+g(j))*xi(j)
enddo
if(gg==0.)return
gam=dgg/gg
do j=1,n
g(j)=-xi(j)
h(j)=g(j)+gam*h(j)
enddo
enddo
if(.not.done)exit
enddo
pause 'too many iterations'
end subroutine sparse

program d1r9
!driver program for routine sparse
parameter(nn=100,n=(nn-1)**2,deltx=0.01,delty=0.01)
common m
dimension b(n),x(n),bcmp(n),a(n,n)!,c(nn-1,nn-1),d(nn-1,nn-1)
external asub,atsub
m=n

 !c(1,1)=2.0*(1.0/deltx**2+1.0/delty**2)
 !c(1,2)=-1.0/deltx**2
 !c(99,98)=-1.0/deltx**2
 !c(99,99)=2.0*(1.0/deltx**2+1.0/delty**2)
!do i=2,nn-2
   !do j=2,nn-2
    !c(i,j)=2.0*(1.0/deltx**2+1.0/delty**2)
    !c(i,j-1)=-1.0/deltx**2
    !c(i,j+1)=-1.0/deltx**2
    !enddo
!enddo
!do i=1,nn-1
    !d(i,i)=-1.0/delty**2
!enddo
a(1,1)=2.0*(1.0/deltx**2+1.0/delty**2)
a(1,2)=-1.0/deltx**2
a(1,100)=-1.0/delty**2
a(99,99)=2.0*(1.0/deltx**2+1.0/delty**2)
a(99,98)=-1.0/deltx**2
a(99,198)=-1.0/delty**2
a(99*99,99*99)=2.0*(1.0/deltx**2+1.0/delty**2)
a(99*99,99*99-1)=-1.0/deltx**2
a(99*99,99*99-99)=-1.0/delty**2
a(99*99-98,99*99-98)=2.0*(1.0/deltx**2+1.0/delty**2)
a(99*99-98,99*99-97)=-1.0/deltx**2
a(99*99-98,99*99-98-99)=-1.0/delty**2
do i=2,98
   a(i,i)=2.0*(1.0/deltx**2+1.0/delty**2)
   a(i,i-1)=-1.0/deltx**2
   a(i,i+1)=-1.0/deltx**2
   a(i,i+99)=-1.0/delty**2
enddo
do i=99*98+2,99*98+98
   a(i,i)=2.0*(1.0/deltx**2+1.0/delty**2)
   a(i,i-1)=-1.0/deltx**2
   a(i,i+1)=-1.0/deltx**2
   a(i,i-99)=-1.0/delty**2
enddo

do i=99+1,99*(99-1)
if(mod(i,100)/=0.and.mod(i,99)/=0) a(i,i)=2.0*(1.0/deltx**2+1.0/delty**2)
   a(i,i-1)=-1.0/deltx**2
   a(i,i+1)=-1.0/deltx**2
   a(i,i-99)=-1.0/delty**2
   a(i,i+99)=-1.0/delty**2
if(mod(i,100)==0)  a(i,i)=2.0*(1.0/deltx**2+1.0/delty**2)
   a(i,i+1)=-1.0/deltx**2
   a(i,i-99)=-1.0/delty**2
   a(i,i+99)=-1.0/delty**2
   if(mod(i,99)==0)  a(i,i)=2.0*(1.0/deltx**2+1.0/delty**2)
   a(i,i-1)=-1.0/deltx**2
   a(i,i-99)=-1.0/delty**2
   a(i,i+99)=-1.0/delty**2
enddo

do i=99*98+1,99*99
b(i)=b(i)+((i-99*98)-sin(1.0)*cos((i-99*98)*delty))/delty**2
enddo

do i=1,98
   do j=1,99
b((i-1)*99+j)=sin(i*deltx)*cos(j*delty)
enddo
enddo

do i=1,99*99
x(i)=0.0
enddo

call sparse(b,n,asub,atsub,x,rsq)
write(*,'(/1x,a,e15.6)')'sum-squared residual:',rsq
write(*,'(/1x,a)')'solution vector:'
write(*,'(/1x,5f12.6)')(x(i),i=1,n)
call asub(x,bcmp)
write(*,'(/1x,a)')'press return to end do...'
read(*,*)
write(*,'(1x,a/t8,a,t22,a)')'test of solution vector:','a*x','b'
do i=1,n
write(*,'(1x,2f12.6)') bcmp(i),b(i)
enddo
end program

subroutine asub(xin,xout)
common n
dimension xin(n),xout(n)
xout(1)=a(1,1)*xin(1)+a(1,2)*xin(2)+a(1,100)*xin(100)
xout(99*99)=a(99*99,99*99)*xin(99*99)+a(99*99,99*99-1)*xin(99*99-1)+a(99*99,99*99-99)*xin(99*99-99)
xout(99)=a(99,99)*xin(99)+a(99,98)*xin(98)+a(99,198)*xin(198)
xout(99*99-98)=a(99*99-98,99*99-98)*xin(99*99-98)+a(99*99,99*99-97)*xin(99*99-97)+a(99*99-98,99*99-98-99)*xin(99*99-98-99)
do i=2,98
xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i+1)*xin(i+1)+a(i,i+99)*xin(i+99)
enddo
do i=99*98+2,99*98+98
xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i+1)*xin(i+1)+a(i,i-99)*xin(i-99)
enddo
do i=99+1,99*(99-1)
if(mod(i,100)/=0.and.mod(i,99)/=0) xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i+1)*xin(i+1)+a(i,i-99)*xin(i-99)+a(i,i+99)*xin(i+99)
if(mod(i,100)==0) xout(i)=a(i,i)*xin(i)+a(i,i+1)*xin(i+1)+a(i,i-99)*xin(i-99)+a(i,i+99)*xin(i+99)
if(mod(i,99)==0) xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i-99)*xin(i-99)+a(i,i+99)*xin(i+99)
enddo
end subroutine asub

subroutine atsub(xin,xout)
common n
dimension xin(n),xout(n)
xout(1)=a(1,1)*xin(1)+a(1,2)*xin(2)+a(1,100)*xin(100)
xout(99*99)=a(99*99,99*99)*xin(99*99)+a(99*99,99*99-1)*xin(99*99-1)+a(99*99,99*99-99)*xin(99*99-99)
xout(99)=a(99,99)*xin(99)+a(99,98)*xin(98)+a(99,198)*xin(198)
xout(99*99-98)=a(99*99-98,99*99-98)*xin(99*99-98)+a(99*99,99*99-97)*xin(99*99-97)+a(99*99-98,99*99-98-99)*xin(99*99-98-99)
do i=2,98
xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i+1)*xin(i+1)+a(i,i+99)*xin(i+99)
enddo
do i=99*98+2,99*98+98
xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i+1)*xin(i+1)+a(i,i-99)*xin(i-99)
enddo
do i=99+1,99*(99-1)
if(mod(i,100)/=0.and.mod(i,99)/=0) xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i+1)*xin(i+1)+a(i,i-99)*xin(i-99)+a(i,i+99)*xin(i+99)
if(mod(i,100)==0) xout(i)=a(i,i)*xin(i)+a(i,i+1)*xin(i+1)+a(i,i-99)*xin(i-99)+a(i,i+99)*xin(i+99)
if(mod(i,99)==0) xout(i)=a(i,i)*xin(i)+a(i,i-1)*xin(i-1)+a(i,i-99)*xin(i-99)+a(i,i+99)*xin(i+99)
enddo
end subroutine atsub





    

回复列表 (共1个回复)

沙发

subroutine sparse(b,n,asub,atsub,x,rsq)

这个子程序调用子程序asub,atsub的结果,这种书写格式需要考证下。我想这里应该有问题。

我来回复

您尚未登录,请登录后再回复。点此登录或注册