93 lines
2.4 KiB
Fortran
93 lines
2.4 KiB
Fortran
subroutine pgset(ntemp)
|
|
c =======================
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ITERAT.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
common/grdpra/GRD(MDEPTH),pra(mdepth),pgs0(mdepth),ANTP(MDEPTH)
|
|
common/rybpgs/CS(MDEPTH),PRAD2D(MDEPTH),F1HE
|
|
dimension a(mdepth),b(mdepth),c(mdepth),v(mdepth),
|
|
* p(mdepth),pnew(mdepth),delp(mdepth)
|
|
dimension temp0(mdepth),pg0(mdepth)
|
|
C
|
|
do id=1,nd
|
|
p(id)=pgs0(id)
|
|
temp0(id)=temp(id)
|
|
end do
|
|
c
|
|
item=0
|
|
10 continue
|
|
item=item+1
|
|
c
|
|
itp=0
|
|
20 continue
|
|
itp=itp+1
|
|
c
|
|
id=1
|
|
b(id)=un
|
|
v(id)=dm(1)*sqrt(cs(id)*temp(id)*qgrav*half)/f1he-p(id)
|
|
do id=2,nd-1
|
|
dmm=un/(dm(id)-dm(id-1))
|
|
dmp=un/(dm(id+1)-dm(id))
|
|
dm0=two/(dm(id+1)-dm(id-1))
|
|
alp=dmm*dm0
|
|
gam=dmp*dm0
|
|
bet=alp+gam
|
|
QQ=PRAD2D(ID)
|
|
a(id)=p(id)*alp
|
|
c(id)=p(id)*gam
|
|
b(id)=p(id-1)*alp+p(id+1)*gam-two*p(id)*bet+qq
|
|
v(id)=-p(id-1)*p(id)*alp-p(id+1)*p(id)*gam+p(id)**2*bet-
|
|
* p(id)*qq-cs(id)*temp(id)*qgrav
|
|
end do
|
|
c
|
|
id=nd
|
|
alp=two/(dm(id)-dm(id-1))**2
|
|
a(id)=alp*p(id)
|
|
b(id)=alp*(p(id-1)-two*p(id))
|
|
v(id)=alp*p(id)*(p(id)-p(id-1))-cs(id)*temp(id)*qgrav
|
|
c
|
|
call tridag(a,b,c,v,delp,nd)
|
|
c
|
|
pdmax=0.
|
|
do id=1,nd
|
|
pnew(id)=p(id)+delp(id)
|
|
pd=(pnew(id)-p(id))/p(id)
|
|
pnew(id)=max(pnew(id),0.5*p(id))
|
|
pdmax=max(pdmax,abs(pd))
|
|
c if(ippgst.ge.2) write(6,602) iter,item,itp,id,p(id),pnew(id),pd
|
|
c 602 format('pgset',4i4,1p3e12.4)
|
|
p(id)=pnew(id)
|
|
end do
|
|
c if(ippgst.ge.1) write(6,606) iter,item,itp,pdmax
|
|
c 606 format('pgset iter,itp,pdmax:',3i4,1pe10.2)
|
|
c
|
|
if(itp.lt.30.and.pdmax.gt.1.e-4) go to 20
|
|
c
|
|
if(item.lt.ntemp) then
|
|
do id=1,nd
|
|
temp0(id)=temp(id)
|
|
pg0(id)=p(id)
|
|
temp(id)=temp(id)*1.01
|
|
end do
|
|
go to 10
|
|
end if
|
|
c
|
|
do id=1,nd
|
|
antp(id)=p(id)/bolk/temp(id)
|
|
ant0=pg0(id)/bolk/temp0(id)
|
|
temp(id)=temp0(id)
|
|
c if(ippgst.ge.2)
|
|
c * write(6,605) iter,id,pg0(id),p(id),p(id)/pg0(id)
|
|
c 605 format('new P',2i4,1p2e12.4,0p2f10.4)
|
|
end do
|
|
if(ntemp.eq.1) then
|
|
do id=1,nd
|
|
pgs0(id)=p(id)
|
|
end do
|
|
end if
|
|
c
|
|
return
|
|
end
|