您所在位置：主题：jstzhurj老师，我又将程序简化了，能否看下？
tianhy2010
[专家分：60] 发布于 2010-08-28 22:18:00
还是上次那代码。我想了下，由于相邻的两个特征值之间可能有好几个p，比如在eigenvalue(4)和eigenvalue(5)之间有8个p，分别是23、24、25、。。。、30，他们的conr值相同，我只要算一个就可以了，然后把这个值赋给其他的conr，比如得到了conr(23),可以把conr(23)直接赋给conr(24、25、26、...、30),这样就不用再重复计算了，我改了下程序，帮忙看下吧？呵呵
q=1
do i=1,4*m*n-1 ！每个i找满足的p,先对i循环
conduc=0.0
k=0
do p=q,450000
if((eigenvalue(i)<=Ef(p)).and.(eigenvalue(i+1)>Ef(p))) then ！如果p满足条件，就执行下面的操作，再看下满足这个条件的p有几个
q=p+1 !p+1看下还能否满足条件，如果能那就k+1,直到不能满足条件跳出if语句
k=k+1 !计算总的能满足i条件的p的个数
end if
do temp=1,i
do j=i+1,4*m*n
ea=matmul(traneigv(temp,:),hx)
ec=matmul(traneigv(temp,:),hy)
eb=matmul(traneigv(j,:),hx)
ed=matmul(traneigv(j,:),hy)
conduc=conduc+(dot_product(ea,eigenvector(:,j))*dot_product(ed,eigenvector(:,temp))
end do
end do
conr(p)=2*pi*aimag(conduc)/S
！将能满足i条件的所有conr(p)都赋值,如果k>1，那就说明不止一个能满足条件了
if(k>1) then
do ii=1,k
conr(p+ii)=conr(p)
end do
end if
q=p
exit ！退到计算下一个i的地方
end do
end do
q=1
do i=1,4*m*n-1 ！每个i找满足的p,先对i循环
conduc=0.0
k=0
do p=q,450000
if((eigenvalue(i)<=Ef(p)).and.(eigenvalue(i+1)>Ef(p))) then ！如果p满足条件，就执行下面的操作，再看下满足这个条件的p有几个
q=p+1 !p+1看下还能否满足条件，如果能那就k+1,直到不能满足条件跳出if语句
k=k+1 !计算总的能满足i条件的p的个数
end if
do temp=1,i
do j=i+1,4*m*n
ea=matmul(traneigv(temp,:),hx)
ec=matmul(traneigv(temp,:),hy)
eb=matmul(traneigv(j,:),hx)
ed=matmul(traneigv(j,:),hy)
conduc=conduc+(dot_product(ea,eigenvector(:,j))*dot_product(ed,eigenvector(:,temp))
end do
end do
conr(p)=2*pi*aimag(conduc)/S
！将能满足i条件的所有conr(p)都赋值,如果k>1，那就说明不止一个能满足条件了
if(k>1) then
do ii=1,k
conr(p+ii)=conr(p)
end do
end if
q=p
exit ！退到计算下一个i的地方
end do
end do
