23 lines
590 B
Fortran
23 lines
590 B
Fortran
SUBROUTINE rstrct(uc,uf,nc)
|
|
INTEGER nc
|
|
DOUBLE PRECISION uc(nc,nc),uf(2*nc-1,2*nc-1)
|
|
INTEGER ic,if,jc,jf
|
|
do 12 jc=2,nc-1
|
|
jf=2*jc-1
|
|
do 11 ic=2,nc-1
|
|
if=2*ic-1
|
|
uc(ic,jc)=.5d0*uf(if,jf)+.125d0*(uf(if+1,jf)+uf(if-1,jf)+
|
|
*uf(if,jf+1)+uf(if,jf-1))
|
|
11 continue
|
|
12 continue
|
|
do 13 ic=1,nc
|
|
uc(ic,1)=uf(2*ic-1,1)
|
|
uc(ic,nc)=uf(2*ic-1,2*nc-1)
|
|
13 continue
|
|
do 14 jc=1,nc
|
|
uc(1,jc)=uf(1,2*jc-1)
|
|
uc(nc,jc)=uf(2*nc-1,2*jc-1)
|
|
14 continue
|
|
return
|
|
END
|