359e844c1f2ec7a70b99130be4b12594c9bff580
[scilab.git] / scilab / modules / core / sci_gateway / fortran / sci_f_clear.f
1 c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 c Copyright (C) INRIA
3
4 c This file must be used under the terms of the CeCILL.
5 c This source file is licensed as described in the file COPYING, which
6 c you should have received as part of this distribution.  The terms
7 c are also available at    
8 c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
9       subroutine intclear(fname)
10       include 'stack.h'
11 c     
12       parameter (nz3=nsiz-3,nz2=nsiz-2)
13       character*(*) fname
14       integer top0,id(nsiz)
15       logical getsmat,checkval,checklhs
16       integer iadr
17       integer a, blank,percen,helps(nsiz)
18
19
20       data a/10/,blank/40/,percen/56/
21       data helps /353243448,673717273,nz2*673720360/
22       
23       iadr(l)=l+l-1
24
25 c
26       if(.not.checklhs(fname,1,1)) return
27
28       if(rhs.le.0) then
29          if (macr.ne.0 .or. paus.ne.0) then
30             if(rstk(pt-2).eq.909) then
31 c     .     clear within an exec'd macro
32                goto 01
33             endif
34 c     .     clear within a macro, an execstr, an exec or a pause
35             k = lpt(1) - (13+nsiz)
36             if(lin(k+7).ne.0.and.istk(lin(k+6)).eq.10) goto 02
37 c     .     clear within a macro, an exec or a pause
38             bot = min(bbot,lin(k+5))
39             goto 02
40          endif
41
42  01      continue
43 c     .  clear all variable
44
45 c     .  preserve %help variable
46          i1=bbot
47          fin=-1
48          call stackg(helps)
49          if(err.gt.0) return
50          if (fin.gt.0) i1=min(fin,i1)
51
52          fin=0
53          call stackg(helps)
54          if(err.gt.0) return
55          ih=fin
56
57          fin=0
58          is=fin
59          bot = bbot 
60          if(ih.eq.-1) then
61             call stackp(helps,0)
62             if(err.gt.0) return
63          endif
64  02      top=top+1
65          il = iadr(lstk(top))
66          istk(il) = 0
67          lstk(top+1) = lstk(top) + 1
68          return
69       endif
70      
71       top0=top
72       do 10 k=1,rhs
73          if(.not.getsmat(fname,top0,top,m,n,1,1,lr,nlr)) return
74          if(.not.checkval(fname,m*n,1)) return
75          if(nlr.eq.0) then
76             top=top-1
77             goto 10
78          endif
79 c        . check for valid variable name
80          do 05 i=0,nlr-1
81             ic=abs(istk(lr+i))
82             if((ic.gt.blank.and.(i.gt.0.and.ic.eq.percen)).or.
83      $           (i.eq.0.and.ic.lt.a)) then
84                err=rhs+1-k
85                call error(248)
86                return
87             endif
88  05      continue
89          call namstr(id,istk(lr),nlr,0)
90          il = iadr(lstk(top))
91          istk(il) = 0
92          lstk(top+1) = lstk(top) + 1
93          rhs = 0
94          call stackp(id,0)
95          if (err .gt. 0.or.err1.gt.0) return
96          fin = 1
97  10   continue
98       top=top+1
99       il = iadr(lstk(top))
100       istk(il) = 0
101       lstk(top+1) = lstk(top) + 1
102       end
103