File: i_r_i.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (48 lines) | stat: -rw-r--r-- 1,002 bytes parent folder | download | duplicates (3) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
      subroutine i_r_i
c     division a droite
      include '../stack.h'
      integer iadr,sadr
c     
      iadr(l)=l+l-1
c      sadr(l)=(l/2)+1
c     
      il2=iadr(lstk(top))
      if(istk(il2).lt.0) il2=iadr(istk(il2+1))
      m2=istk(il2+1)
      n2=istk(il2+2)
      it2=istk(il2+3)
      l2=il2+4
      mn2=m2*n2
      top=top-1
c     
      il1=iadr(lstk(top))
      if(istk(il1).lt.0) il1=iadr(istk(il1+1))
      m1=istk(il1+1)
      n1=istk(il1+2)
      it1=istk(il1+3)
      l1=il1+4
      mn1=m1*n1
      if(it1.ne.it2) then
         top=top+1
         fin=-fin
         return
      endif

      if (mn2 .ne. 1) then
         fin = -fin
         top = top+1
      else
c     .  vector / cst
         if(m2.lt.0.and.mn1.ne.1) then 
            call error(14)
            return
         endif
         call genrdiv(it1,istk(l1),1,istk(l2),0,istk(l1),1,mn1,ierr)
         if(ierr.ne.0) then
            call error(27)
            return
         endif
      endif
 999  return
      end