← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/system2/expsum.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:
routines/system2/expsum.f
 
1
      subroutine expsum(isg,chaine,n,iptr,np,maxnp,ierr)
 
2
c!but
 
3
c     Etant donnee une expression cette subroutine la decompose
 
4
c     en  somme et differences de sous-expressions et en change
 
5
c     eventuellement le signe
 
6
c!liste d'appel
 
7
c     subroutine expsum(isg,chaine,n,iptr,np,maxnp,ierr)
 
8
c     integer isg,chaine(*),n,iptr(*),np,maxnp,ierr
 
9
c
 
10
c     isg : flag de changement de signe de l'expression
 
11
c           isg>0 pas de changement de signe
 
12
c           isg<0 changement de signe
 
13
c     chaine:vecteur d'entiers contenant les codes  des
 
14
c            caracteres de l'expression.
 
15
c            en retour chaine contient les codes de l'expression
 
16
c            la longueur peut etre modifiee (voir augmentee de 1)
 
17
c     n: longueur de "chaine"
 
18
c     iptr : vecteur des pointeurs sur le debut de chaque sous
 
19
c            expressions (signe initial compris) dans chaine.
 
20
c     np : nombre de sous expressions
 
21
c     maxnp : taille maxi de iptr (limite du nombre de sous
 
22
c             expressions
 
23
c     ierr : retour d'erreur si np>maxnp (ierr=1)
 
24
c!origine
 
25
c     S Steer INRIA 1990
 
26
c!
 
27
c     Copyright INRIA
 
28
      integer chaine(*),iptr(*)
 
29
c     
 
30
      integer plus,minus,sign,lparen,rparen
 
31
      data plus/45/,minus/46/,lparen/41/,rparen/42/
 
32
c     
 
33
      ierr=0
 
34
c     on elimine des parentheses superflues   
 
35
      sign=isg
 
36
      l1=1
 
37
 01   n0=n
 
38
      if(chaine(l1).eq.plus.or.chaine(l1).eq.minus) l1=l1+1
 
39
      if(chaine(l1).eq.lparen) then
 
40
         l1=l1+1
 
41
         icount=1
 
42
 03      l1=l1+1
 
43
         if(l1.gt.n) goto 04
 
44
         if(chaine(l1).eq.lparen) icount=icount+1
 
45
         if(chaine(l1).eq.rparen) icount=icount-1
 
46
         if(icount.ne.0) goto 03
 
47
         if(l1.ne.n) goto 06         
 
48
         if(chaine(1).eq.minus) sign=-sign
 
49
         call icopy(n-3,chaine(3),1,chaine(1),1)
 
50
         n=n-3
 
51
      endif
 
52
 04   if(chaine(1).eq.lparen) then
 
53
         l1=2
 
54
         icount=1
 
55
 05      l1=l1+1
 
56
         if(l1.gt.n) goto 06
 
57
         if(chaine(l1).eq.lparen) icount=icount+1
 
58
         if(chaine(l1).eq.rparen) icount=icount-1
 
59
         if(icount.ne.0) goto 05
 
60
         if(l1.ne.n) goto 06
 
61
         if(chaine(1).eq.minus) sign=-sign
 
62
         call icopy(n-2,chaine(2),1,chaine(1),1)
 
63
         n=n-2
 
64
      endif
 
65
 06   if(n.lt.n0) goto 01
 
66
c on  rajoute eventuellement le premier signe
 
67
      if(chaine(1).ne.plus.and.chaine(1).ne.minus) then
 
68
         call icopy(n,chaine(1),-1,chaine(2),-1)
 
69
         chaine(1)=plus
 
70
         n=n+1
 
71
      endif
 
72
 
 
73
      np=0
 
74
c     
 
75
c on recherche chacun des termes et l'on change eventuellement les signes
 
76
      l1=0
 
77
      icount=0
 
78
 10   l1=l1+1
 
79
      if(l1.gt.n) goto 30
 
80
      if(chaine(l1).eq.lparen) icount=icount+1
 
81
      if(chaine(l1).eq.rparen) icount=icount-1
 
82
      if(icount.eq.0) then
 
83
         if(chaine(l1).eq.minus) then
 
84
            if(sign.eq.-1) chaine(l1)=plus
 
85
            np=np+1
 
86
            if(np.gt.maxnp) goto 100
 
87
            iptr(np)=l1
 
88
         elseif(chaine(l1).eq.plus) then
 
89
            if(sign.eq.-1) chaine(l1)=minus
 
90
            np=np+1
 
91
            if(np.gt.maxnp) goto 100
 
92
            iptr(np)=l1
 
93
         endif
 
94
      endif
 
95
      goto 10
 
96
      
 
97
 30   if(np+1.gt.maxnp) goto 100
 
98
      iptr(np+1)=l1
 
99
      return
 
100
 100  ierr=1
 
101
      return
 
102
      end