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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
subroutine fmt(a,maxc,typ,n1,n2)
c!but
c ce sous programme determine le format d'ecriture le plus court
c representant au mieux le nombre positif a
c!liste d'appel
c subroutine fmt(a,maxc,typ,n1,n2)
c
c double precision a
c integer maxc,typ,n1,n2
c
c a : nombre positif
c maxc : nombre maximum de caracteres utilisables pour representer
c a
c typ : type du format
c typ=0 le nombre n'est pas representable
c typ=1 le format est dn1.n2
c typ=2 le format est fn1.n2
c n1,n2 : entiers definissant les champs des formats
c!origine
c Serge Steer INRIA
c!
c Copyright INRIA
double precision a,a1,ent,dec,sciround,dlamch
integer typ,n1,n2,maxc
logical v
c
C testing Nans
v=.false.
if (isanan(a).eq.1) v=.true.
if(v) then
typ=-2
return
c testing Inf
elseif(a.gt.dlamch('o')) then
typ=-1
return
endif
if(maxc-3.le.0) goto 30
if(a.lt.1.0d+0) goto 20
a1=mod(a,10.0d+0)
ent=a-a1+int(a1)
dec=a-ent
ndgt=int(log10(ent+0.4))+1
if(ndgt.lt.0) ndgt=maxc
if(ndgt.le.maxc-2) goto 10
if(maxc-7.lt.0) goto 30
typ=1
n1=maxc
n2=maxc-7
return
10 n1=ndgt+2
typ=2
ndgt=maxc-n1
n2=0
a1=dec*10.0d+0**(ndgt+1)
c dec=(a1-mod(a1,10.0d+0))/10.0d+0
dec=sciround(a1/10.0d+0)
if(dec.eq.0.0d+0) return
n2=ndgt
11 if(mod(dec,10.0d+0).ne.0.0d+0) goto 12
n2=n2-1
dec=dec/10.0d+0
goto 11
12 n1=n1+n2
return
c
20 ndgt=0
if(a.eq.0.0d+0) goto 26
m=1-log10(a)
ndgt=maxc-3+m
if(m.gt.maxc-3) goto 25
dec=sciround(a*10.0d+0**ndgt)
21 if(mod(dec,10.0d+0).ne.0.0d+0) goto 22
dec=dec/10.0d+0
ndgt=ndgt-1
goto 21
22 if(ndgt.le.maxc-3) goto 26
n1=maxc-3
n2=min(maxc-7,ndgt-m)
if(n1.ge.n2) goto 26
25 if(maxc-7.lt.0) goto 26
typ=1
n1=maxc
n2=maxc-7
return
26 typ=2
n2=min(ndgt,maxc-3)
n1=n2+3
return
30 typ=2
n1=maxc
n2=0
return
end
|
