📄 bcucof.for
字号:
SUBROUTINE bcucof(y,y1,y2,y12,d1,d2,c)
REAL d1,d2,c(4,4),y(4),y1(4),y12(4),y2(4)
INTEGER i,j,k,l
REAL d1d2,xx,cl(16),wt(16,16),x(16)
SAVE wt
DATA wt/1,0,-3,2,4*0,-3,0,9,-6,2,0,-6,4,8*0,3,0,-9,6,-2,0,6,-4,10*
*0,9,-6,2*0,-6,4,2*0,3,-2,6*0,-9,6,2*0,6,-4,4*0,1,0,-3,2,-2,0,6,-4,
*1,0,-3,2,8*0,-1,0,3,-2,1,0,-3,2,10*0,-3,2,2*0,3,-2,6*0,3,-2,2*0,
*-6,4,2*0,3,-2,0,1,-2,1,5*0,-3,6,-3,0,2,-4,2,9*0,3,-6,3,0,-2,4,-2,
*10*0,-3,3,2*0,2,-2,2*0,-1,1,6*0,3,-3,2*0,-2,2,5*0,1,-2,1,0,-2,4,
*-2,0,1,-2,1,9*0,-1,2,-1,0,1,-2,1,10*0,1,-1,2*0,-1,1,6*0,-1,1,2*0,
*2,-2,2*0,-1,1/
d1d2=d1*d2
do 11 i=1,4
x(i)=y(i)
x(i+4)=y1(i)*d1
x(i+8)=y2(i)*d2
x(i+12)=y12(i)*d1d2
11 continue
do 13 i=1,16
xx=0.
do 12 k=1,16
xx=xx+wt(i,k)*x(k)
12 continue
cl(i)=xx
13 continue
l=0
do 15 i=1,4
do 14 j=1,4
l=l+1
c(i,j)=cl(l)
14 continue
15 continue
return
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -