File: blktit.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 (33 lines) | stat: -rw-r--r-- 902 bytes parent folder | download | duplicates (4) 
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
 
      subroutine blktit(lunit,k1,k2,io)
c!purpose
c     generates and outputs a matrix bloc title line of the form :
c     <empty line>
c            column k1 to k2
c     <empty line>
c!
c     Copyright INRIA
      integer k1,k2,io
c
      character*4 fmt2
      character*70 fmt1,cw
c
c     number of digit necessary to represent k2
      lft=int(log10(dble(k2)+0.4))+1
      write(fmt2,'(''i'',i2)') lft

      call basout(io,lunit,' ')
      if(io.eq.-1) return

      if(k1.eq.k2) then
         fmt1='(''         column '','//fmt2//')'
         write(cw(1:16+lft),fmt1) k1
         call basout(io,lunit,cw(1:16+lft))
      else
         fmt1='(''         column '','//fmt2//','' to '','//fmt2//')'
         write(cw(1:(20+2*lft)),fmt1) k1,k2
         call basout(io,lunit,cw(1:(20+2*lft)))
      endif
      if (io.eq.-1) return
      call basout(io,lunit,' ')
      if (io.eq.-1) return
      end