- 积分
- 0
- 注册时间
- 2011-2-23
- 仿真币
-
- 最后登录
- 1970-1-1
|
subroutine ghmatec(x,y,xm,ym,g,h,fi,dfi,kode,nx)
dimension g(nx,nx),h(nx,nx)
dimension x(1),y(1),xm(1),ym(1),fi(1),kode(1),dfi(1)
common n,l,nc(5),m,ge,xnu,inp,ipr
x(n+1)=x(1)
y(n+1)=y(1)
do 10 i=1,n
xm(i)=(x(i)+x(i+1))/2
10 ym(i)=(y(i)+y(i+1))/2
if (m-1) 15,15,12
12 xm(nc(1))=(x(nc(1))+x(1))/2
ym(nc(1))=(y(nc(1))+y(1))/2
do 13 k=2,m
xm(nc(K))=(x(nc(k))+x(nc(k-1)+1))/2
13 ym(nc(K))=(y(nc(k))+y(nc(k-1)+1))/2
15 do 30 i=1,n
do 30 j=1,n
if(m-1) 16,16,17
17 if(j-nc(1))19,18,19
18 kk=1
go to 23
19 do 22 k=2,m
if (j-nc(k)) 22,21,22
21 kk=nc(k-1)+1
go to 23
22 continue
16 kk=j+1
23 if(i-j) 20,25,20
20 call extinec(xm(i),ym(i),x(j),y(j),x(kk),y(kk),h((2*i-1),(2*j-1)),
*h((2*i-1),(2*j)),h((2*i),(2*j-1)),h((2*i),(2*j)),g((2*i-1),(2*j-1)
*),g((2*i-1),(2*j)),g((2*i),(2*j)))
g((2*i),(2*j-1))=g((2*i-1),(2*j))
go to 26
25 call locinec(x(j),y(j),x(kk),y(kk),g((2*i-1),(2*j-1)),
*g((2*i-1),(2*j)),g((2*i),(2*j)))
h((2*i-1),(2*j-1))=0.5
h((2*i),(2*j))=0.5
h((2*i-1),(2*j))=0
h((2*i),(2*j-1))=0
g((2*i),(2*j-1))=g((2*i-1),(2*j))
26 continue
30 continue
nn=2*n
do 50 j=1,nn
if (kode(j))43,43,40
40 do 42 i=1,nn
ch=g(i,j)
g(i,j)=-h(i,j)
42 h(i,j)=-ch
go to 50
43 do 45 i=1,nn
45 g(i,j)=g(i,j)*ge
50 continue
do 60 i=1,nn
dfi(i)=0
do 60 j=1,nn
dfi(i)=dfi(i)+h(i,j)*fi(j)
60 continue
return
end |
|