0
我試圖在fortran中編寫代碼來計算協調編號。但是有這些錯誤任務中不兼容的等級0和2
coord.f:43.72: read(13,*) ri(i), g(2,2,i), g(1,2,i), g(1,2,i), g(1, 1 Error: Expected array subscript at (1) coord.f:78.38: call integrate(npts-1,ri,gt,ans) 1 Warning: Rank mismatch in argument 'ans' at (1) (scalar and rank-2) coord.f:79.8: t1(ia,ib)=ans 1 Error: Incompatible ranks 0 and 2 in assignment at (1) coord.f:52.32: call coordination(ri,g,ro,num) 1 Warning: Invalid procedure argument at (1)
這是低於我已經嘗試了它的代碼。任何人都可以請 幫我解決這些錯誤？
ccccc Solution for Coordination number:
c 2 :macro-ion
c 1 :counter-ion
include "prmts" ! parameter for npts, l, pi, bl!
character init*10
integer icont(l,l)
double precision grid, dm22, dr, dt, num
double precision g(l,l,npts),
& ro(l,l),z(l),r(l),ri(npts),dm(l,l),
& h(l,l,npts),ans(l,l), t1(l,l),gt(npts)
open(unit=13,file='grm.out.txt',status='old')
open(unit=14,file='cor.out',status='unknown')
read(13,*)(z(i),i=1,l) ! algebric charge !
read(13,*)(r(i),i=1,l) ! radious of ions !
read(13,*)ro(2,2) ! no.density of 2 !
do i = 1, l
r(i) = r(i)
enddo
dm22 = dm22
dr = r(2)/grid
ro(2,2) = ro(2,2)
ro(1,1) = -z(2)*ro(2,2)/z(1)
! From condition of electro neutrality !
open(unit=13,file='grm.out.txt',status='old')
do i=1, npts-1
read(13,*) ri(i), g(2,2,i), g(1,2,i), g(1,2,i), g(1,1,i)
enddo
close(13)
CCCCC CALCULATE COORDINATION NUMBER
call coordination(ri,g,ro,num)
write(14,*)"# Cornum = ", num(ia,ib)
write(14,*)"#----------------------------------------------"
write(14,*)"# num22 num21 num12 num11 "
write(14,*)"#----------------------------------------------"
999 format(4f18.6)
stop
end ! end of main !
subroutine coordination(ri,g,ro,num)
include 'prmts' ! for l, npts, pi and bl !
double precision ri(npts), g(l,l,npts), ro(l,l)
& , num(l,l), ans(l,l), t1(l,l),gt(npts)
integer i, ia, ib
CCCCC COORDINATION NUMBER
CCCCC Cornum : Coordination number.
do ia=1,l
do ib=1,l
do i=1,npts-1
gt(i)=g(ia,ib,i)*ri(i)**2
enddo
call integrate(npts-1,ri,gt,ans)
t1(ia,ib)=ans
enddo
enddo
CCCCC COORDINATION NUMBER
do ia=1,l
do ib=1,l
num(ia,ib)= 4.0d0*pi*ro(ib,ib)*t1(ia,ib)
enddo
enddo
write(*,*) 'Cornum = ', num(ia,ib)
end
subroutine integrate(n,x,y,ans)
integer nin, nout
parameter (nin=5,nout=6)
double precision ans, error
integer ifail, n
double precision x(n), y(n)
ifail = 1
call pintegr(x,y,n,ans,error,ifail)
if (ifail.eq.0) then
write (nout,99999) 'integral = ', ans,
+ ' estimated error = ', error
else if (ifail.eq.1) then
write (nout,*) 'less than 4 points supplied'
else if (ifail.eq.2) then
write (nout,*)
+ 'points not in increasing or decreasing order'
else if (ifail.eq.3) then
write (nout,*) 'points not all distinct'
end if
return
99999 format (1x,a,e12.4,a,e12.4)
end
subroutine pintegr(x,y,n,ans,er,ifail)
double precision ans, er
integer n
double precision x(n), y(n)
double precision c, d1, d2, d3, h1, h2, h3, h4, r1, r2, r3,
* r4, s
integer i, nn
ans = 0.0d0
er = 0.0d0
if (n.ge.4) go to 20
ifail = 1
return
h2 = x(2) - x(1) 20
do 80 i = 3, n
h3 = x(i) - x(i-1)
if (h2*h3) 40, 40, 80
write(*,*)'points not specified correctly' 40
ifail = 3
return
continue 80
d3 = (y(2)-y(1))/h2
h3 = x(3) - x(2)
d1 = (y(3)-y(2))/h3
h1 = h2 + h3
d2 = (d1-d3)/h1
h4 = x(4) - x(3)
r1 = (y(4)-y(3))/h4
r2 = (r1-d1)/(h4+h3)
h1 = h1 + h4
r3 = (r2-d2)/h1
ans = h2*(y(1)+h2*(d3/2.0d0-h2*(d2/6.0d0-(h2+2.0d0*h3)*r3/12.0d0))
* )
s = -(h2**3)*(h2*(3.0d0*h2+5.0d0*h4)+10.0d0*h3*h1)/60.0d0
r4 = 0.0d0
nn = n - 1
do 120 i = 3, nn
ans = ans + h3*((y(i)+y(i-1))/2.0d0-h3*h3*(d2+r2+(h2-h4)*r3)
* /12.0d0)
c = h3**3*(2.0d0*h3*h3+5.0d0*(h3*(h4+h2)+2.0d0*h4*h2))/120.0d0
er = er + (c+s)*r4
if (i.ne.3) s = c
if (i.eq.3) s = s + 2.0d0*c
if (i-n+1) 100, 140, 100
h1 = h2 100
h2 = h3
h3 = h4
d1 = r1
d2 = r2
d3 = r3
h4 = x(i+2) - x(i+1)
r1 = (y(i+2)-y(i+1))/h4
r4 = h4 + h3
r2 = (r1-d1)/r4
r4 = r4 + h2
r3 = (r2-d2)/r4
r4 = r4 + h1
r4 = (r3-d3)/r4
continue 120
continue 140
ans = ans + h4*(y(n)-h4*(r1/2.0d0+h4*(r2/6.0d0+(2.0d0*h3+h4)
* *r3/12.0d0)))
er = er - h4**3*r4*(h4*(3.0d0*h4+5.0d0*h2)+10.0d0*h3*(h2+h3+h4))
* /60.0d0 + s*r4
ans = ans + er
ifail = 0
return
end
END of Program