40 lines
987 B
Fortran
40 lines
987 B
Fortran
SUBROUTINE pzextr(iest,xest,yest,yz,dy,nv)
|
|
INTEGER iest,nv,IMAX,NMAX
|
|
REAL xest,dy(nv),yest(nv),yz(nv)
|
|
PARAMETER (IMAX=13,NMAX=50)
|
|
INTEGER j,k1
|
|
REAL delta,f1,f2,q,d(NMAX),qcol(NMAX,IMAX),x(IMAX)
|
|
SAVE qcol,x
|
|
x(iest)=xest
|
|
do 11 j=1,nv
|
|
dy(j)=yest(j)
|
|
yz(j)=yest(j)
|
|
11 continue
|
|
if(iest.eq.1) then
|
|
do 12 j=1,nv
|
|
qcol(j,1)=yest(j)
|
|
12 continue
|
|
else
|
|
do 13 j=1,nv
|
|
d(j)=yest(j)
|
|
13 continue
|
|
do 15 k1=1,iest-1
|
|
delta=1./(x(iest-k1)-xest)
|
|
f1=xest*delta
|
|
f2=x(iest-k1)*delta
|
|
do 14 j=1,nv
|
|
q=qcol(j,k1)
|
|
qcol(j,k1)=dy(j)
|
|
delta=d(j)-q
|
|
dy(j)=f1*delta
|
|
d(j)=f2*delta
|
|
yz(j)=yz(j)+dy(j)
|
|
14 continue
|
|
15 continue
|
|
do 16 j=1,nv
|
|
qcol(j,iest)=dy(j)
|
|
16 continue
|
|
endif
|
|
return
|
|
END
|