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