~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/scicos/cosiord.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
ImportĀ upstreamĀ versionĀ 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      subroutine cosiord(neq,x,xptr,z,zptr,iz,izptr,told,tf,
 
2
c     Copyright INRIA
 
3
     $     tevts,evtspt,nevts,pointi,inpptr,inplnk,outptr,
 
4
     $     outlnk,lnkptr,clkptr,ordptr,nptr,
 
5
     $     ordclk,nordcl,ztyp,cord,iord,niord,oord,zord,
 
6
     $     critev,rpar,rpptr,ipar,
 
7
     $     ipptr,funptr,funtyp,rhot,ihot,outtb,jroot,w,iwa,ierr) 
 
8
C     
 
9
C     
 
10
C..   Parameters .. 
 
11
c     maximum number of clock output for one block
 
12
      integer nts
 
13
      parameter (nts=100)
 
14
C     
 
15
      integer neq(*)
 
16
C     neq must contain after #states all integer data for simblk and grblk
 
17
      double precision x(*),z(*),told,tf,tevts(*),rpar(*),outtb(*)
 
18
      double precision w(*),rhot(*)
 
19
      integer iwa(*)
 
20
C     X must contain after state values all real data for simblk and grblk
 
21
      integer xptr(*),zptr(*),iz(*),izptr(*),evtspt(nevts),nevts,pointi
 
22
      integer inpptr(*),inplnk(*),outptr(*),outlnk(*),lnkptr(*)
 
23
      integer clkptr(*),ordptr(nptr),nptr,ztyp(*)
 
24
      integer ordclk(nordcl,2),nordcl,cord(*),iord(*),oord(*),zord(*)
 
25
      integer critev(*),rpptr(*),ipar(*),ipptr(*),funptr(*),funtyp(*)
 
26
      integer ihot(*),jroot(*),ierr
 
27
c
 
28
      logical hot,stuck
 
29
      integer i,k,ierr1,iopt,istate,itask,j,jdum,jt,
 
30
     &     ksz,flag,keve,kpo,nord,nclock
 
31
      double precision t
 
32
      double precision tvec(nts)
 
33
c
 
34
 
 
35
 
 
36
      integer         nblk,nordptr,nout,ng,nrwp,niwp,ncord,
 
37
     &     noord,nzord
 
38
      common /cossiz/ nblk,nordptr,nout,ng,nrwp,niwp,ncord,
 
39
     &     noord,nzord
 
40
C     
 
41
c
 
42
      integer kfun
 
43
      common /curblk/ kfun
 
44
c     
 
45
      double precision atol,rtol,ttol,deltat
 
46
      common /costol/ atol,rtol,ttol,deltat
 
47
c
 
48
 
 
49
      ntvec=0
 
50
 
 
51
c     initialisation (propagation of constant blocks outputs)
 
52
      if(niord.eq.0) goto 10
 
53
      do 05 jj=1,niord
 
54
         kfun=iord(jj)
 
55
         nclock = iord(jj+niord)
 
56
         flag=1
 
57
         call callf(kfun,nclock,funptr,funtyp,told,x,x,xptr,z,zptr,iz,
 
58
     $        izptr,rpar,rpptr,ipar,ipptr,tvec,ntvec,inpptr,inplnk
 
59
     $        ,outptr,outlnk,lnkptr,outtb,flag) 
 
60
         if (flag .lt. 0) then
 
61
            ierr = 5 - flag
 
62
            return
 
63
         endif
 
64
 05   continue
 
65
 10   return
 
66
      end
 
67
 
 
68