1c     Scicos
2c
3c     Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
4c
5c     This program is free software; you can redistribute it and/or modify
6c     it under the terms of the GNU General Public License as published by
7c     the Free Software Foundation; either version 2 of the License, or
8c     (at your option) any later version.
9c
10c     This program is distributed in the hope that it will be useful,
11c     but WITHOUT ANY WARRANTY; without even the implied warranty of
12c     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13c     GNU General Public License for more details.
14c
15c     You should have received a copy of the GNU General Public License
16c     along with this program; if not, write to the Free Software
17c     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18c
19c     See the file ./license.txt
20c
21
22      subroutine delayv(flag,nevprt,t,xd,x,nx,z,nz,tvec,ntvec,
23     &     rpar,nrpar,ipar,nipar,u1,nu1,u2,nu2,y,ny)
24c     Copyright INRIA
25
26c     rpar(1)=dt
27c     delayv=u(nin)
28c
29      double precision t,xd(*),x(*),z(*),tvec(*),rpar(*),y(*)
30      double precision u1(*),u2(*)
31      integer flag,nevprt,nx,nz,ntvec,nrpar,ipar(*)
32      integer nipar,nu1,nu2,ny
33
34      double precision a,dtat,u2r
35      integer i,in,j,k
36
37      j=int((nz-1)/nu1)
38      if(flag.eq.3) then
39         tvec(1)=t+rpar(1)
40         k=int(u2(1)/rpar(1))
41         if(k.gt.(j-3)) tvec(2)=t
42         if(k.lt.1) tvec(2)=t
43      endif
44c
45c     .   shift buffer
46      if(flag.eq.2) then
47         do 10 i=1,j
48            z(i)=z(i+1)
49 10      continue
50         do 30 in=1,nu1-1
51            do 35 ii=(in*j)+1,(in+1)*j
52               z(ii)=z(ii+1)
53 35         continue
54 30      continue
55         z(nz)=t
56
57         do 20 in=1,nu1
58            z(j*in)=u1(in)
59 20      continue
60      endif
61
62      if(flag.eq.1.or.flag.eq.6) then
63         dtat=t-z(nz)
64         do 08 in=1,nu1
65c     extrapolate to find values at delta.t
66            if(u2(1).le.dtat) then
67c     initialisation start
68               if(dtat.lt.rpar(1)/100.0d0) then
69                  a=u2(1)/(rpar(1)+dtat)
70c     delete negative delay
71                  if(a.le.(0.0d0)) a=0.0d0
72                  y(in)=(1-a)*z(j*in)+a*z((j*in)-1)
73               else
74                  a=u2(1)/dtat
75c     delete negative delay
76                  if(a.le.(0.0d0)) a=0.0d0
77                  y(in)=(1-a)*u1(in)+a*z(j*in)
78               endif
79            else
80               u2r=(u2(1)-dtat)
81               k=int(u2r/rpar(1))
82c     limitation of size buffer
83               if(k.gt.(j-3)) then
84                  k=j-3
85                  a=1.0d0
86               else
87                  a=(u2r-(k*rpar(1)))/rpar(1)
88               endif
89c     interpolate to find values at t-delay
90               y(in)=(1-a)*z((j*in)-k)+a*z((j*in)-k-1)
91            endif
92 08      continue
93
94      endif
95      return
96      end
97
98
99
100
101