Computational routine
eng

##
dlradp

### File content

          subroutine dlradp(flag,nevprt,t,xd,x,nx,z,nz,tvec,ntvec,
         &     rpar,nrpar,ipar,nipar,u,nu,y,ny)
    c     Copyright INRIA

    c     Scicos block simulator

    c     SISO, strictly proper adapted transfer function
    c
    c     u(1)    : main input
    c     u(2)    : modes adaptation input
    c
    c     m = ipar(1) : degree of numerator
    c     n = ipar(2) : degree of denominator n>m
    c     npt = ipar(3) : number of mesh points
    c     x = rpar(1:npt) : mesh points abscissae
    c     rnr = rpar(npt+1:npt+m*npt) : rnr(i,k) i=1:m  is the real part of
    c          the roots of the numerator at the kth mesh point
    c     rni = rpar(npt+m*npt+1:npt+2*m*npt) : rni(i,k) i=1:m  is the
    c          imaginary part of the roots of the numerator at the kth
    c          mesh point
    c     rdr = rpar(npt+2*m*np+1:npt+(2*m+n)*npt) : rdr(i,k) i=1:n
    c          is the real part of the roots of the denominator at the kth
    c          meshpoint
    c     rdi = rpar(npt+(2*m+n)*np+1:npt+2*(m+n)*npt) : rdi(i,k) i=1:n
    c          is the imaginary part of the roots of the denominator at
    c          the kth  meshpoint
    c     g   = rpar(npt+2*(m+n)*npt+1:npt+2*(m+n)*npt+npt) is the
    c           gain values at the mesh points.
    c!
          double precision t,xd(*),x(*),z(*),tvec(*),rpar(*),u(*),y(*)
          integer flag,nevprt,nx,nz,ntvec,nrpar,ipar(*)
          integer nipar,nu,ny

    c
          double precision yyp,ddot
          double precision yy(201),num(51),den(51),ww(51)

          m=ipar(1)
          n=ipar(2)
          if(flag.eq.2) then
    c     state
             m=ipar(1)
             n=ipar(2)
             mpn=m+n
             npt=ipar(3)
             call intp(u(2),rpar(1),rpar(1+npt),2*mpn+1,npt,yy)
             call wprxc(m,yy(1),yy(1+m),num,ww)
             call wprxc(n,yy(1+2*m),yy(1+2*m+n),den,ww)
             yyp=-ddot(n,den,1,z(m+1),1)+(ddot(m,num,1,z(1),1)+u(1))*
         $        yy(1+2*mpn)
             if(m.gt.0) then
                call unsfdcopy(m-1,z(2),-1,z(1),-1)
                z(m)=u(1)
             endif
             call unsfdcopy(n-1,z(m+2),-1,z(m+1),-1)
             z(mpn)=yyp
          elseif(flag.eq.4) then
    c     init
             m=ipar(1)
             n=ipar(2)
             if(m.gt.50.or.n.gt.50) then
                flag=-1
                return
             endif
          endif
    c     y
          y(1)=z(m+n)

          end