← Back to branch summary

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

« back to all changes in this revision

Viewing changes to routines/poly/strdsp.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/poly/strdsp.f
 
1
      subroutine strdsp(mat,d,lig,col,ll,lunit,iw,cw)
 
2
c!but 
 
3
c     
 
4
c     Cette subroutine fait le display d'une matrice de chaines de 
 
5
c     caracteres donnes par des codes entiers.
 
6
c     
 
7
c     La subroutine qui fait la conversion des codes entier en caracteres
 
8
c     est cvstr.
 
9
c     
 
10
c!Sequence d'appel:
 
11
c     
 
12
c     call strdsp(mat,d,lig,col,ll,lunit,iw,cw)
 
13
c     
 
14
c!Parametres:
 
15
c     
 
16
c     mat: matrice entiere, contenant les codes des caracateres de 
 
17
c     l'ensemble de la matrice de chaine
 
18
c     
 
19
c     d: matrice entiere, elle indique les deplacement des
 
20
c     adresses d'implantation par rapport au debut de mat.
 
21
c     
 
22
c     lig: entier, nombre de lignes de mat.
 
23
c     
 
24
c     col: entier, nombre de colonnes de mat.
 
25
c     
 
26
c     ll: entier, lleur de la ligne de dloyement.
 
27
c     
 
28
c     lunit: entier, indique l'etiquette logique du dispositif
 
29
c     de sortie.
 
30
c     
 
31
c     iw: vecteur entier de longueur col. Zone de travail.
 
32
c     
 
33
c     cw: caracter de longueur egale  a ll
 
34
c     
 
35
c!auteur:
 
36
c     s Steer (inria), 18sept.1985. corrige 1992
 
37
c!    
 
38
c     
 
39
c     Copyright INRIA
 
40
      integer mat(*),d(*),lig,col,ll,lunit,iw(*)
 
41
      character cw*(*),dl*1
 
42
      integer lines,sl,sk,c1,nind
 
43
c     
 
44
      data nind/5/
 
45
c     
 
46
      dl=' '
 
47
      if(lig*col.gt.1) dl='!'
 
48
c     
 
49
      lcol=1
 
50
      lines=0
 
51
      lbloc=lcol+col-1
 
52
      nbloc=1
 
53
      iw(lbloc+nbloc)=col
 
54
      sk=0
 
55
c     
 
56
c     cas d'une matrice vide
 
57
      if (col.eq.0.or.lig.eq.0) return
 
58
c     
 
59
      l=1
 
60
      k0=1
 
61
      do 11 k=1,col
 
62
         sl=0
 
63
         iw(k)=0
 
64
         do 10 i=1,lig
 
65
            lgh=d(l+1)-d(l)+2
 
66
            iw(k)=max(iw(k),lgh)
 
67
            sl=sl+(lgh/(ll-2))+1
 
68
            l=l+1
 
69
 10      continue
 
70
         sk=sk+iw(k)
 
71
         if(sk.gt.ll-2) then
 
72
            if(k.eq.k0) then
 
73
               iw(lbloc+nbloc)=k
 
74
               sk=0
 
75
               k0=k+1
 
76
            else
 
77
               iw(lbloc+nbloc)=k-1
 
78
               sk=iw(k)
 
79
               k0=k
 
80
            endif
 
81
            nbloc=nbloc+1
 
82
            iw(lbloc+nbloc)=col
 
83
c     lines=lines+sl+lig+2
 
84
         endif
 
85
 11   continue
 
86
      nbloc=min(nbloc,col)
 
87
c     
 
88
c     
 
89
      k1=1
 
90
      do 70 ib=1,nbloc
 
91
         k2=iw(lbloc+ib)
 
92
         ll1=0
 
93
         if(nbloc.ne.1) then
 
94
            call blktit(lunit,k1,k2,io)
 
95
            if (io.eq.-1) goto 99
 
96
         endif
 
97
c     
 
98
         cw(1:1)=dl
 
99
         c1=2
 
100
c     
 
101
         do 60 l=1,lig
 
102
            l1=c1
 
103
            do 50 k=k1,k2
 
104
               l0=l1
 
105
               ldg=(k-1)*lig+l
 
106
               lp=d(ldg)
 
107
               np=d(ldg+1)-d(ldg)
 
108
c     
 
109
               ll1=0
 
110
               indent=0
 
111
 40            np1=min(np,ll-2-indent)
 
112
               call cvstr(np1,mat(lp),cw(l1:l1+np1-1),1)
 
113
               l1=l1+np1
 
114
               if(np1.ne.np) then
 
115
                  ll1=ll
 
116
                  if(l1.le.ll-1) cw(l1:ll-1)=' '
 
117
                  cw(ll:ll)=dl
 
118
                  call basout(io,lunit,cw(c1-1:ll))
 
119
                  if(io.eq.-1) goto 99
 
120
                  cw(c1:c1+nind-1)=' '
 
121
                  l1=c1+nind
 
122
                  indent=nind
 
123
                  lp=lp+np1
 
124
                  np=np-np1
 
125
                  if(np.gt.0) goto 40
 
126
               endif
 
127
               il=min(iw(k),ll-2)
 
128
               if(l0+il.ge.l1) then
 
129
                  cw(l1:l0+il)=' '
 
130
                  l1=l0+il
 
131
               endif
 
132
 50         continue
 
133
            if(ll1.eq.ll) then
 
134
               if(l1.le.ll) then
 
135
                  cw(l1:ll)=' '
 
136
                  l1=ll
 
137
               endif
 
138
            endif
 
139
            cw(l1:l1)=dl
 
140
            call basout(io,lunit,cw(c1-1:l1))
 
141
            if(io.eq.-1) goto 99
 
142
            if(l.ne.lig) then
 
143
               cw(c1:l1-1)='  '
 
144
               call basout(io,lunit,cw(c1-1:l1))
 
145
               if(io.eq.-1) goto 99
 
146
            endif
 
147
 60      continue
 
148
         k1=k2+1
 
149
 70   continue
 
150
c     
 
151
 99   return
 
152
 110  format('(i',i2,')')
 
153
 120  format('(f',i2,'.',i2,')')
 
154
 130  format('(d',i2,'.',i2,')')
 
155
      end