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