Any suggestion for code to format REAL in a narrow column?
n...@eta.chalmers.se
I'd be most grateful if somebody could send me suggestions for method/
code/... to help solving my problem.
In writing F.77 (eg. VAX-Fortran), I'd like to output a REAL*4 value
into a column of 6 characters width.
I also have a supplied INTEGER value ("decno") that states "the
number of decimals", eg it is ment to be formatted like F6.<decno>,
but as You guess there might be a problem. For example, for decno=3,
the output is only fine when -10 < value < 100.
In the general case, this holds, but... when something goes out of the
normal, I'd prefere to squece the value in anyhow! First, I'm
reducing on the number of decimals used, secondly, I'm reverting to
using exponential form.
I've been testing/programming for a while, but for each step I take, I
realize even more width of this problem!
First was of cause to make a proper rounding of the values. 9.999735
with 2 decimals would be 10.00, which has two digitis before the
period (comparing INT(LOG10(value)) gave problems - next try was to
compare INT(LOG10(NINT(value*10.0**decno)/10.0**decno)), but when the
"value times 10**decno" exceeds storage for an integer (ie approx
10E9), there is an abrupt end to the sucess. For nodig=3, this means
any value > 1E6 goes wild, and such values are not to odd, for
examples when calculating pressures (in Pa...). I'd like to have a
routine that copes with all numbers storeable in the REAL...
As I'd like to maximize the number of valid figures presented anyhow,
I'd like to note that:
123E11 Has more information than 1.2E13
In case of negative values, a space for the minus sign is needed. If
the base or the exponent is positive, there is no need to waste space
for a plus-sign.
For the moment, I think in the direction of having a subroutine to do
the fomatting by fiddling around with characters, but if there
allready is something similar circulating the Web, I'd happily reuse!
After all, this should have been something known to computing
engineers for all times - outputting a formated matrix of results with
M columns, each N characters wide, on a output device line of max. P
characters...
I know the Fortran standard output of ****** far to well to appreciate
it.
Best regards,
Göran
David Flower
wrote:
I suggest that you write your own routine to produce a CHARACTER
variable of required length from a REAL variable.
One point, do you want the decimal points to line up columnwise? If so
you will require the same FORMAT for the entire column.
Dave Flower
Ron Shepard
"n...@eta.chalmers.se" <n...@eta.chalmers.se> wrote:
> As I'd like to maximize the number of valid figures presented anyhow,
> I'd like to note that:
>
> 123E11 Has more information than 1.2E13
This is something that I've been asking for since the "fortran 8x"
review period 20 years ago. It seems to be a common requirement,
displaying the maximum number of significant digits in a fixed width
field, yet it has never appeared in any fortran standard nor in any
vendor extension that I know of.
I think you have to do the work yourself. I have some examples for
specific field widths, but they do not generalize in a
straightforward way to arbitrary field widths. Here are some things
you might need to consider.
*) switch between f and e formats as appropriate.
*) for e formats, reduce the exponent field to one digit when
possible.
*) Replace the "E" with either "+" or "-" as appropriate. That is,
"123-11" is a valid floating point constant in formatted i/o, so you
might as well use it rather than "12E-11".
*) positive values will have one more digit displayed than negative
values of the same magnitude. You might want the option to either
suppress or require all of the "+" signs, the latter of which
restores the symmetry between positive and negative values.
*) there is sometimes more than one way to display a given value
that has the same number of displayed digits, e.g. "1234-10",
"123.4-9", "12.34-8", "1.234-7", and ".1234-6". However, "12345-9"
is better than "1234.-8" etc. because the former does not waste
space for the decimal point.
$.02 -Ron Shepard
me...@skyway.usask.ca
>In article <1171449998.0...@p10g2000cwp.googlegroups.com>,
> "n...@eta.chalmers.se" <n...@eta.chalmers.se> wrote:
>
>> As I'd like to maximize the number of valid figures presented anyhow,
>> I'd like to note that:
>>
>> 123E11 Has more information than 1.2E13
>
printer - or smaller font.
Computer o/p is not limited to 131 chars. anymore.
Chris
dpb
wrote:
...
> In writing F.77 (eg. VAX-Fortran), I'd like to output a REAL*4 value
> into a column of 6 characters width.
> I also have a supplied INTEGER value ("decno") that states "the
> number of decimals", eg it is ment to be formatted like F6.<decno>,
> but as You guess there might be a problem. For example, for decno=3,
> the output is only fine when -10 < value < 100.
>
> In the general case, this holds, but... when something goes out of the
> normal, I'd prefere to squece the value in anyhow! First, I'm
> reducing on the number of decimals used, secondly, I'm reverting to
> using exponential form.
> As I'd like to maximize the number of valid figures presented anyhow,
> I'd like to note that:
>
> 123E11 Has more information than 1.2E13
In the Bettis Labs-written nuclear design codes of ages gone by, there
was an input/output processor that made the tacit assumption all
floating point values were written as (for example) 123456-3 where the
decimal and E were implied. The decimal was implied as leading so the
example is 0.000123456. It also had the ability to parse input
containing properly specified I,E, or F formatted values, but I gather
only output is significant here.
I think this is about the most concise generic format possible once
one selects a field width. Switching around between formats from entry
to entry makes reading the output very painful and error prone so
perhaps the occasional loss of a character of precision might be made
up for by fewer mistaken interpretations?
Whether these routines are available or not I don't know--I never saw
the source, but had the functionality available as linkable modules on
machines of days of yore...I know most if not all the codes have been
ported to desktops, but I've not used one in more years than I care to
remember... :)
Anyway, hopefully at least the idea is of some help...
--
n...@eta.chalmers.se
As no "ready-made solution" to this problem that must have been there
for all days of computing, evoked, I'll have to write it now. It will
take some time, but I'll (eventually?) post my results for mutual use.
As replacing the E / E- with +/- is a nice idea, I'll surely take that
one. In the use I have right now, the mutual design of positive and
negative values is not that important. (And a mutual placement of
decimal indicator is certainly not).
When it comes to select decimal indicator placement for different
solutions giving the same resolution, I'd give favour to the
"engineering" alternatives, 10** {3|6|9|...}
What I'm actually displaying is a matrix of measurement values from
different sensors. Each row has one signal, one might be a voltage,
one a current (as low as mA or uA), one might be a differential air
pressure drop across some "narrow" hole (in the range of 10 Pa), the
next might be a peek pressure inside a combustion camber - quite some
magnitudes larger).
Horizontally, different samples (taken at different times) are
displayed. I want to put as many samples as possible on the same
screen, and thereafter to scroll the screen using the arrow keypads.
Please don't be upset; but in this case, the displaying unit is about
as modern as the programming language.
It is limited to 24 lines by 80 chars (132 is possible, but that would
require personal binoculars for lots of mid-aged staff operating this
system).
Do I need to say this is an old system running, scheduled to run for
some more years, where the "file editing routine" has been of ******
trouble for all days that values has exceeded the limits (by
accident...) - the editing tool is there to adjust the results of the
accidents!
> From a different paradigm ... why not widen your
> printer - or smaller font.
> Computer o/p is not limited to 131 chars. anymore.
/Göran
Terence
otional sign and significance with a point in there somewhere,
totalling 6 characters and the exponent under the mantissa in the line
below?
My own variabile width real-to-text routine expects no output exponent
(human numbers), but writes the number to a work string as 20
characters and then takes the left-most (width) significant digits for
the column width desired in the report. If it finds the decimal point
is outside the area it replaces the string with a short exponent
version to avoid writing a wrong value.
One of the parameters input is the maximum number of decimal places,
which allows a general alignment within columns.
dpb
wrote:
...
> What I'm actually displaying is a matrix of measurement values from
> different sensors. Each row has one signal, one might be a voltage,
> one a current (as low as mA or uA), one might be a differential air
> pressure drop across some "narrow" hole (in the range of 10 Pa), the
> next might be a peek pressure inside a combustion camber - quite some
> magnitudes larger).
For such a specialized display, it would be expected that the values
in any given column are of nearly the same magnitude for long periods
of time unless it is a transient monitor rather than an operational
one. If such is the case, it would seem reasonable to find a specific
format that covers the range of values for each transducer output and
stick with that format for that column. I've worked on quite a number
of similar-sounding systems over the years and that almost invariably
was the simplest solution. If there's an issue of a large dynamic
range for a particular sensor's output, that makes it a little more
difficult. But, I think my approach would be more application-
specific than the way the original question seemed to approach the
subject, thus making the implementation much less complex.
Depending on the OS, hardware, etc., I can certainly understand there
being very little flexibility on choice of display modes, but it
_might_ be possible if this is CRT rather than paper to get a larger
monitor that would more easily support the longer line yet be
readable. Couldn't tell from description what the actual output
device referred to is...
Colin Watters
Given that your output is intended to be human-readable, it doesn't actually
have to be computer-readable. You could design a format that is
understandable to humans, is very compact, and would require minimal head
scratching.
For example, display all values between 0.1 and 999999 normally. Anything of
1e6 or greater, use a single uppercase alphabetic character to denote the
exponent. So 12345F is 0.12345E+6 ; 33461J is 0.33461E+10 ; 55432Z is
0.55432E+26. For values less than 0.1, use lowercase. So 44567c is
0.44567E-03 ; 12345j is 0.12345E-10 ; 54321z is 0.54321E-26.
Negative numbers would still require a digit to be sacrificed. Or you could
use colour to distinguish negatives, or reverse video (or flashing? no maybe
not). OR ... put the exponent character first.
Hope this gives you some ideas...
--
Qolin
Email: my qname at domain
Domain: qomputing dot demon dot co dot uk
P.S. See also my earlier post that went missing... real working code.
David Flower
wrote:
I'm guessing a bit, but I suspect that you require that users be able
to observe trends in the data. If this is so, then there is a
substantial advantage in all the data in any one column being in the
same format; given this, any exponent could be absorbed into the
heading. Perhaps, also, the format could be changed by the user during
a run
Dave Flower
Louis Krupp
> Ok then here's an off the wall idea.
>
> Given that your output is intended to be human-readable, it doesn't actually
> have to be computer-readable. You could design a format that is
> understandable to humans, is very compact, and would require minimal head
> scratching.
<snip>
> Negative numbers would still require a digit to be sacrificed. Or you could
> use colour to distinguish negatives, or reverse video (or flashing? no maybe
> not). OR ... put the exponent character first.
Overpunch. It works for COBOL.
Louis
Colin Watters
On Feb 14, 10:46?am, "n...@eta.chalmers.se" <n...@eta.chalmers.se>
> Gran
... I asked almost exactly this here about 18 months ago. I never got any
suggestions to beat what I currently do: see attached.
My code is desperately inefficient, mostly Fortran 77, and uses non-standard
syntax such as real*4. But it works for me, and has undergone various tweaks
and bugfixes for the best part of 20 years. AND it does exactly what you
want AFAICS.
The main routine is SIG_N, which used to have 4 entrypoints but has recently
been sanitized. This uses RCOMPACT.
RCOMPACT munges a character string containing the result of a formatted
write on a real. It compresses it, removing unnecessary characters while
preserving the existing precision. Thus for example +0.1234500E-03 would be
converted to .12345-3.
SIG_N works by choosing a 'suitable' format specifier to convert the real to
a character string with a formatted write. This string is passed to
RCOMPACT. On exit, the length of the string is compared with the required
length, and if it is too big, the format specifier is adjusted to remove one
digit of precision, and we go round again. This loop stars at label 2.
You can see the growth rings in this code. There is another IF-block above
this, where some of the more common (for me) special-case values are treated
differently to increase speed.
SIG_N comes in 4 flavours, to allow padding with trailing zeros (or not),
and single or double precision. Since it is a function the caller has to
declare its length. This overlaps somewhat with the first argument;
nevertheless I find this convenient coz I declare it one character bigger
than the argument size so I get a trailing space in the result, which suits
me. In any case you could always call the core routine SIG_SUB.
The rest of the file is other service-type routines, and a test program at
the end. The whole lot compiles and links and runs on CVF 6.6a, I would hope
it will do the same on many other compilers.
...So, come on chaps. 18 months ago I asked if anyone had any good ideas for
this. Now you can all see my code, maybe (when you have stopped laughing)
someone could come up with a better way.
--
Qolin
Email: my qname at domain
Domain: qomputing dot demon dot co dot uk
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!
! SIG_N ... format a floating point number to N columns, preserving
! maximum number of significant figures.
!
! Qolin 07/06/06 Remove entry points.
! Qolin 20/09/00 Fixed the problem described below (02/05/00) by altering
the
! tested value for an F format from 1.0 to 0.9995.
! Qolin 24/05/00 Added entrypoints sig_m and sig_ms to allow the answer
to
! be shorter than the specified length, i.e. padding with
! trailing zeros will not happen.
! Qolin 02/05/00 OK forget the comment below, Whats REALLY happening is
! that the number if 0.999998, and its being rounded to
! 1.00000, which of course really won't fit in f6.5.
! Qolin 02/05/00 Seems that digital fortran won't do the sensable thing
! when asked to format a number like 0.99999 with a
! format specifier of f6.5. We want it to create '.99999',
! but it insists on supplying a leading zero as in
! '0.99999', which of course won't fit, so it substitutes
! stars instead. Bloody hell !!!
! Qolin 24/02/99 Created... A rather brute-force approach, this,
! but it should be robust. It can be accellerated
! later if we think it worthwhile.
!
!------------------------------------------------------------------------
character*(*) function sig_n (ncol,dd) ! double-precision argument,
pad to exact size
implicit none
integer ncol
real*8 dd
character*40 ccc
integer, parameter :: ep = 12
logical, parameter :: exact = .true.
call sig_sub(ncol,dd,ep,exact,ccc)
sig_n = ccc
end function sig_n
character*(*) function sig_ns(ncol,rr) ! single-precision argument,
pad to exact size
implicit none
integer ncol
real*4 rr
character*40 ccc
integer, parameter :: ep = 6
logical, parameter :: exact = .true.
call sig_sub(ncol,dble(rr),ep,exact,ccc)
sig_ns = ccc
end function sig_ns
character*(*) function sig_ms(ncol,rr) ! single-precision argument,
no padding
implicit none
integer ncol
real*4 rr
character*40 ccc
integer, parameter :: ep = 6
logical, parameter :: exact = .false.
call sig_sub(ncol,dble(rr),ep,exact,ccc)
sig_ms = ccc
end function sig_ms
character*(*) function sig_m (ncol,dd) ! double-precision argument,
no padding
implicit none
integer ncol
real*8 dd
character*40 ccc
integer, parameter :: ep = 12
logical, parameter :: exact = .false.
call sig_sub(ncol,dd,ep,exact,ccc)
sig_m = ccc
end function sig_m
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
subroutine sig_sub(ncol,val,aep,exact,ccc)
implicit none
integer ncol ! (in) number of columns desired for the answer
real*8 val ! (in) value to be converted
integer aep ! (in) 6 or 12, for single or double precision
logical exact ! (in) If trailing zeros must be added to make up
exact number of characters
character*(*) ccc ! (out) converted value
character*40 cc2
real*8 , parameter :: R4UNDEF = -1e31 ! Real*4
Undefined.
integer lencfq1, size, nc, pos
integer, save :: qlg1=0, qlg2=0, qlg3=0
real*4 err_func4
real*8 rcc,err_func8,err,lim
integer ierr, ep
character*12 fmt, zeros
character*13 pzeros
save pzeros
equivalence(zeros(1:1),pzeros(2:2))
data pzeros / '.000000000000' /
character*10, parameter :: faa(15) = (/ '(g8.1)' , &
'(g9.2)' , &
'(g10.3)' , &
'(g11.4)' , &
'(g12.5)' , &
'(g13.5)' , &
'(g14.7)' , &
'(g15.8)' , &
'(g16.9)' , &
'(g17.10)', &
'(g18.11)', &
'(g19.12)', &
'(g20.13)', &
'(g21.14)', &
'(g22.15)' /)
character*20, parameter :: czero = '0.00000000000000000'
!-----for pipesim engine debugging, limit significant figures to 3:
ep = aep
size = min(ncol,ep)
if(val.eq.r4undef) then
ccc = '-1e31'
elseif(val.eq.0.0) then
if(exact) then
ccc = czero(1:ncol)
else
ccc = '0.'
endif
!-----If abs of val is in the range 0.99999 to 0.0001, use an F format
directly (eg. 0.001234 is better than 0.123e-2)
elseif(abs(val).lt.0.99995 .and. abs(val).ge.0.0001) then
size = ncol - 1 ! subtract one for the decimal
point
if(val.lt.0.) size = size - 1 ! and another one for a negative
if(abs(val).ge.0.1) then
size = min(size,ep) ! don't use more precision than
is available: we want 0.1., not 0.099999999
elseif(abs(val).ge.0.01) then
size = min(size,ep+1)
elseif(abs(val).ge.0.001) then
size = min(size,ep+2)
else
size = min(size,ep+3)
endif
!-------create an F format
write(fmt,34,err=98) ncol,size
34 format('(F',i2.2,'.',i2.2,')')
!-------create the string using that format
write(ccc,fmt,err=97) val
!-------left-justify
call ljcs(ccc,nc)
!-------add trailing zeros if necessarry, or remove them maybe
if(exact) then
if(nc.lt.ncol) ccc(nc+1:ncol) = zeros
else
call rcompact(ccc)
endif
else
!-------start with a G format sized to ncol, or precision of value,
whichever is the smaller
if(abs(val).lt.0.0001) then ! if is clearly going to need 'e-3' on
the end, start off with size=ncol-3
size = min(ncol-3,ep) ! do not use more than 6
significant figures with single precision values, else risk getting
99.9999999 instead of 100.
else
size = min(ncol,ep) ! do not use more than 6
significant figures with single precision values, else risk getting
99.9999999 instead of 100.
endif
!-------loop round here
2 continue
!-------use the array of formats to convert the string
write(ccc,faa(max(1,size)),err=95) val
!-------if its too big, or if an exact fit is not required, throw it at
rcompact
nc = len_trim(ccc)
if(nc.gt.ncol .or. .not.exact) then
call rcompact(ccc) ! compact the string
if(size.gt.0) call rcompact_replace_e(ccc) ! replace the E into
the exponent (actually an 'e')
!---------if it's still too big, decrease the size and go round again
nc = len_trim(ccc)
if(nc.gt.ncol) then
size = size - 1
if(size.lt.0) goto 94
goto 2
endif
endif
!-------if it's the correct size, leave it
if(nc.eq.ncol .or. .not.exact) then
continue
!-------if it's too small, add trailing zeros at the appropriate point
elseif(index(ccc,'e').gt.0) then ! we have an exponent
pos = index(ccc,'e')
if(index(ccc,'.').gt.0) then ! and a decimal point
cc2 = ccc(1:pos-1)//zeros(1:ncol-nc)//ccc(pos:)
else
cc2 = ccc(1:pos-1)//pzeros(1:ncol-nc)//ccc(pos:)
endif
ccc = cc2
elseif(index(ccc,'.').gt.0) then ! no exponent, but we have a
decimal point
ccc(nc+1:ncol) = zeros
else ! no exponent, and no decimal
point
ccc(nc+1:ncol) = pzeros
endif
endif
goto 900
93 continue
ccc = '?!?'
goto 900
94 continue
ccc = '?!!'
goto 900
95 continue
ccc = '!??'
goto 900
96 continue
ccc = '!?!'
goto 900
97 continue
ccc = '!!?'
goto 900
98 continue
ccc = '!!!'
goto 900
!-----set the answer & return
900 continue
return
end
!+- OmniWorks Replacement History -
pipesim`engines`bjalib`common:rcompact.f90;1
! 1*[ 64578] 15-JUL-2004 08:41:58 (GMT) DGrills
! "Transfer to Omniworks 14 July 2004"
!+- OmniWorks Replacement History -
pipesim`engines`bjalib`common:rcompact.f90;1
subroutine rcompact(arg_cval)
!---------------------------------------------------------------------------
!
! RCOMPACT ... Compact a character string containing a formatted real
number.
! e.g. '10.000' becomes '10', '+0.21000E-05' becomes
'.21e-5'.
!
! N.B. argument is CHARACTER !!!
!
! See also: rcompact_2 ... 2 arguments, 2nd one is len_trim of arg1
! rcompact_r ... 2 arguments, 1st is real in, 2nd is char
out
! rcompact_d ... 2 arguments, 1st is double in, 2nd is char
out
! rcompact_replace_e ... puts back the E in the exponent
!
! Qolin 15/12/97 Alternate entry point RCOMPACT_2 added.
! Qolin 07/12/94 Created.
!
!---------------------------------------------------------------------------
implicit none
character*(*) arg_cval ! (in/out) string to be converted
integer arg_nc ! (out) number of characters returned,
alternate EP only
integer*4 dp, ep, i, nc, en
real checkr1, checkr2
character*20 cval, cfrac, cexp, ocval
character*80 whole
character*1 sign
integer add, rexp
logical fixed
en = 1
goto 100
entry rcompact_2(arg_cval,arg_nc)
en = 2
100 continue
!-----take a copy of the argument and remove spaces
cval = arg_cval
call packcs(cval,nc)
ocval = cval
fixed = .false.
!-----locate the position of the start of the exponent
ep = index (cval(2:),'D')
if(ep.eq.0) ep = index (cval(2:),'E')
if(ep.eq.0) ep = index (cval(2:),'d')
if(ep.eq.0) ep = index (cval(2:),'e')
if(ep.eq.0) ep = index (cval(2:),'+')
if(ep.eq.0) ep = index (cval(2:),'-')
!-----crack off the exponent if it exists
cexp = ' '
if(ep.gt.0) then
ep = ep + 1 ! allow for cval(2:) above
cexp = cval(ep:)
cval(ep:) = ' '
!--------remove D or E, if redundant
i = 2
if(cexp(:2).eq.'D+' .or. &
cexp(:2).eq.'D-' .or. &
cexp(:2).eq.'E+' .or. &
cexp(:2).eq.'E-' ) then
cexp(1:1) = ' '
i = 3
fixed = .true.
endif
!--------remove leading zeros
do while (cexp(i:i).eq.'0')
cexp(i:i) = ' '
i = min ( i + 1, len(cexp) )
fixed = .true.
enddo
!--------if all that remains is just a '+' or '-', remove that too. Q
04/07/95
if(cexp.eq.' +' .or. cexp.eq.' -') cexp = ' '
endif
!-----locate the position of the decimal point
dp = index(cval,'.')
!-----crack off the decimal point & fractional part of the mantissa if it
exists
cfrac = ' '
if(dp.gt.0) then
cfrac = cval(dp:)
cval(dp:) = ' '
!--------remove trailing zeros
i = len_trim(cfrac)
do while(cfrac(i:i).eq.'0')
cfrac(i:i) = ' '
i = max( i - 1, 1 )
fixed = .true.
enddo
!--------remove decimal if redundant
if(cfrac.eq.'.') then
cfrac = ' '
fixed = .true.
endif
!-----if there is no decimal point, but there is an exponent, look for
redundant trailing zeros
elseif(ep.gt.0) then
!--------remove trailing zeros
add = 0
i = len_trim(cval)
do while(cval(i:i).eq.'0')
cval(i:i) = ' '
i = max( i - 1, 1 )
add = add + 1
fixed = .true.
enddo
!--------adjust exponent to suit
if(add.gt.0) then
if(cexp(1:1).eq.'E' .or. cexp(1:1).eq.'D') cexp(1:1) ='+'
read(cexp,'(i4)') rexp
rexp = rexp + add
if(rexp.eq.0) cexp = ' '
if(rexp.lt.0) write(cexp,'(i4)') rexp
if(rexp.gt.0) write(cexp,'(a,i4)') 'e',rexp
endif
endif
!-----the remaining contents of CVAL is the integer part of the mantissa.
! remove leading '+' (and '-', for the moment)
i = 1
sign = ' '
if(cval(1:1) .eq.'+' .or. cval(1:1).eq.'-') then
if(cval(1:1).eq.'-') sign = '-'
cval(1:1) = ' '
i = 2
fixed = .true.
endif
!-----remove leading zeros
do while(cval(i:i).eq.'0')
cval(i:i) = ' '
i = min ( i + 1, len(cval) )
fixed = .true.
enddo
!-----if that leaves us with something like .1e25, i.e. a fractional
one-digit mantissa with an exponent,
! transform it into an integer mantissa by modifying the exponent &
removing the decimal point
if(cval.eq.' ' .and. len_trim(cfrac).eq.2 .and. cexp.ne.' ' ) then
read(cexp,'(i4)') rexp
rexp = rexp - 1
if(rexp.eq.0) cexp = ' '
if(rexp.lt.0) write(cexp,'(i4)') rexp
if(rexp.gt.0) write(cexp,'(a,i4)') 'e',rexp
cval = cfrac(2:2)
cfrac = ' '
endif
!-----re-assemble the string and remove spaces
if(fixed) then
whole = sign // cval // cfrac // cexp
call packcs(whole,nc)
!--------check for zero being replaced by space, and change it back
if(whole.eq.' ') whole = '0'
!--------return
arg_cval = whole
if(en.eq.2) arg_nc = nc
else
!--------if we didn't find anything to change, look for strings of 999
if(index(arg_cval,'999').le.0) then
arg_cval = ocval
elseif(ocval.eq.'.9999999') then
arg_cval = '1'
elseif(ocval.eq.'9.999999') then
arg_cval = '10'
elseif(ocval.eq.'99.99999') then
arg_cval = '100'
elseif(ocval.eq.'999.9999') then
arg_cval = '1E4'
elseif(ocval.eq.'9999.999') then
arg_cval = '1E5'
elseif(ocval.eq.'99999.99') then
arg_cval = '1E6'
elseif(ocval.eq.'999999.9') then
arg_cval = '1E7'
elseif(ocval.eq.'9999999.') then
arg_cval = '1E8'
elseif(ocval.eq.'99999999') then
arg_cval = '1E9'
else
arg_cval = ocval ! to ensure that it gets left-justified: Q
15/07/99
endif
if(en.eq.2) arg_nc = len_trim(arg_cval)
endif
return
end
!---------------------------------------------------------------------------
------
subroutine rcompact_replace_e(ccc)
! ... replaces the E in the exponent, eg .1234-5 becomes .1234e-5.
implicit none
character*(*) ccc
character*20 lcc
integer i
!-----look for a + or - in an exponent position
i = max(index(ccc(2:),'-'),index(ccc(2:),'+')) ! added substring
reference to omit any leading sign... Q 24/07/01
if(i.le.0) goto 900 ! Q 24/07/01 ... adjust to allow for substring
ref above
i = i + 1 ! undo substring ref: Q 24/07/01
!-----ensure there isn't a D or E preceeding it already
if(ccc(i-1:i-1).eq.'E') goto 900
if(ccc(i-1:i-1).eq.'e') goto 900
if(ccc(i-1:i-1).eq.'D') goto 900
if(ccc(i-1:i-1).eq.'d') goto 900
!-----put one in
if(ccc(i:i).eq.'-') then ! if -ve exponent, we must insert the 'e'
lcc = ccc
ccc = lcc(1:i-1) //'e'// lcc(i:)
else ! if +ve exponent, overwrite the '+' with
the 'e'. Q 21/09/00
ccc(i:i) = 'e'
endif
900 continue
end
!+- OmniWorks Replacement History -
pipesim`engines`bjalib`common:packcs.f90;1
! 1*[ 64578] 15-JUL-2004 08:41:58 (GMT) DGrills
! "Transfer to Omniworks 14 July 2004"
!+- OmniWorks Replacement History -
pipesim`engines`bjalib`common:packcs.f90;1
SUBROUTINE PACKCS(STRING,NC)
!---------------------------------------------------------------------------
--
!
! PACKCS ... PACK CHARACTERS SUBROUTINE.
!
!
! OTHER ENTRY POINTS:
!
! LENCS ... as LENC
! LENC ... get length of significant part of character string
! LJCS ... left justify a character string
!
! Modification History:
!
! CBrickley 6/1/06 lnbc replaced by len(trim(...))
! Qolin 29/10/98 Removed dependence on internal string. MUCH better! ...
turns
! out its trickier that I first thought: we must ensure we
never
! assingn string(nc:nc) = string(i:i) when nc equals i,
else salford spits.
! Qolin 05/08/94 Added entry point PACKCS1.
! Qolin 15/02/88 Checked NC to ensure greater than zero.
!
!
!---------------------------------------------------------------------------
--
IMPLICIT NONE
!
! FORMAL PARAMETERS:
!
CHARACTER STRING*(*)
INTEGER NC
!
!
! LOCAL VARIABLES:
!
INTEGER I, ncc, k, j, i1
!
!
!
!
!-------------------------------------------------------------------------
!
! PACKCS ... remove all spaces from a string.
!-----forget it if string is all spaces
if(string.eq.' ') then
nc = 1
goto 900
endif
!-----forget it if string contains no spaces
j = index(string,' ')
if(j.le.0) then
nc = len(string)
goto 900
endif
!-----forget it if the first space is beyond the trimmed length
k = len(trim(string))
if ( j .gt. k ) then
nc = k
goto 900
endif
!-----OK, so now we definately have something to do.
!cc NC=0 ... can't be right, try this:
NC=j-1
do i = j, len(trim((string)))
if(string(i:i).ne.' ') then
nc=nc+1
string(nc:nc)=string(i:i)
endif
enddo
string(nc+1:) = ' ' ! Q 29/10/98
goto 900
!
!--------------------------------------------------------------------------
entry packcs1(string,nc)
!
! PACKCS1 ... exchange all occurrences of 2 or more spaces for a single
space.
!
!-----forget it if string is all spaces
if(string.eq.' ') then
nc = 1
goto 900
endif
!-----forget it if string contains no double-spaces
j = index(string,' ')
if(j.le.0) then
nc = len(string)
goto 900
endif
!-----forget it if the first double-space is beyond the trimmed length
k = len(trim(string))
if ( j .gt. k ) then
nc = k
goto 900
endif
!-----OK, so now we definately have something to do.
!cc nc = 0
NC = j-1
DO I = j, k
i1 = min(i+1,len(string))
IF(STRING(I:I1).NE.' ') THEN
NC=NC+1
string(NC:NC)=STRING(I:I)
ENDIF
enddo
!cc nc = nc + 1
!cc string(nc:nc) = string(k:k)
string(nc+1:) = ' '
!
goto 900
!
!--------------------------------------------------------------------------
ENTRY LENCS(STRING,NC)
ENTRY LENC(STRING,NC)
!
! LENC ... GET THE LENGTH OF THE SIGNIFICANT PART OF A CHARACTER STRING.
! I.E., RETURN THE POSITION OF THE LAST NON-BLANK CHARACTER.
!
NC=len(trim(string))
goto 900
!---------------------------------------------------------------------------
ENTRY LJCS(STRING,NC)
!
! LJCS ... LEFT-JUSTIFY A CHARACTER STRING.
!
if(string.eq.' ') then ! catch a string of all blanks
nc = 1
else
NC=len(trim(string))
if(string(1:1).eq.' ') then ! catch a string that doesn't
need jeft-justifying
DO I=2,nc ! loop to find the first
non-blank character
IF(STRING(I:I).NE.' ') goto 6
enddo
6 CONTINUE
k = 1
do j = i, nc ! loop to shuffle each
character down
string(k:k) = string(j:j)
k = k + 1
enddo
string(k:) = ' ' ! zap the rest
nc = k - 1 ! adjust length
endif
endif
GOTO 900
!---------------------------------------------------------------------------
--
900 continue
return
!
END
!---------------------------------------------------------------------------
--
!+- OmniWorks Replacement History -
pipesim`engines`bjalib`common:testsg10.f90;1
! 1*[ 64578] 15-JUL-2004 08:41:58 (GMT) DGrills
! "Transfer to Omniworks 14 July 2004"
!+- OmniWorks Replacement History -
pipesim`engines`bjalib`common:testsg10.f90;1
program testsig10
character*10 c,sig_ns
character*30 flag
character*179 fff
real a,r,error,bb,olda
integer i,count
!cc open(8,file='testsg10.out')
a=1e-30
olda = a
count=100
bb=0.
10 continue
olda = a
do 1 i=1,20000
a=a*1.021
c=sig_ns(8,a)
read(c,'(f11.0)') r
error=abs(abs(a-r)/(r+a)*2.)
flag=' '
if(error.gt.1e-7) flag=' * '
if(error.gt.1e-6) flag=' ** '
if(error.gt.1e-5) flag=' *** '
if(error.gt.1e-4) flag=' **** '
if(error.gt.1e-3) flag=' ***** '
if(error.gt.1e-2) flag=' ****** '
if(error.gt.1e-1) flag=' *************** '
if(error.gt.1e-0) flag=' ************************ '
if(abs(olda)*10. .lt. abs(a)) then
! write(6,101) char(12)
write(6,100) a,c,r,error,flag
count=3
olda = a
endif
!c write(6,100) a,c,r,error,flag
if(error.gt.bb) then
write(fff,100) a,c,r,error,flag
bb=error
endif
count=count+1
if(abs(a).gt.1e30) goto 2
1 continue
2 continue
print *,fff
if(a.lt.0.) stop
bb=0.
a=-1e-30
goto 10
100 format(g14.7,2x,a11,2x,g14.7,2x,g14.7,2x,a)
101 format(a,' Original Sig10s read error'/)
end