summaryrefslogtreecommitdiffstats
path: root/scilab/modules/symbolic/sci_gateway
diff options
context:
space:
mode:
authorPierre Marechal <pierre.marechal@scilab.org>2006-08-17 16:06:16 +0000
committerPierre Marechal <pierre.marechal@scilab.org>2006-08-17 16:06:16 +0000
commit44a50e7396e5524ba15ce218ba88aad564ff57cc (patch)
treef54c5bd157bec760cb658b7ced6ec86d5ca7aee8 /scilab/modules/symbolic/sci_gateway
parentb75847b822cf61fb516242f101661b204f0b883b (diff)
downloadscilab-44a50e7396e5524ba15ce218ba88aad564ff57cc.zip
scilab-44a50e7396e5524ba15ce218ba88aad564ff57cc.tar.gz
Set svn:eol-style to native
Diffstat (limited to 'scilab/modules/symbolic/sci_gateway')
-rw-r--r--scilab/modules/symbolic/sci_gateway/c/gw_symbolic.c110
-rw-r--r--scilab/modules/symbolic/sci_gateway/c/sci_addsubf.c42
-rw-r--r--scilab/modules/symbolic/sci_gateway/c/sci_ldivf.c30
-rw-r--r--scilab/modules/symbolic/sci_gateway/c/sci_mulf.c30
-rw-r--r--scilab/modules/symbolic/sci_gateway/c/sci_rdivf.c30
-rw-r--r--scilab/modules/symbolic/sci_gateway/fortran/sci_addsubf.f330
-rw-r--r--scilab/modules/symbolic/sci_gateway/fortran/sci_ldivf.f522
-rw-r--r--scilab/modules/symbolic/sci_gateway/fortran/sci_mulf.f522
-rw-r--r--scilab/modules/symbolic/sci_gateway/fortran/sci_rdivf.f522
9 files changed, 1069 insertions, 1069 deletions
diff --git a/scilab/modules/symbolic/sci_gateway/c/gw_symbolic.c b/scilab/modules/symbolic/sci_gateway/c/gw_symbolic.c
index ba3445f..5ae40db 100644
--- a/scilab/modules/symbolic/sci_gateway/c/gw_symbolic.c
+++ b/scilab/modules/symbolic/sci_gateway/c/gw_symbolic.c
@@ -1,55 +1,55 @@
1#include "gw_symbolic.h" 1#include "gw_symbolic.h"
2/*-----------------------------------------------------------------------------------*/ 2/*-----------------------------------------------------------------------------------*/
3/* INRIA 2006 */ 3/* INRIA 2006 */
4/* Allan CORNET */ 4/* Allan CORNET */
5/*-----------------------------------------------------------------------------------*/ 5/*-----------------------------------------------------------------------------------*/
6#if _MSC_VER 6#if _MSC_VER
7#include <Windows.h> 7#include <Windows.h>
8#include "MALLOC.h" 8#include "MALLOC.h"
9extern char *GetExceptionString(DWORD ExceptionCode); 9extern char *GetExceptionString(DWORD ExceptionCode);
10#endif 10#endif
11/*-----------------------------------------------------------------------------------*/ 11/*-----------------------------------------------------------------------------------*/
12 12
13extern int C2F(sci_addf) _PARAMS((char *fname,unsigned long fname_len)); 13extern int C2F(sci_addf) _PARAMS((char *fname,unsigned long fname_len));
14extern int C2F(sci_subf) _PARAMS((char *fname,unsigned long fname_len)); 14extern int C2F(sci_subf) _PARAMS((char *fname,unsigned long fname_len));
15extern int C2F(sci_mulf) _PARAMS((char *fname,unsigned long fname_len)); 15extern int C2F(sci_mulf) _PARAMS((char *fname,unsigned long fname_len));
16extern int C2F(sci_ldivf) _PARAMS((char *fname,unsigned long fname_len)); 16extern int C2F(sci_ldivf) _PARAMS((char *fname,unsigned long fname_len));
17extern int C2F(sci_rdivf) _PARAMS((char *fname,unsigned long fname_len)); 17extern int C2F(sci_rdivf) _PARAMS((char *fname,unsigned long fname_len));
18/*-----------------------------------------------------------------------------------*/ 18/*-----------------------------------------------------------------------------------*/
19static SymbolicTable Tab[]= 19static SymbolicTable Tab[]=
20{ 20{
21{C2F(sci_addf),"addf"}, 21{C2F(sci_addf),"addf"},
22{C2F(sci_subf),"subf"}, 22{C2F(sci_subf),"subf"},
23{C2F(sci_mulf),"mulf"}, 23{C2F(sci_mulf),"mulf"},
24{C2F(sci_ldivf),"ldivf"}, 24{C2F(sci_ldivf),"ldivf"},
25{C2F(sci_rdivf),"rdivf"} 25{C2F(sci_rdivf),"rdivf"}
26}; 26};
27/*-----------------------------------------------------------------------------------*/ 27/*-----------------------------------------------------------------------------------*/
28int C2F(gw_symbolic)() 28int C2F(gw_symbolic)()
29{ 29{
30 if (Rhs != 2) 30 if (Rhs != 2)
31 { 31 {
32 Scierror(39,"incorrect number of arguments.\r\n"); 32 Scierror(39,"incorrect number of arguments.\r\n");
33 return 0; 33 return 0;
34 } 34 }
35#if _MSC_VER 35#if _MSC_VER
36 #ifndef _DEBUG 36 #ifndef _DEBUG
37 _try 37 _try
38 { 38 {
39 (*(Tab[Fin-1].f)) (Tab[Fin-1].name,strlen(Tab[Fin-1].name)); 39 (*(Tab[Fin-1].f)) (Tab[Fin-1].name,strlen(Tab[Fin-1].name));
40 } 40 }
41 _except (EXCEPTION_EXECUTE_HANDLER) 41 _except (EXCEPTION_EXECUTE_HANDLER)
42 { 42 {
43 char *ExceptionString=GetExceptionString(GetExceptionCode()); 43 char *ExceptionString=GetExceptionString(GetExceptionCode());
44 sciprint("Warning !!!\nScilab has found a critical error (%s)\nwith \"%s\" function.\nScilab may become unstable.\n",ExceptionString,Tab[Fin-1].name); 44 sciprint("Warning !!!\nScilab has found a critical error (%s)\nwith \"%s\" function.\nScilab may become unstable.\n",ExceptionString,Tab[Fin-1].name);
45 if (ExceptionString) {FREE(ExceptionString);ExceptionString=NULL;} 45 if (ExceptionString) {FREE(ExceptionString);ExceptionString=NULL;}
46 } 46 }
47 #else 47 #else
48 (*(Tab[Fin-1].f)) (Tab[Fin-1].name,strlen(Tab[Fin-1].name)); 48 (*(Tab[Fin-1].f)) (Tab[Fin-1].name,strlen(Tab[Fin-1].name));
49 #endif 49 #endif
50#else 50#else
51 (*(Tab[Fin-1].f)) (Tab[Fin-1].name,strlen(Tab[Fin-1].name)); 51 (*(Tab[Fin-1].f)) (Tab[Fin-1].name,strlen(Tab[Fin-1].name));
52#endif 52#endif
53 return 0; 53 return 0;
54} 54}
55/*-----------------------------------------------------------------------------------*/ 55/*-----------------------------------------------------------------------------------*/
diff --git a/scilab/modules/symbolic/sci_gateway/c/sci_addsubf.c b/scilab/modules/symbolic/sci_gateway/c/sci_addsubf.c
index 2c06b55..9444e36 100644
--- a/scilab/modules/symbolic/sci_gateway/c/sci_addsubf.c
+++ b/scilab/modules/symbolic/sci_gateway/c/sci_addsubf.c
@@ -1,21 +1,21 @@
1/*-----------------------------------------------------------------------------------*/ 1/*-----------------------------------------------------------------------------------*/
2/* INRIA 2006 */ 2/* INRIA 2006 */
3/* Allan CORNET */ 3/* Allan CORNET */
4/*-----------------------------------------------------------------------------------*/ 4/*-----------------------------------------------------------------------------------*/
5#include "machine.h" 5#include "machine.h"
6#include "stack-c.h" 6#include "stack-c.h"
7/*-----------------------------------------------------------------------------------*/ 7/*-----------------------------------------------------------------------------------*/
8extern int C2F(sciaddfsubf) _PARAMS((char *fname)); 8extern int C2F(sciaddfsubf) _PARAMS((char *fname));
9/*-----------------------------------------------------------------------------------*/ 9/*-----------------------------------------------------------------------------------*/
10int C2F(sci_addf) _PARAMS((char *fname,unsigned long fname_len)) 10int C2F(sci_addf) _PARAMS((char *fname,unsigned long fname_len))
11{ 11{
12 C2F(sciaddfsubf)(fname); 12 C2F(sciaddfsubf)(fname);
13 return 0; 13 return 0;
14} 14}
15/*-----------------------------------------------------------------------------------*/ 15/*-----------------------------------------------------------------------------------*/
16int C2F(sci_subf) _PARAMS((char *fname,unsigned long fname_len)) 16int C2F(sci_subf) _PARAMS((char *fname,unsigned long fname_len))
17{ 17{
18 C2F(sciaddfsubf)(fname); 18 C2F(sciaddfsubf)(fname);
19 return 0; 19 return 0;
20} 20}
21/*-----------------------------------------------------------------------------------*/ 21/*-----------------------------------------------------------------------------------*/
diff --git a/scilab/modules/symbolic/sci_gateway/c/sci_ldivf.c b/scilab/modules/symbolic/sci_gateway/c/sci_ldivf.c
index 21691a8..37a0866 100644
--- a/scilab/modules/symbolic/sci_gateway/c/sci_ldivf.c
+++ b/scilab/modules/symbolic/sci_gateway/c/sci_ldivf.c
@@ -1,15 +1,15 @@
1/*-----------------------------------------------------------------------------------*/ 1/*-----------------------------------------------------------------------------------*/
2/* INRIA 2006 */ 2/* INRIA 2006 */
3/* Allan CORNET */ 3/* Allan CORNET */
4/*-----------------------------------------------------------------------------------*/ 4/*-----------------------------------------------------------------------------------*/
5#include "machine.h" 5#include "machine.h"
6#include "stack-c.h" 6#include "stack-c.h"
7/*-----------------------------------------------------------------------------------*/ 7/*-----------------------------------------------------------------------------------*/
8extern int C2F(scildivf) _PARAMS((char *fname)); 8extern int C2F(scildivf) _PARAMS((char *fname));
9/*-----------------------------------------------------------------------------------*/ 9/*-----------------------------------------------------------------------------------*/
10int C2F(sci_ldivf) _PARAMS((char *fname,unsigned long fname_len)) 10int C2F(sci_ldivf) _PARAMS((char *fname,unsigned long fname_len))
11{ 11{
12 C2F(scildivf)(fname); 12 C2F(scildivf)(fname);
13 return 0; 13 return 0;
14} 14}
15/*-----------------------------------------------------------------------------------*/ 15/*-----------------------------------------------------------------------------------*/
diff --git a/scilab/modules/symbolic/sci_gateway/c/sci_mulf.c b/scilab/modules/symbolic/sci_gateway/c/sci_mulf.c
index 7e21953..97aa759 100644
--- a/scilab/modules/symbolic/sci_gateway/c/sci_mulf.c
+++ b/scilab/modules/symbolic/sci_gateway/c/sci_mulf.c
@@ -1,15 +1,15 @@
1/*-----------------------------------------------------------------------------------*/ 1/*-----------------------------------------------------------------------------------*/
2/* INRIA 2006 */ 2/* INRIA 2006 */
3/* Allan CORNET */ 3/* Allan CORNET */
4/*-----------------------------------------------------------------------------------*/ 4/*-----------------------------------------------------------------------------------*/
5#include "machine.h" 5#include "machine.h"
6#include "stack-c.h" 6#include "stack-c.h"
7/*-----------------------------------------------------------------------------------*/ 7/*-----------------------------------------------------------------------------------*/
8extern int C2F(scimulf) _PARAMS((char *fname)); 8extern int C2F(scimulf) _PARAMS((char *fname));
9/*-----------------------------------------------------------------------------------*/ 9/*-----------------------------------------------------------------------------------*/
10int C2F(sci_mulf) _PARAMS((char *fname,unsigned long fname_len)) 10int C2F(sci_mulf) _PARAMS((char *fname,unsigned long fname_len))
11{ 11{
12 C2F(scimulf)(fname); 12 C2F(scimulf)(fname);
13 return 0; 13 return 0;
14} 14}
15/*-----------------------------------------------------------------------------------*/ 15/*-----------------------------------------------------------------------------------*/
diff --git a/scilab/modules/symbolic/sci_gateway/c/sci_rdivf.c b/scilab/modules/symbolic/sci_gateway/c/sci_rdivf.c
index efb3565..e8ab873 100644
--- a/scilab/modules/symbolic/sci_gateway/c/sci_rdivf.c
+++ b/scilab/modules/symbolic/sci_gateway/c/sci_rdivf.c
@@ -1,15 +1,15 @@
1/*-----------------------------------------------------------------------------------*/ 1/*-----------------------------------------------------------------------------------*/
2/* INRIA 2006 */ 2/* INRIA 2006 */
3/* Allan CORNET */ 3/* Allan CORNET */
4/*-----------------------------------------------------------------------------------*/ 4/*-----------------------------------------------------------------------------------*/
5#include "machine.h" 5#include "machine.h"
6#include "stack-c.h" 6#include "stack-c.h"
7/*-----------------------------------------------------------------------------------*/ 7/*-----------------------------------------------------------------------------------*/
8extern int C2F(scirdivf) _PARAMS((char *fname)); 8extern int C2F(scirdivf) _PARAMS((char *fname));
9/*-----------------------------------------------------------------------------------*/ 9/*-----------------------------------------------------------------------------------*/
10int C2F(sci_rdivf) _PARAMS((char *fname,unsigned long fname_len)) 10int C2F(sci_rdivf) _PARAMS((char *fname,unsigned long fname_len))
11{ 11{
12 C2F(scirdivf)(fname); 12 C2F(scirdivf)(fname);
13 return 0; 13 return 0;
14} 14}
15/*-----------------------------------------------------------------------------------*/ 15/*-----------------------------------------------------------------------------------*/
diff --git a/scilab/modules/symbolic/sci_gateway/fortran/sci_addsubf.f b/scilab/modules/symbolic/sci_gateway/fortran/sci_addsubf.f
index 74f9d2a..9be3b67 100644
--- a/scilab/modules/symbolic/sci_gateway/fortran/sci_addsubf.f
+++ b/scilab/modules/symbolic/sci_gateway/fortran/sci_addsubf.f
@@ -1,166 +1,166 @@
1c -------------------------- 1c --------------------------
2c Copyright INRIA 2c Copyright INRIA
3c -------------------------- 3c --------------------------
4c 4c
5 subroutine sciaddfsubf(fname) 5 subroutine sciaddfsubf(fname)
6c ---------------------------- 6c ----------------------------
7 character*(*) fname 7 character*(*) fname
8 include 'stack.h' 8 include 'stack.h'
9 9
10 logical iseye,isnum 10 logical iseye,isnum
11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb 11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb
12 integer iadr,sadr 12 integer iadr,sadr
13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/ 13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/
14 data slash/48/ ,bslash/49/ 14 data slash/48/ ,bslash/49/
15 15
16 iadr(l)=l+l-1 16 iadr(l)=l+l-1
17 sadr(l)=(l/2)+1 17 sadr(l)=(l/2)+1
18 18
19 isg=1 19 isg=1
20 if(fin.eq.2) isg=-1 20 if(fin.eq.2) isg=-1
21 ilptr1=iadr(lstk(top+1))+1 21 ilptr1=iadr(lstk(top+1))+1
22c le "+1" est du a expsum qui peut renvoyer une chaine 1 carac plus long 22c le "+1" est du a expsum qui peut renvoyer une chaine 1 carac plus long
23c que la chaine donnee 23c que la chaine donnee
24 il1=iadr(lstk(top-1)) 24 il1=iadr(lstk(top-1))
25 il=il1 25 il=il1
26 if(istk(il1).ne.10) then 26 if(istk(il1).ne.10) then
27 err=1 27 err=1
28 call error(55) 28 call error(55)
29 return 29 return
30 endif 30 endif
31 il2=iadr(lstk(top)) 31 il2=iadr(lstk(top))
32 if(istk(il2).ne.10) then 32 if(istk(il2).ne.10) then
33 err=2 33 err=2
34 call error(55) 34 call error(55)
35 return 35 return
36 endif 36 endif
37 is=plus 37 is=plus
38c 38c
39 if(istk(il1+1)*istk(il1+2).ne.1) then 39 if(istk(il1+1)*istk(il1+2).ne.1) then
40 err=1 40 err=1
41 call error(36) 41 call error(36)
42 return 42 return
43 endif 43 endif
44 n1=istk(il1+5)-1 44 n1=istk(il1+5)-1
45 il1=il1+6 45 il1=il1+6
46 il0=il1 46 il0=il1
47 maxnp=iadr(lstk(bot))-ilptr1 47 maxnp=iadr(lstk(bot))-ilptr1
48 call expsum(1,istk(il1),n1,istk(ilptr1),np1,maxnp,err) 48 call expsum(1,istk(il1),n1,istk(ilptr1),np1,maxnp,err)
49 if(err.gt.0) then 49 if(err.gt.0) then
50 call error(17) 50 call error(17)
51 return 51 return
52 endif 52 endif
53c 53c
54 ilptr2=ilptr1+np1+1 54 ilptr2=ilptr1+np1+1
55 if(istk(il2+1)*istk(il2+2).ne.1) then 55 if(istk(il2+1)*istk(il2+2).ne.1) then
56 err=2 56 err=2
57 call error(36) 57 call error(36)
58 return 58 return
59 endif 59 endif
60 n2=istk(il2+5)-1 60 n2=istk(il2+5)-1
61 il2=il2+6 61 il2=il2+6
62 top=top-1 62 top=top-1
63 maxnp=iadr(lstk(bot))-ilptr2 63 maxnp=iadr(lstk(bot))-ilptr2
64 call expsum(isg,istk(il2),n2,istk(ilptr2),np2,maxnp,err) 64 call expsum(isg,istk(il2),n2,istk(ilptr2),np2,maxnp,err)
65 if(err.gt.0) then 65 if(err.gt.0) then
66 call error(17) 66 call error(17)
67 return 67 return
68 endif 68 endif
69c 69c
70 inum=0 70 inum=0
71 do 1005 i1=1,np1 71 do 1005 i1=1,np1
72 it1=il1-1+istk(ilptr1-1+i1) 72 it1=il1-1+istk(ilptr1-1+i1)
73 nt1=istk(ilptr1+i1)-istk(ilptr1-1+i1) 73 nt1=istk(ilptr1+i1)-istk(ilptr1-1+i1)
74 if(istk(it1+1).eq.0.and.n1.eq.2) then 74 if(istk(it1+1).eq.0.and.n1.eq.2) then
75 call icopy(n2,istk(il2),1,istk(il1),1) 75 call icopy(n2,istk(il2),1,istk(il1),1)
76 il1=il1+n2 76 il1=il1+n2
77 goto 1010 77 goto 1010
78 endif 78 endif
79 if(isnum(istk(it1+1),nt1-1,inum1)) then 79 if(isnum(istk(it1+1),nt1-1,inum1)) then
80 if(istk(it1).eq.minus) inum1=-inum1 80 if(istk(it1).eq.minus) inum1=-inum1
81 inum=inum+inum1 81 inum=inum+inum1
82 istk(it1)=0 82 istk(it1)=0
83 endif 83 endif
84 i2=0 84 i2=0
85 1004 i2=i2+1 85 1004 i2=i2+1
86 if(i2.gt.np2) goto 1005 86 if(i2.gt.np2) goto 1005
87 it2=il2-1+istk(ilptr2-1+i2) 87 it2=il2-1+istk(ilptr2-1+i2)
88 if(istk(it2).eq.0) goto 1004 88 if(istk(it2).eq.0) goto 1004
89 nt2=istk(ilptr2+i2)-istk(ilptr2-1+i2) 89 nt2=istk(ilptr2+i2)-istk(ilptr2-1+i2)
90 if(istk(it2+1).eq.0.and.n2.eq.2) then 90 if(istk(it2+1).eq.0.and.n2.eq.2) then
91 if (istk(it1).ne.0) then 91 if (istk(it1).ne.0) then
92 il1=il1+n1 92 il1=il1+n1
93 goto 1010 93 goto 1010
94 else 94 else
95 ilw=il1 95 ilw=il1
96 goto 1008 96 goto 1008
97 endif 97 endif
98 endif 98 endif
99 if(isnum(istk(it2+1),nt2-1,inum2)) then 99 if(isnum(istk(it2+1),nt2-1,inum2)) then
100 if(istk(it2).eq.minus) inum2=-inum2 100 if(istk(it2).eq.minus) inum2=-inum2
101 inum=inum+inum2 101 inum=inum+inum2
102 istk(it2)=0 102 istk(it2)=0
103 goto 1004 103 goto 1004
104 endif 104 endif
105 if (istk(it1).ne.istk(it2).and.nt1.eq.nt2) then 105 if (istk(it1).ne.istk(it2).and.nt1.eq.nt2) then
106c on regarde si les termes sont egaux 106c on regarde si les termes sont egaux
107 do 1002 k=2,nt1 107 do 1002 k=2,nt1
108 if(istk(it1-1+k).ne.istk(it2-1+k)) goto 1004 108 if(istk(it1-1+k).ne.istk(it2-1+k)) goto 1004
109 1002 continue 109 1002 continue
110 istk(it2)=0 110 istk(it2)=0
111 istk(it1)=0 111 istk(it1)=0
112 goto 1005 112 goto 1005
113 endif 113 endif
114 goto 1004 114 goto 1004
115 1005 continue 115 1005 continue
116c 116c
117 ilw=il1 117 ilw=il1
118 do 1006 i1=1,np1 118 do 1006 i1=1,np1
119 it1=il1-1+istk(ilptr1-1+i1) 119 it1=il1-1+istk(ilptr1-1+i1)
120 nt1=istk(ilptr1+i1)-istk(ilptr1-1+i1) 120 nt1=istk(ilptr1+i1)-istk(ilptr1-1+i1)
121 if(istk(it1).ne.0) then 121 if(istk(it1).ne.0) then
122 call icopy(nt1,istk(it1),1,istk(ilw),1) 122 call icopy(nt1,istk(it1),1,istk(ilw),1)
123 ilw=ilw+nt1 123 ilw=ilw+nt1
124 endif 124 endif
125 1006 continue 125 1006 continue
126 do 1007 i2=1,np2 126 do 1007 i2=1,np2
127 it2=il2-1+istk(ilptr2-1+i2) 127 it2=il2-1+istk(ilptr2-1+i2)
128 nt2=istk(ilptr2+i2)-istk(ilptr2-1+i2) 128 nt2=istk(ilptr2+i2)-istk(ilptr2-1+i2)
129 if(istk(it2).ne.0) then 129 if(istk(it2).ne.0) then
130 call icopy(nt2,istk(it2),1,istk(ilw),1) 130 call icopy(nt2,istk(it2),1,istk(ilw),1)
131 ilw=ilw+nt2 131 ilw=ilw+nt2
132 endif 132 endif
133 1007 continue 133 1007 continue
134c 134c
135 1008 if(inum.ne.0) then 135 1008 if(inum.ne.0) then
136 if(inum.lt.0) then 136 if(inum.lt.0) then
137 istk(ilw)=minus 137 istk(ilw)=minus
138 ilw=ilw+1 138 ilw=ilw+1
139 inum=-inum 139 inum=-inum
140 elseif(ilw.ne.il0) then 140 elseif(ilw.ne.il0) then
141 istk(ilw)=plus 141 istk(ilw)=plus
142 ilw=ilw+1 142 ilw=ilw+1
143 endif 143 endif
144 call intstr(inum,istk(ilw),ni,0) 144 call intstr(inum,istk(ilw),ni,0)
145 ilw=ilw+ni 145 ilw=ilw+ni
146 endif 146 endif
147c 147c
148 il1=ilw 148 il1=ilw
149 if(il1.eq.il0) then 149 if(il1.eq.il0) then
150 istk(il1)=0 150 istk(il1)=0
151 il1=il1+1 151 il1=il1+1
152 endif 152 endif
153c 153c
154 1010 n1=il1-il0 154 1010 n1=il1-il0
155 if(istk(il0).eq.plus) then 155 if(istk(il0).eq.plus) then
156 call icopy(n1-1,istk(il0+1),1,istk(il0),1) 156 call icopy(n1-1,istk(il0+1),1,istk(il0),1)
157 n1=n1-1 157 n1=n1-1
158 il1=il1-1 158 il1=il1-1
159 endif 159 endif
160 istk(il+5)=n1+1 160 istk(il+5)=n1+1
161 lstk(top+1)=sadr(il1+1) 161 lstk(top+1)=sadr(il1+1)
162 goto 9999 162 goto 9999
163 163
164 9999 return 164 9999 return
165 end 165 end
166 \ No newline at end of file 166 \ No newline at end of file
diff --git a/scilab/modules/symbolic/sci_gateway/fortran/sci_ldivf.f b/scilab/modules/symbolic/sci_gateway/fortran/sci_ldivf.f
index a58e112..0905551 100644
--- a/scilab/modules/symbolic/sci_gateway/fortran/sci_ldivf.f
+++ b/scilab/modules/symbolic/sci_gateway/fortran/sci_ldivf.f
@@ -1,261 +1,261 @@
1c -------------------------- 1c --------------------------
2c Copyright INRIA 2c Copyright INRIA
3c -------------------------- 3c --------------------------
4c 4c
5 subroutine scildivf(fname) 5 subroutine scildivf(fname)
6c ---------------------------- 6c ----------------------------
7 character*(*) fname 7 character*(*) fname
8 include 'stack.h' 8 include 'stack.h'
9 9
10 logical iseye,isnum 10 logical iseye,isnum
11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb 11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb
12 integer iadr,sadr 12 integer iadr,sadr
13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/ 13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/
14 data slash/48/ ,bslash/49/ 14 data slash/48/ ,bslash/49/
15 15
16 iadr(l)=l+l-1 16 iadr(l)=l+l-1
17 sadr(l)=(l/2)+1 17 sadr(l)=(l/2)+1
18 18
19 symb=bslash 19 symb=bslash
20 20
21 il1=iadr(lstk(top-1)) 21 il1=iadr(lstk(top-1))
22 il=il1 22 il=il1
23 if(istk(il1).ne.10) then 23 if(istk(il1).ne.10) then
24 err=1 24 err=1
25 call error(55) 25 call error(55)
26 return 26 return
27 endif 27 endif
28 if(istk(il1+1)*istk(il1+2).ne.1) then 28 if(istk(il1+1)*istk(il1+2).ne.1) then
29 err=1 29 err=1
30 call error(36) 30 call error(36)
31 return 31 return
32 endif 32 endif
33 n1=istk(il1+5)-1 33 n1=istk(il1+5)-1
34 il1=il1+6 34 il1=il1+6
35 il0=il1 35 il0=il1
36 call atome(istk(il1),n1,it1,is1) 36 call atome(istk(il1),n1,it1,is1)
37 if(symb.ne.bslash) call termf(istk(il1),n1,it1) 37 if(symb.ne.bslash) call termf(istk(il1),n1,it1)
38c 38c
39 il2=iadr(lstk(top)) 39 il2=iadr(lstk(top))
40 if(istk(il2).ne.10) then 40 if(istk(il2).ne.10) then
41 err=2 41 err=2
42 call error(55) 42 call error(55)
43 return 43 return
44 endif 44 endif
45 if(istk(il2+1)*istk(il2+2).ne.1) then 45 if(istk(il2+1)*istk(il2+2).ne.1) then
46 err=2 46 err=2
47 call error(36) 47 call error(36)
48 return 48 return
49 endif 49 endif
50 n2=istk(il2+5)-1 50 n2=istk(il2+5)-1
51 il2=il2+6 51 il2=il2+6
52 top=top-1 52 top=top-1
53c 53c
54 call atome(istk(il2),n2,it2,is2) 54 call atome(istk(il2),n2,it2,is2)
55 if(symb.ne.slash) call termf(istk(il2),n2,it2) 55 if(symb.ne.slash) call termf(istk(il2),n2,it2)
56 if (it2.ne.0) call factf(istk(il2),n2,it2) 56 if (it2.ne.0) call factf(istk(il2),n2,it2)
57 57
58c 58c
59 goto (2010,2020,2030,2040) it1+2*it2+1 59 goto (2010,2020,2030,2040) it1+2*it2+1
60c 60c
61c 2 expressions 61c 2 expressions
62 2010 continue 62 2010 continue
63 idec=0 63 idec=0
64 if(is1.ne.1) then 64 if(is1.ne.1) then
65 call icopy(n1,istk(il1),-1,istk(il1+1),-1) 65 call icopy(n1,istk(il1),-1,istk(il1+1),-1)
66 idec=1 66 idec=1
67 endif 67 endif
68 il0=il1 68 il0=il1
69 istk(il1)=lparen 69 istk(il1)=lparen
70 istk(il1+n1+idec)=rparen 70 istk(il1+n1+idec)=rparen
71 il1=il1+n1+idec+1 71 il1=il1+n1+idec+1
72 istk(il1)=symb 72 istk(il1)=symb
73 il1=il1+1 73 il1=il1+1
74 istk(il1)=lparen 74 istk(il1)=lparen
75 il1=il1+1 75 il1=il1+1
76 if(is2.eq.1) then 76 if(is2.eq.1) then
77 il2=il2+1 77 il2=il2+1
78 n2=n2-1 78 n2=n2-1
79 endif 79 endif
80 call icopy(n2,istk(il2),1,istk(il1),1) 80 call icopy(n2,istk(il2),1,istk(il1),1)
81 il1=il1+n2 81 il1=il1+n2
82 istk(il1)=rparen 82 istk(il1)=rparen
83 il1=il1+1 83 il1=il1+1
84 istk(il+5)=il1-il0+1 84 istk(il+5)=il1-il0+1
85 lstk(top+1)=sadr(il1) 85 lstk(top+1)=sadr(il1)
86 goto 9999 86 goto 9999
87 2020 continue 87 2020 continue
88c un atome et une expression 88c un atome et une expression
89 idec=abs(is1) 89 idec=abs(is1)
90 ipar=0 90 ipar=0
91 if(n1-idec.eq.1 .and.istk(il1+idec).eq.0) then 91 if(n1-idec.eq.1 .and.istk(il1+idec).eq.0) then
92 if(symb.eq.bslash) then 92 if(symb.eq.bslash) then
93 call error(27) 93 call error(27)
94 return 94 return
95 endif 95 endif
96 goto 9999 96 goto 9999
97 endif 97 endif
98 if(symb.ne.slash.and. 98 if(symb.ne.slash.and.
99 & ((n1-idec.eq.1 .and. istk(il1+idec).eq.1).or. 99 & ((n1-idec.eq.1 .and. istk(il1+idec).eq.1).or.
100 & (n1-idec.eq.5.and.iseye(istk(il1+idec))))) then 100 & (n1-idec.eq.5.and.iseye(istk(il1+idec))))) then
101c n1=n1-1 101c n1=n1-1
102 n1=idec 102 n1=idec
103 if(is1.eq.-1) then 103 if(is1.eq.-1) then
104 istk(il1+n1)=lparen 104 istk(il1+n1)=lparen
105 n1=n1+1 105 n1=n1+1
106 ipar=1 106 ipar=1
107 endif 107 endif
108 goto 2021 108 goto 2021
109 else 109 else
110 istk(il1+n1)=symb 110 istk(il1+n1)=symb
111 istk(il1+n1+1)=lparen 111 istk(il1+n1+1)=lparen
112 n1=n1+2 112 n1=n1+2
113 ipar=1 113 ipar=1
114 endif 114 endif
115 2021 if(is2.eq.1) then 115 2021 if(is2.eq.1) then
116 il2=il2+1 116 il2=il2+1
117 n2=n2-1 117 n2=n2-1
118 endif 118 endif
119 call icopy(n2,istk(il2),1,istk(il1+n1),1) 119 call icopy(n2,istk(il2),1,istk(il1+n1),1)
120 n1=n1+n2 120 n1=n1+n2
121 if(ipar.eq.1) then 121 if(ipar.eq.1) then
122 istk(il1+n1)=rparen 122 istk(il1+n1)=rparen
123 n1=n1+1 123 n1=n1+1
124 endif 124 endif
125 istk(il+5)=1+n1 125 istk(il+5)=1+n1
126 lstk(top+1)=sadr(il1+n1) 126 lstk(top+1)=sadr(il1+n1)
127 goto 9999 127 goto 9999
128c expr et atome 128c expr et atome
129 2030 continue 129 2030 continue
130 idec=abs(is2) 130 idec=abs(is2)
131 if(n2-idec.eq.1.and.istk(il2+idec).eq.0) then 131 if(n2-idec.eq.1.and.istk(il2+idec).eq.0) then
132 if(symb.eq.slash) then 132 if(symb.eq.slash) then
133 call error(27) 133 call error(27)
134 return 134 return
135 endif 135 endif
136 istk(il1)=0 136 istk(il1)=0
137 istk(il+5)=2 137 istk(il+5)=2
138 lstk(top+1)=sadr(il1+1) 138 lstk(top+1)=sadr(il1+1)
139 goto 9999 139 goto 9999
140 endif 140 endif
141 if(symb.ne.bslash.and.is2.ge.0 141 if(symb.ne.bslash.and.is2.ge.0
142 & .and.((n2-idec.eq.1.and.istk(il2+idec).eq.1) 142 & .and.((n2-idec.eq.1.and.istk(il2+idec).eq.1)
143 & .or.(n2-idec.eq.5.and.iseye(istk(il2+idec))))) then 143 & .or.(n2-idec.eq.5.and.iseye(istk(il2+idec))))) then
144 istk(il+5)=n1+1 144 istk(il+5)=n1+1
145 lstk(top+1)=sadr(il1+n1) 145 lstk(top+1)=sadr(il1+n1)
146 goto 9999 146 goto 9999
147 endif 147 endif
148 idec=0 148 idec=0
149 if(is1.ne.1) idec=idec+1 149 if(is1.ne.1) idec=idec+1
150 if(is2.lt.0) idec=idec+1 150 if(is2.lt.0) idec=idec+1
151 call icopy(n1,istk(il1),-1,istk(il1+idec),-1) 151 call icopy(n1,istk(il1),-1,istk(il1+idec),-1)
152 il0=il1 152 il0=il1
153 ill=il1 153 ill=il1
154 if(is2.lt.0) then 154 if(is2.lt.0) then
155 istk(ill)=minus 155 istk(ill)=minus
156 ill=ill+1 156 ill=ill+1
157 endif 157 endif
158 istk(ill)=lparen 158 istk(ill)=lparen
159 istk(il1+n1+idec)=rparen 159 istk(il1+n1+idec)=rparen
160 il1=il1+n1+idec+1 160 il1=il1+n1+idec+1
161 if(symb.ne.bslash.and.is2.eq.-1.and. 161 if(symb.ne.bslash.and.is2.eq.-1.and.
162 & ((n2.eq.2.and.istk(il2+1).eq.1).or. 162 & ((n2.eq.2.and.istk(il2+1).eq.1).or.
163 & (n2.eq.6.and.iseye(istk(il2+1))))) goto 2031 163 & (n2.eq.6.and.iseye(istk(il2+1))))) goto 2031
164 istk(il1)=symb 164 istk(il1)=symb
165 il1=il1+1 165 il1=il1+1
166 if(is2.ne.0) then 166 if(is2.ne.0) then
167 il2=il2+1 167 il2=il2+1
168 n2=n2-1 168 n2=n2-1
169 endif 169 endif
170 call icopy(n2,istk(il2),1,istk(il1),1) 170 call icopy(n2,istk(il2),1,istk(il1),1)
171 il1=il1+n2 171 il1=il1+n2
172 2031 istk(il+5)=il1-il0+1 172 2031 istk(il+5)=il1-il0+1
173 lstk(top+1)=sadr(il1) 173 lstk(top+1)=sadr(il1)
174 goto 9999 174 goto 9999
175c atome et atome 175c atome et atome
176 2040 continue 176 2040 continue
177 177
178 idec1=abs(is1) 178 idec1=abs(is1)
179 if(n1-idec1.eq.1.and.istk(il1+idec1).eq.0) then 179 if(n1-idec1.eq.1.and.istk(il1+idec1).eq.0) then
180 if(symb.eq.bslash) then 180 if(symb.eq.bslash) then
181 call error(27) 181 call error(27)
182 return 182 return
183 endif 183 endif
184 goto 9999 184 goto 9999
185 endif 185 endif
186 idec2=abs(is2) 186 idec2=abs(is2)
187 if(n2-idec2.eq.1.and.istk(il2+idec2).eq.0) then 187 if(n2-idec2.eq.1.and.istk(il2+idec2).eq.0) then
188 if(symb.eq.slash) then 188 if(symb.eq.slash) then
189 call error(27) 189 call error(27)
190 return 190 return
191 endif 191 endif
192 istk(il1)=0 192 istk(il1)=0
193 istk(il+5)=2 193 istk(il+5)=2
194 lstk(top+1)=sadr(il1+1) 194 lstk(top+1)=sadr(il1+1)
195 goto 9999 195 goto 9999
196 endif 196 endif
197 if(symb.eq.star) then 197 if(symb.eq.star) then
198 if(isnum(istk(il1+idec1),n1-idec1,inum1).and. 198 if(isnum(istk(il1+idec1),n1-idec1,inum1).and.
199 & isnum(istk(il2+idec2),n2-idec2,inum2)) then 199 & isnum(istk(il2+idec2),n2-idec2,inum2)) then
200 if(is1.eq.-1) inum1=-inum1 200 if(is1.eq.-1) inum1=-inum1
201 if(is2.eq.-1) inum2=-inum2 201 if(is2.eq.-1) inum2=-inum2
202 inum=inum1*inum2 202 inum=inum1*inum2
203 call intstr(inum,istk(il1),ni,0) 203 call intstr(inum,istk(il1),ni,0)
204 il1=il1+ni 204 il1=il1+ni
205 istk(il+5)=ni+1 205 istk(il+5)=ni+1
206 lstk(top+1)=sadr(il1) 206 lstk(top+1)=sadr(il1)
207 goto 9999 207 goto 9999
208 endif 208 endif
209 endif 209 endif
210 is=blanc 210 is=blanc
211 if(is1.eq.-1.and.is2.ge.0 .or. 211 if(is1.eq.-1.and.is2.ge.0 .or.
212 + is2.eq.-1.and.is1.ge.0) is=minus 212 + is2.eq.-1.and.is1.ge.0) is=minus
213 if(symb.ne.slash.and. 213 if(symb.ne.slash.and.
214 & ((n1-abs(is1).eq.1.and.istk(il1+abs(is1)).eq.1).or. 214 & ((n1-abs(is1).eq.1.and.istk(il1+abs(is1)).eq.1).or.
215 & (n1-abs(is1).eq.5.and.iseye(istk(il1+abs(is1))))) ) then 215 & (n1-abs(is1).eq.5.and.iseye(istk(il1+abs(is1))))) ) then
216 if(is.eq.minus) then 216 if(is.eq.minus) then
217 istk(il1)=is 217 istk(il1)=is
218 il1=il1+1 218 il1=il1+1
219 endif 219 endif
220 call icopy(n2-abs(is2),istk(il2+abs(is2)),1,istk(il1),1) 220 call icopy(n2-abs(is2),istk(il2+abs(is2)),1,istk(il1),1)
221 il1=il1+n2-abs(is2) 221 il1=il1+n2-abs(is2)
222 istk(il+5)=il1-il0+1 222 istk(il+5)=il1-il0+1
223 lstk(top+1)=sadr(il1+1) 223 lstk(top+1)=sadr(il1+1)
224 goto 9999 224 goto 9999
225 endif 225 endif
226 idec1=0 226 idec1=0
227 idec=0 227 idec=0
228 if(is1.eq.-1.and.is2.eq.-1) idec1=1 228 if(is1.eq.-1.and.is2.eq.-1) idec1=1
229 if(is.eq.minus.and.is1.eq.0) then 229 if(is.eq.minus.and.is1.eq.0) then
230 idec=1 230 idec=1
231 call icopy(n1,istk(il1),-1,istk(il1+idec),-1) 231 call icopy(n1,istk(il1),-1,istk(il1+idec),-1)
232 n1=n1+1 232 n1=n1+1
233 endif 233 endif
234 if(idec1.ne.0) then 234 if(idec1.ne.0) then
235 call icopy(n1-1,istk(il1+idec+1),1,istk(il1+idec),1) 235 call icopy(n1-1,istk(il1+idec+1),1,istk(il1+idec),1)
236 n1=n1-1 236 n1=n1-1
237 endif 237 endif
238 il0=il1 238 il0=il1
239 ill=il1 239 ill=il1
240 if(is.eq.minus) then 240 if(is.eq.minus) then
241 istk(ill)=minus 241 istk(ill)=minus
242 ill=ill+1 242 ill=ill+1
243 endif 243 endif
244 il1=il1+n1 244 il1=il1+n1
245 if(symb.ne.bslash.and. 245 if(symb.ne.bslash.and.
246 & ((n2-abs(is2).eq.1.and.istk(il2+abs(is2)).eq.1).or. 246 & ((n2-abs(is2).eq.1.and.istk(il2+abs(is2)).eq.1).or.
247 & (n2-abs(is2).eq.5.and.iseye(istk(il2+abs(is2)))))) goto 2041 247 & (n2-abs(is2).eq.5.and.iseye(istk(il2+abs(is2)))))) goto 2041
248 istk(il1)=symb 248 istk(il1)=symb
249 il1=il1+1 249 il1=il1+1
250 if(is2.ne.0) then 250 if(is2.ne.0) then
251 il2=il2+1 251 il2=il2+1
252 n2=n2-1 252 n2=n2-1
253 endif 253 endif
254 call icopy(n2,istk(il2),1,istk(il1),1) 254 call icopy(n2,istk(il2),1,istk(il1),1)
255 il1=il1+n2 255 il1=il1+n2
256 2041 istk(il+5)=il1-il0+1 256 2041 istk(il+5)=il1-il0+1
257 lstk(top+1)=sadr(il1) 257 lstk(top+1)=sadr(il1)
258 goto 9999 258 goto 9999
259c 259c
260 9999 return 260 9999 return
261 end 261 end
diff --git a/scilab/modules/symbolic/sci_gateway/fortran/sci_mulf.f b/scilab/modules/symbolic/sci_gateway/fortran/sci_mulf.f
index 3aa6361..be101cc 100644
--- a/scilab/modules/symbolic/sci_gateway/fortran/sci_mulf.f
+++ b/scilab/modules/symbolic/sci_gateway/fortran/sci_mulf.f
@@ -1,262 +1,262 @@
1c -------------------------- 1c --------------------------
2c Copyright INRIA 2c Copyright INRIA
3c -------------------------- 3c --------------------------
4c 4c
5 subroutine scimulf(fname) 5 subroutine scimulf(fname)
6c ---------------------------- 6c ----------------------------
7 character*(*) fname 7 character*(*) fname
8 include 'stack.h' 8 include 'stack.h'
9 9
10 logical iseye,isnum 10 logical iseye,isnum
11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb 11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb
12 integer iadr,sadr 12 integer iadr,sadr
13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/ 13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/
14 data slash/48/ ,bslash/49/ 14 data slash/48/ ,bslash/49/
15 15
16 iadr(l)=l+l-1 16 iadr(l)=l+l-1
17 sadr(l)=(l/2)+1 17 sadr(l)=(l/2)+1
18 18
19 symb=star 19 symb=star
20 20
21 il1=iadr(lstk(top-1)) 21 il1=iadr(lstk(top-1))
22 il=il1 22 il=il1
23 if(istk(il1).ne.10) then 23 if(istk(il1).ne.10) then
24 err=1 24 err=1
25 call error(55) 25 call error(55)
26 return 26 return
27 endif 27 endif
28 if(istk(il1+1)*istk(il1+2).ne.1) then 28 if(istk(il1+1)*istk(il1+2).ne.1) then
29 err=1 29 err=1
30 call error(36) 30 call error(36)
31 return 31 return
32 endif 32 endif
33 n1=istk(il1+5)-1 33 n1=istk(il1+5)-1
34 il1=il1+6 34 il1=il1+6
35 il0=il1 35 il0=il1
36 call atome(istk(il1),n1,it1,is1) 36 call atome(istk(il1),n1,it1,is1)
37 if(symb.ne.bslash) call termf(istk(il1),n1,it1) 37 if(symb.ne.bslash) call termf(istk(il1),n1,it1)
38c 38c
39 il2=iadr(lstk(top)) 39 il2=iadr(lstk(top))
40 if(istk(il2).ne.10) then 40 if(istk(il2).ne.10) then
41 err=2 41 err=2
42 call error(55) 42 call error(55)
43 return 43 return
44 endif 44 endif
45 if(istk(il2+1)*istk(il2+2).ne.1) then 45 if(istk(il2+1)*istk(il2+2).ne.1) then
46 err=2 46 err=2
47 call error(36) 47 call error(36)
48 return 48 return
49 endif 49 endif
50 n2=istk(il2+5)-1 50 n2=istk(il2+5)-1
51 il2=il2+6 51 il2=il2+6
52 top=top-1 52 top=top-1
53c 53c
54 call atome(istk(il2),n2,it2,is2) 54 call atome(istk(il2),n2,it2,is2)
55 if(symb.ne.slash) call termf(istk(il2),n2,it2) 55 if(symb.ne.slash) call termf(istk(il2),n2,it2)
56 if (it2.ne.0) call factf(istk(il2),n2,it2) 56 if (it2.ne.0) call factf(istk(il2),n2,it2)
57 57
58c 58c
59 goto (2010,2020,2030,2040) it1+2*it2+1 59 goto (2010,2020,2030,2040) it1+2*it2+1
60c 60c
61c 2 expressions 61c 2 expressions
62 2010 continue 62 2010 continue
63 idec=0 63 idec=0
64 if(is1.ne.1) then 64 if(is1.ne.1) then
65 call icopy(n1,istk(il1),-1,istk(il1+1),-1) 65 call icopy(n1,istk(il1),-1,istk(il1+1),-1)
66 idec=1 66 idec=1
67 endif 67 endif
68 il0=il1 68 il0=il1
69 istk(il1)=lparen 69 istk(il1)=lparen
70 istk(il1+n1+idec)=rparen 70 istk(il1+n1+idec)=rparen
71 il1=il1+n1+idec+1 71 il1=il1+n1+idec+1
72 istk(il1)=symb 72 istk(il1)=symb
73 il1=il1+1 73 il1=il1+1
74 istk(il1)=lparen 74 istk(il1)=lparen
75 il1=il1+1 75 il1=il1+1
76 if(is2.eq.1) then 76 if(is2.eq.1) then
77 il2=il2+1 77 il2=il2+1
78 n2=n2-1 78 n2=n2-1
79 endif 79 endif
80 call icopy(n2,istk(il2),1,istk(il1),1) 80 call icopy(n2,istk(il2),1,istk(il1),1)
81 il1=il1+n2 81 il1=il1+n2
82 istk(il1)=rparen 82 istk(il1)=rparen
83 il1=il1+1 83 il1=il1+1
84 istk(il+5)=il1-il0+1 84 istk(il+5)=il1-il0+1
85 lstk(top+1)=sadr(il1) 85 lstk(top+1)=sadr(il1)
86 goto 9999 86 goto 9999
87 2020 continue 87 2020 continue
88c un atome et une expression 88c un atome et une expression
89 idec=abs(is1) 89 idec=abs(is1)
90 ipar=0 90 ipar=0
91 if(n1-idec.eq.1 .and.istk(il1+idec).eq.0) then 91 if(n1-idec.eq.1 .and.istk(il1+idec).eq.0) then
92 if(symb.eq.bslash) then 92 if(symb.eq.bslash) then
93 call error(27) 93 call error(27)
94 return 94 return
95 endif 95 endif
96 goto 9999 96 goto 9999
97 endif 97 endif
98 if(symb.ne.slash.and. 98 if(symb.ne.slash.and.
99 & ((n1-idec.eq.1 .and. istk(il1+idec).eq.1).or. 99 & ((n1-idec.eq.1 .and. istk(il1+idec).eq.1).or.
100 & (n1-idec.eq.5.and.iseye(istk(il1+idec))))) then 100 & (n1-idec.eq.5.and.iseye(istk(il1+idec))))) then
101c n1=n1-1 101c n1=n1-1
102 n1=idec 102 n1=idec
103 if(is1.eq.-1) then 103 if(is1.eq.-1) then
104 istk(il1+n1)=lparen 104 istk(il1+n1)=lparen
105 n1=n1+1 105 n1=n1+1
106 ipar=1 106 ipar=1
107 endif 107 endif
108 goto 2021 108 goto 2021
109 else 109 else
110 istk(il1+n1)=symb 110 istk(il1+n1)=symb
111 istk(il1+n1+1)=lparen 111 istk(il1+n1+1)=lparen
112 n1=n1+2 112 n1=n1+2
113 ipar=1 113 ipar=1
114 endif 114 endif
115 2021 if(is2.eq.1) then 115 2021 if(is2.eq.1) then
116 il2=il2+1 116 il2=il2+1
117 n2=n2-1 117 n2=n2-1
118 endif 118 endif
119 call icopy(n2,istk(il2),1,istk(il1+n1),1) 119 call icopy(n2,istk(il2),1,istk(il1+n1),1)
120 n1=n1+n2 120 n1=n1+n2
121 if(ipar.eq.1) then 121 if(ipar.eq.1) then
122 istk(il1+n1)=rparen 122 istk(il1+n1)=rparen
123 n1=n1+1 123 n1=n1+1
124 endif 124 endif
125 istk(il+5)=1+n1 125 istk(il+5)=1+n1
126 lstk(top+1)=sadr(il1+n1) 126 lstk(top+1)=sadr(il1+n1)
127 goto 9999 127 goto 9999
128c expr et atome 128c expr et atome
129 2030 continue 129 2030 continue
130 idec=abs(is2) 130 idec=abs(is2)
131 if(n2-idec.eq.1.and.istk(il2+idec).eq.0) then 131 if(n2-idec.eq.1.and.istk(il2+idec).eq.0) then
132 if(symb.eq.slash) then 132 if(symb.eq.slash) then
133 call error(27) 133 call error(27)
134 return 134 return
135 endif 135 endif
136 istk(il1)=0 136 istk(il1)=0
137 istk(il+5)=2 137 istk(il+5)=2
138 lstk(top+1)=sadr(il1+1) 138 lstk(top+1)=sadr(il1+1)
139 goto 9999 139 goto 9999
140 endif 140 endif
141 if(symb.ne.bslash.and.is2.ge.0 141 if(symb.ne.bslash.and.is2.ge.0
142 & .and.((n2-idec.eq.1.and.istk(il2+idec).eq.1) 142 & .and.((n2-idec.eq.1.and.istk(il2+idec).eq.1)
143 & .or.(n2-idec.eq.5.and.iseye(istk(il2+idec))))) then 143 & .or.(n2-idec.eq.5.and.iseye(istk(il2+idec))))) then
144 istk(il+5)=n1+1 144 istk(il+5)=n1+1
145 lstk(top+1)=sadr(il1+n1) 145 lstk(top+1)=sadr(il1+n1)
146 goto 9999 146 goto 9999
147 endif 147 endif
148 idec=0 148 idec=0
149 if(is1.ne.1) idec=idec+1 149 if(is1.ne.1) idec=idec+1
150 if(is2.lt.0) idec=idec+1 150 if(is2.lt.0) idec=idec+1
151 call icopy(n1,istk(il1),-1,istk(il1+idec),-1) 151 call icopy(n1,istk(il1),-1,istk(il1+idec),-1)
152 il0=il1 152 il0=il1
153 ill=il1 153 ill=il1
154 if(is2.lt.0) then 154 if(is2.lt.0) then
155 istk(ill)=minus 155 istk(ill)=minus
156 ill=ill+1 156 ill=ill+1
157 endif 157 endif
158 istk(ill)=lparen 158 istk(ill)=lparen
159 istk(il1+n1+idec)=rparen 159 istk(il1+n1+idec)=rparen
160 il1=il1+n1+idec+1 160 il1=il1+n1+idec+1
161 if(symb.ne.bslash.and.is2.eq.-1.and. 161 if(symb.ne.bslash.and.is2.eq.-1.and.
162 & ((n2.eq.2.and.istk(il2+1).eq.1).or. 162 & ((n2.eq.2.and.istk(il2+1).eq.1).or.
163 & (n2.eq.6.and.iseye(istk(il2+1))))) goto 2031 163 & (n2.eq.6.and.iseye(istk(il2+1))))) goto 2031
164 istk(il1)=symb 164 istk(il1)=symb
165 il1=il1+1 165 il1=il1+1
166 if(is2.ne.0) then 166 if(is2.ne.0) then
167 il2=il2+1 167 il2=il2+1
168 n2=n2-1 168 n2=n2-1
169 endif 169 endif
170 call icopy(n2,istk(il2),1,istk(il1),1) 170 call icopy(n2,istk(il2),1,istk(il1),1)
171 il1=il1+n2 171 il1=il1+n2
172 2031 istk(il+5)=il1-il0+1 172 2031 istk(il+5)=il1-il0+1
173 lstk(top+1)=sadr(il1) 173 lstk(top+1)=sadr(il1)
174 goto 9999 174 goto 9999
175c atome et atome 175c atome et atome
176 2040 continue 176 2040 continue
177 177
178 idec1=abs(is1) 178 idec1=abs(is1)
179 if(n1-idec1.eq.1.and.istk(il1+idec1).eq.0) then 179 if(n1-idec1.eq.1.and.istk(il1+idec1).eq.0) then
180 if(symb.eq.bslash) then 180 if(symb.eq.bslash) then
181 call error(27) 181 call error(27)
182 return 182 return
183 endif 183 endif
184 goto 9999 184 goto 9999
185 endif 185 endif
186 idec2=abs(is2) 186 idec2=abs(is2)
187 if(n2-idec2.eq.1.and.istk(il2+idec2).eq.0) then 187 if(n2-idec2.eq.1.and.istk(il2+idec2).eq.0) then
188 if(symb.eq.slash) then 188 if(symb.eq.slash) then
189 call error(27) 189 call error(27)
190 return 190 return
191 endif 191 endif
192 istk(il1)=0 192 istk(il1)=0
193 istk(il+5)=2 193 istk(il+5)=2
194 lstk(top+1)=sadr(il1+1) 194 lstk(top+1)=sadr(il1+1)
195 goto 9999 195 goto 9999
196 endif 196 endif
197 if(symb.eq.star) then 197 if(symb.eq.star) then
198 if(isnum(istk(il1+idec1),n1-idec1,inum1).and. 198 if(isnum(istk(il1+idec1),n1-idec1,inum1).and.
199 & isnum(istk(il2+idec2),n2-idec2,inum2)) then 199 & isnum(istk(il2+idec2),n2-idec2,inum2)) then
200 if(is1.eq.-1) inum1=-inum1 200 if(is1.eq.-1) inum1=-inum1
201 if(is2.eq.-1) inum2=-inum2 201 if(is2.eq.-1) inum2=-inum2
202 inum=inum1*inum2 202 inum=inum1*inum2
203 call intstr(inum,istk(il1),ni,0) 203 call intstr(inum,istk(il1),ni,0)
204 il1=il1+ni 204 il1=il1+ni
205 istk(il+5)=ni+1 205 istk(il+5)=ni+1
206 lstk(top+1)=sadr(il1) 206 lstk(top+1)=sadr(il1)
207 goto 9999 207 goto 9999
208 endif 208 endif
209 endif 209 endif
210 is=blanc 210 is=blanc
211 if(is1.eq.-1.and.is2.ge.0 .or. 211 if(is1.eq.-1.and.is2.ge.0 .or.
212 + is2.eq.-1.and.is1.ge.0) is=minus 212 + is2.eq.-1.and.is1.ge.0) is=minus
213 if(symb.ne.slash.and. 213 if(symb.ne.slash.and.
214 & ((n1-abs(is1).eq.1.and.istk(il1+abs(is1)).eq.1).or. 214 & ((n1-abs(is1).eq.1.and.istk(il1+abs(is1)).eq.1).or.
215 & (n1-abs(is1).eq.5.and.iseye(istk(il1+abs(is1))))) ) then 215 & (n1-abs(is1).eq.5.and.iseye(istk(il1+abs(is1))))) ) then
216 if(is.eq.minus) then 216 if(is.eq.minus) then
217 istk(il1)=is 217 istk(il1)=is
218 il1=il1+1 218 il1=il1+1
219 endif 219 endif
220 call icopy(n2-abs(is2),istk(il2+abs(is2)),1,istk(il1),1) 220 call icopy(n2-abs(is2),istk(il2+abs(is2)),1,istk(il1),1)
221 il1=il1+n2-abs(is2) 221 il1=il1+n2-abs(is2)
222 istk(il+5)=il1-il0+1 222 istk(il+5)=il1-il0+1
223 lstk(top+1)=sadr(il1+1) 223 lstk(top+1)=sadr(il1+1)
224 goto 9999 224 goto 9999
225 endif 225 endif
226 idec1=0 226 idec1=0
227 idec=0 227 idec=0
228 if(is1.eq.-1.and.is2.eq.-1) idec1=1 228 if(is1.eq.-1.and.is2.eq.-1) idec1=1
229 if(is.eq.minus.and.is1.eq.0) then 229 if(is.eq.minus.and.is1.eq.0) then
230 idec=1 230 idec=1
231 call icopy(n1,istk(il1),-1,istk(il1+idec),-1) 231 call icopy(n1,istk(il1),-1,istk(il1+idec),-1)
232 n1=n1+1 232 n1=n1+1
233 endif 233 endif
234 if(idec1.ne.0) then 234 if(idec1.ne.0) then
235 call icopy(n1-1,istk(il1+idec+1),1,istk(il1+idec),1) 235 call icopy(n1-1,istk(il1+idec+1),1,istk(il1+idec),1)
236 n1=n1-1 236 n1=n1-1
237 endif 237 endif
238 il0=il1 238 il0=il1
239 ill=il1 239 ill=il1
240 if(is.eq.minus) then 240 if(is.eq.minus) then
241 istk(ill)=minus 241 istk(ill)=minus
242 ill=ill+1 242 ill=ill+1
243 endif 243 endif
244 il1=il1+n1 244 il1=il1+n1
245 if(symb.ne.bslash.and. 245 if(symb.ne.bslash.and.
246 & ((n2-abs(is2).eq.1.and.istk(il2+abs(is2)).eq.1).or. 246 & ((n2-abs(is2).eq.1.and.istk(il2+abs(is2)).eq.1).or.
247 & (n2-abs(is2).eq.5.and.iseye(istk(il2+abs(is2)))))) goto 2041 247 & (n2-abs(is2).eq.5.and.iseye(istk(il2+abs(is2)))))) goto 2041
248 istk(il1)=symb 248 istk(il1)=symb
249 il1=il1+1 249 il1=il1+1
250 if(is2.ne.0) then 250 if(is2.ne.0) then
251 il2=il2+1 251 il2=il2+1
252 n2=n2-1 252 n2=n2-1
253 endif 253 endif
254 call icopy(n2,istk(il2),1,istk(il1),1) 254 call icopy(n2,istk(il2),1,istk(il1),1)
255 il1=il1+n2 255 il1=il1+n2
256 2041 istk(il+5)=il1-il0+1 256 2041 istk(il+5)=il1-il0+1
257 lstk(top+1)=sadr(il1) 257 lstk(top+1)=sadr(il1)
258 goto 9999 258 goto 9999
259c 259c
260 9999 return 260 9999 return
261 end 261 end
262 \ No newline at end of file 262 \ No newline at end of file
diff --git a/scilab/modules/symbolic/sci_gateway/fortran/sci_rdivf.f b/scilab/modules/symbolic/sci_gateway/fortran/sci_rdivf.f
index dfb50c6..205beeb 100644
--- a/scilab/modules/symbolic/sci_gateway/fortran/sci_rdivf.f
+++ b/scilab/modules/symbolic/sci_gateway/fortran/sci_rdivf.f
@@ -1,261 +1,261 @@
1c -------------------------- 1c --------------------------
2c Copyright INRIA 2c Copyright INRIA
3c -------------------------- 3c --------------------------
4c 4c
5 subroutine scirdivf(fname) 5 subroutine scirdivf(fname)
6c ---------------------------- 6c ----------------------------
7 character*(*) fname 7 character*(*) fname
8 include 'stack.h' 8 include 'stack.h'
9 9
10 logical iseye,isnum 10 logical iseye,isnum
11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb 11 integer lparen,rparen,star,plus,minus,blanc,slash,bslash,symb
12 integer iadr,sadr 12 integer iadr,sadr
13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/ 13 data lparen/41/,rparen/42/,star/47/,plus/45/,minus/46/,blanc/40/
14 data slash/48/ ,bslash/49/ 14 data slash/48/ ,bslash/49/
15 15
16 iadr(l)=l+l-1 16 iadr(l)=l+l-1
17 sadr(l)=(l/2)+1 17 sadr(l)=(l/2)+1
18 18
19 symb=slash 19 symb=slash
20 20
21 il1=iadr(lstk(top-1)) 21 il1=iadr(lstk(top-1))
22 il=il1 22 il=il1
23 if(istk(il1).ne.10) then 23 if(istk(il1).ne.10) then
24 err=1 24 err=1
25 call error(55) 25 call error(55)
26 return 26 return
27 endif 27 endif
28 if(istk(il1+1)*istk(il1+2).ne.1) then 28 if(istk(il1+1)*istk(il1+2).ne.1) then
29 err=1 29 err=1
30 call error(36) 30 call error(36)
31 return 31 return
32 endif 32 endif
33 n1=istk(il1+5)-1 33 n1=istk(il1+5)-1
34 il1=il1+6 34 il1=il1+6
35 il0=il1 35 il0=il1
36 call atome(istk(il1),n1,it1,is1) 36 call atome(istk(il1),n1,it1,is1)
37 if(symb.ne.bslash) call termf(istk(il1),n1,it1) 37 if(symb.ne.bslash) call termf(istk(il1),n1,it1)
38c 38c
39 il2=iadr(lstk(top)) 39 il2=iadr(lstk(top))
40 if(istk(il2).ne.10) then 40 if(istk(il2).ne.10) then
41 err=2 41 err=2
42 call error(55) 42 call error(55)
43 return 43 return
44 endif 44 endif
45 if(istk(il2+1)*istk(il2+2).ne.1) then 45 if(istk(il2+1)*istk(il2+2).ne.1) then
46 err=2 46 err=2
47 call error(36) 47 call error(36)
48 return 48 return
49 endif 49 endif
50 n2=istk(il2+5)-1 50 n2=istk(il2+5)-1
51 il2=il2+6 51 il2=il2+6
52 top=top-1 52 top=top-1
53c 53c
54 call atome(istk(il2),n2,it2,is2) 54 call atome(istk(il2),n2,it2,is2)
55 if(symb.ne.slash) call termf(istk(il2),n2,it2) 55 if(symb.ne.slash) call termf(istk(il2),n2,it2)
56 if (it2.ne.0) call factf(istk(il2),n2,it2) 56 if (it2.ne.0) call factf(istk(il2),n2,it2)
57 57
58c 58c
59 goto (2010,2020,2030,2040) it1+2*it2+1 59 goto (2010,2020,2030,2040) it1+2*it2+1
60c 60c
61c 2 expressions 61c 2 expressions
62 2010 continue 62 2010 continue
63 idec=0 63 idec=0
64 if(is1.ne.1) then 64 if(is1.ne.1) then
65 call icopy(n1,istk(il1),-1,istk(il1+1),-1) 65 call icopy(n1,istk(il1),-1,istk(il1+1),-1)
66 idec=1 66 idec=1
67 endif 67 endif
68 il0=il1 68 il0=il1
69 istk(il1)=lparen 69 istk(il1)=lparen
70 istk(il1+n1+idec)=rparen 70 istk(il1+n1+idec)=rparen
71 il1=il1+n1+idec+1 71 il1=il1+n1+idec+1
72 istk(il1)=symb 72 istk(il1)=symb
73 il1=il1+1 73 il1=il1+1
74 istk(il1)=lparen 74 istk(il1)=lparen
75 il1=il1+1 75 il1=il1+1
76 if(is2.eq.1) then 76 if(is2.eq.1) then
77 il2=il2+1 77 il2=il2+1
78 n2=n2-1 78 n2=n2-1
79 endif 79 endif
80 call icopy(n2,istk(il2),1,istk(il1),1) 80 call icopy(n2,istk(il2),1,istk(il1),1)
81 il1=il1+n2 81 il1=il1+n2
82 istk(il1)=rparen 82 istk(il1)=rparen
83 il1=il1+1 83 il1=il1+1
84 istk(il+5)=il1-il0+1 84 istk(il+5)=il1-il0+1
85 lstk(top+1)=sadr(il1) 85 lstk(top+1)=sadr(il1)
86 goto 9999 86 goto 9999
87 2020 continue 87 2020 continue
88c un atome et une expression 88c un atome et une expression
89 idec=abs(is1) 89 idec=abs(is1)
90 ipar=0 90 ipar=0
91 if(n1-idec.eq.1 .and.istk(il1+idec).eq.0) then 91 if(n1-idec.eq.1 .and.istk(il1+idec).eq.0) then
92 if(symb.eq.bslash) then 92 if(symb.eq.bslash) then
93 call error(27) 93 call error(27)
94 return 94 return
95 endif 95 endif
96 goto 9999 96 goto 9999
97 endif 97 endif
98 if(symb.ne.slash.and. 98 if(symb.ne.slash.and.
99 & ((n1-idec.eq.1 .and. istk(il1+idec).eq.1).or. 99 & ((n1-idec.eq.1 .and. istk(il1+idec).eq.1).or.
100 & (n1-idec.eq.5.and.iseye(istk(il1+idec))))) then 100 & (n1-idec.eq.5.and.iseye(istk(il1+idec))))) then
101c n1=n1-1 101c n1=n1-1
102 n1=idec 102 n1=idec
103 if(is1.eq.-1) then 103 if(is1.eq.-1) then
104 istk(il1+n1)=lparen 104 istk(il1+n1)=lparen
105 n1=n1+1 105 n1=n1+1
106 ipar=1 106 ipar=1
107 endif 107 endif
108 goto 2021 108 goto 2021
109 else 109 else
110 istk(il1+n1)=symb 110 istk(il1+n1)=symb
111 istk(il1+n1+1)=lparen 111 istk(il1+n1+1)=lparen
112 n1=n1+2 112 n1=n1+2
113 ipar=1 113 ipar=1
114 endif 114 endif
115 2021 if(is2.eq.1) then 115 2021 if(is2.eq.1) then
116 il2=il2+1 116 il2=il2+1
117 n2=n2-1 117 n2=n2-1
118 endif 118 endif
119 call icopy(n2,istk(il2),1,istk(il1+n1),1) 119 call icopy(n2,istk(il2),1,istk(il1+n1),1)
120 n1=n1+n2 120 n1=n1+n2
121 if(ipar.eq.1) then 121 if(ipar.eq.1) then
122 istk(il1+n1)=rparen 122 istk(il1+n1)=rparen
123 n1=n1+1 123 n1=n1+1
124 endif 124 endif
125 istk(il+5)=1+n1 125 istk(il+5)=1+n1
126 lstk(top+1)=sadr(il1+n1) 126 lstk(top+1)=sadr(il1+n1)
127 goto 9999 127 goto 9999
128c expr et atome 128c expr et atome
129 2030 continue 129 2030 continue
130 idec=abs(is2) 130 idec=abs(is2)
131 if(n2-idec.eq.1.and.istk(il2+idec).eq.0) then 131 if(n2-idec.eq.1.and.istk(il2+idec).eq.0) then
132 if(symb.eq.slash) then 132 if(symb.eq.slash) then
133 call error(27) 133 call error(27)
134 return 134 return
135 endif 135 endif
136 istk(il1)=0 136 istk(il1)=0
137 istk(il+5)=2 137 istk(il+5)=2
138 lstk(top+1)=sadr(il1+1) 138 lstk(top+1)=sadr(il1+1)
139 goto 9999 139 goto 9999
140 endif 140 endif
141 if(symb.ne.bslash.and.is2.ge.0 141 if(symb.ne.bslash.and.is2.ge.0
142 & .and.((n2-idec.eq.1.and.istk(il2+idec).eq.1) 142 & .and.((n2-idec.eq.1.and.istk(il2+idec).eq.1)
143 & .or.(n2-idec.eq.5.and.iseye(istk(il2+idec))))) then 143 & .or.(n2-idec.eq.5.and.iseye(istk(il2+idec))))) then
144 istk(il+5)=n1+1 144 istk(il+5)=n1+1
145 lstk(top+1)=sadr(il1+n1) 145 lstk(top+1)=sadr(il1+n1)
146 goto 9999 146 goto 9999
147 endif 147 endif
148 idec=0 148 idec=0
149 if(is1.ne.1) idec=idec+1 149 if(is1.ne.1) idec=idec+1
150 if(is2.lt.0) idec=idec+1 150 if(is2.lt.0) idec=idec+1
151 call icopy(n1,istk(il1),-1,istk(il1+idec),-1) 151 call icopy(n1,istk(il1),-1,istk(il1+idec),-1)
152 il0=il1 152 il0=il1
153 ill=il1 153 ill=il1
154 if(is2.lt.0) then 154 if(is2.lt.0) then
155 istk(ill)=minus 155 istk(ill)=minus
156 ill=ill+1 156 ill=ill+1
157 endif 157 endif
158 istk(ill)=lparen 158 istk(ill)=lparen
159 istk(il1+n1+idec)=rparen 159 istk(il1+n1+idec)=rparen
160 il1=il1+n1+idec+1 160 il1=il1+n1+idec+1
161 if(symb.ne.bslash.and.is2.eq.-1.and. 161 if(symb.ne.bslash.and.is2.eq.-1.and.
162 & ((n2.eq.2.and.istk(il2+1).eq.1).or. 162 & ((n2.eq.2.and.istk(il2+1).eq.1).or.
163 & (n2.eq.6.and.iseye(istk(il2+1))))) goto 2031 163 & (n2.eq.6.and.iseye(istk(il2+1))))) goto 2031
164 istk(il1)=symb 164 istk(il1)=symb
165 il1=il1+1 165 il1=il1+1
166 if(is2.ne.0) then 166 if(is2.ne.0) then
167 il2=il2+1 167 il2=il2+1
168 n2=n2-1 168 n2=n2-1
169 endif 169 endif
170 call icopy(n2,istk(il2),1,istk(il1),1) 170 call icopy(n2,istk(il2),1,istk(il1),1)
171 il1=il1+n2 171 il1=il1+n2
172 2031 istk(il+5)=il1-il0+1 172 2031 istk(il+5)=il1-il0+1
173 lstk(top+1)=sadr(il1) 173 lstk(top+1)=sadr(il1)
174 goto 9999 174 goto 9999
175c atome et atome 175c atome et atome
176 2040 continue 176 2040 continue
177 177
178 idec1=abs(is1) 178 idec1=abs(is1)
179 if(n1-idec1.eq.1.and.istk(il1+idec1).eq.0) then 179 if(n1-idec1.eq.1.and.istk(il1+idec1).eq.0) then
180 if(symb.eq.bslash) then 180 if(symb.eq.bslash) then
181 call error(27) 181 call error(27)
182 return 182 return
183 endif 183 endif
184 goto 9999 184 goto 9999
185 endif 185 endif
186 idec2=abs(is2) 186 idec2=abs(is2)
187 if(n2-idec2.eq.1.and.istk(il2+idec2).eq.0) then 187 if(n2-idec2.eq.1.and.istk(il2+idec2).eq.0) then
188 if(symb.eq.slash) then 188 if(symb.eq.slash) then
189 call error(27) 189 call error(27)
190 return 190 return
191 endif 191 endif
192 istk(il1)=0 192 istk(il1)=0
193 istk(il+5)=2 193 istk(il+5)=2
194 lstk(top+1)=sadr(il1+1) 194 lstk(top+1)=sadr(il1+1)
195 goto 9999 195 goto 9999
196 endif 196 endif
197 if(symb.eq.star) then 197 if(symb.eq.star) then
198 if(isnum(istk(il1+idec1),n1-idec1,inum1).and. 198 if(isnum(istk(il1+idec1),n1-idec1,inum1).and.
199 & isnum(istk(il2+idec2),n2-idec2,inum2)) then 199 & isnum(istk(il2+idec2),n2-idec2,inum2)) then
200 if(is1.eq.-1) inum1=-inum1 200 if(is1.eq.-1) inum1=-inum1
201 if(is2.eq.-1) inum2=-inum2 201 if(is2.eq.-1) inum2=-inum2
202 inum=inum1*inum2 202 inum=inum1*inum2
203 call intstr(inum,istk(il1),ni,0) 203 call intstr(inum,istk(il1),ni,0)
204 il1=il1+ni 204 il1=il1+ni
205 istk(il+5)=ni+1 205 istk(il+5)=ni+1
206 lstk(top+1)=sadr(il1) 206 lstk(top+1)=sadr(il1)
207 goto 9999 207 goto 9999
208 endif 208 endif
209 endif 209 endif
210 is=blanc 210 is=blanc
211 if(is1.eq.-1.and.is2.ge.0 .or. 211 if(is1.eq.-1.and.is2.ge.0 .or.
212 + is2.eq.-1.and.is1.ge.0) is=minus 212 + is2.eq.-1.and.is1.ge.0) is=minus
213 if(symb.ne.slash.and. 213 if(symb.ne.slash.and.
214 & ((n1-abs(is1).eq.1.and.istk(il1+abs(is1)).eq.1).or. 214 & ((n1-abs(is1).eq.1.and.istk(il1+abs(is1)).eq.1).or.
215 & (n1-abs(is1).eq.5.and.iseye(istk(il1+abs(is1))))) ) then 215 & (n1-abs(is1).eq.5.and.iseye(istk(il1+abs(is1))))) ) then
216 if(is.eq.minus) then 216 if(is.eq.minus) then
217 istk(il1)=is 217 istk(il1)=is
218 il1=il1+1 218 il1=il1+1
219 endif 219 endif
220 call icopy(n2-abs(is2),istk(il2+abs(is2)),1,istk(il1),1) 220 call icopy(n2-abs(is2),istk(il2+abs(is2)),1,istk(il1),1)
221 il1=il1+n2-abs(is2) 221 il1=il1+n2-abs(is2)
222 istk(il+5)=il1-il0+1 222 istk(il+5)=il1-il0+1
223 lstk(top+1)=sadr(il1+1) 223 lstk(top+1)=sadr(il1+1)
224 goto 9999 224 goto 9999
225 endif 225 endif
226 idec1=0 226 idec1=0
227 idec=0 227 idec=0
228 if(is1.eq.-1.and.is2.eq.-1) idec1=1 228 if(is1.eq.-1.and.is2.eq.-1) idec1=1
229 if(is.eq.minus.and.is1.eq.0) then 229 if(is.eq.minus.and.is1.eq.0) then
230 idec=1 230 idec=1
231 call icopy(n1,istk(il1),-1,istk(il1+idec),-1) 231 call icopy(n1,istk(il1),-1,istk(il1+idec),-1)
232 n1=n1+1 232 n1=n1+1
233 endif 233 endif
234 if(idec1.ne.0) then 234 if(idec1.ne.0) then
235 call icopy(n1-1,istk(il1+idec+1),1,istk(il1+idec),1) 235 call icopy(n1-1,istk(il1+idec+1),1,istk(il1+idec),1)
236 n1=n1-1 236 n1=n1-1
237 endif 237 endif
238 il0=il1 238 il0=il1
239 ill=il1 239 ill=il1
240 if(is.eq.minus) then 240 if(is.eq.minus) then
241 istk(ill)=minus 241 istk(ill)=minus
242 ill=ill+1 242 ill=ill+1
243 endif 243 endif
244 il1=il1+n1 244 il1=il1+n1
245 if(symb.ne.bslash.and. 245 if(symb.ne.bslash.and.
246 & ((n2-abs(is2).eq.1.and.istk(il2+abs(is2)).eq.1).or. 246 & ((n2-abs(is2).eq.1.and.istk(il2+abs(is2)).eq.1).or.
247 & (n2-abs(is2).eq.5.and.iseye(istk(il2+abs(is2)))))) goto 2041 247 & (n2-abs(is2).eq.5.and.iseye(istk(il2+abs(is2)))))) goto 2041
248 istk(il1)=symb 248 istk(il1)=symb
249 il1=il1+1 249 il1=il1+1
250 if(is2.ne.0) then 250 if(is2.ne.0) then
251 il2=il2+1 251 il2=il2+1
252 n2=n2-1 252 n2=n2-1
253 endif 253 endif
254 call icopy(n2,istk(il2),1,istk(il1),1) 254 call icopy(n2,istk(il2),1,istk(il1),1)
255 il1=il1+n2 255 il1=il1+n2
256 2041 istk(il+5)=il1-il0+1 256 2041 istk(il+5)=il1-il0+1
257 lstk(top+1)=sadr(il1) 257 lstk(top+1)=sadr(il1)
258 goto 9999 258 goto 9999
259c 259c
260 9999 return 260 9999 return
261 end 261 end