s9comp.f
1.36 KB
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