Blame view

fvn_fnlib/s9comp.f 1.36 KB
38581db0c   daniau   git-svn-id: https...
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
34
35
36
37
38
39
40
        subroutine s9comp (nspace, fmt, nwd)
  c august 1979 edition. w. fullerton, c3, los alamos scientific lab.
  c
  c s9comp returns a format in array fmt suitable for writing a header
  c that contains the 6-character function names at the top of two columns
  c of function values.  the position of these names depends on nspace,
  c the number of spaces beyond the carriage control column to skip.
  c
  c the format returned in fmt is
  c          (nspace x, nwd a nch, 26x, 1hd, nwd a nch)
  c where  nwd = the number of integer words required to hold 6 characters
  c   and  nch = the number of characters in one integer word.
  c
  c s9comp also returns nwd, the number of integer words required to
  c hold 6 characters.
  c
        integer fmt(23), f(23)
        external i1mach
        data f(1), f(2), f(3), f(4), f(5) / 1h(, 0, 0, 1hx, 1h, /
        data f(6), f(7), f(8), f(9), f(10) / 0, 1ha, 0, 0, 1h, /
        data f(11), f(12), f(13), f(14), f(15) / 1h2, 1h6, 1hx, 1h,, 1h1 /
        data f(16), f(17), f(18), f(19), f(20) / 2hhd, 1h , 1h,, 0, 1ha /
        data f(21), f(22), f(23) / 0, 0, 1h) /
  c
        nch = i1mach(6)
        nwd = (6 + nch - 1) / nch
  c
        do 10 i=1,23
          fmt(i) = f(i)
   10   continue
  c
        call s88fmt (2, nspace, fmt(2))
        call s88fmt (1, nwd, fmt(6))
        call s88fmt (2, nch, fmt(8))
        fmt(19) = fmt(6)
        fmt(21) = fmt(8)
        fmt(22) = fmt(9)
  c
        return
        end