Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/darite.for
There are 2 other files named darite.for in the archive. Click here to see a list.
SUBROUTINE DARITE(VALUE ,JSTIFY,NOTATN,IPART ,ISIGN ,
1 KLIP ,IFILL ,IWIDTH,MINDEC,MAXDEC,MINSIG,MAXSIG,
2 INIZRO,MARGIN,IDECML,IEXPNT,IFORMT,IZERO ,LFTCOL,
3 MAXBFR,IBUFFR,KOUNT ,IERR )
C RENBR(/FREE FORMAT NUMERIC OUTPUT ROUTINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO REPRESENT A NUMBER SO THAT IT CAN BE
C WRITTEN WITH A FORTRAN FORMAT STATEMENT CONTAINING A
C MULTIPLE A1 ALPHAMERIC SPECIFICATION. THE NUMBER CAN
C BE REPRESENTED EITHER WITH A USER SPECIFIED NUMBER OF
C DIGITS RIGHT OF THE DECIMAL POINT AND WITH A MAXIMUM
C NUMBER OF SIGNIFICANT DIGITS, OR IN SCIENTIFIC
C NOTATION AS A NUMBER IN THE RANGE 1.000... TO
C 9.999... WITH A FOLLOWING EXPONENT. IF FLOATING
C POINT NOTATION HAS BEEN REQUESTED, BUT THE NUMBER
C CANNOT FIT INTO THE SUPPLIED FIELD WITH THE SPECIFIED
C NUMBER OF DIGITS RIGHT OF THE DECIMAL POINT, THEN THE
C NUMBER OF DIGITS RIGHT OF THE DECIMAL POINT WILL BE
C DECREASED, AND IF THE NUMBER WILL STILL NOT FIT, THEN
C SCIENTIFIC NOTATION WILL BE USED. IF THE NUMBER WILL
C NOT FIT INTO THE FIELD EVEN IN SCIENTIFIC NOTATION,
C THEN THE FIELD WILL BE FILLED WITH ASTERISKS.
C
C THE FOLLOWING ARE INPUT ARGUMENTS LEFT UNCHANGED
C
C VALUE = THE NUMBER TO BE REPRESENTED
C JSTIFY = -1, LEFT JUSTIFY NUMBER IN FIELD OF WIDTH
C IWIDTH
C = 0, CENTER NUMBER IN FIELD OF WIDTH IWIDTH.
C = 1, RIGHT JUSTIFY NUMBER IN FIELD OF WIDTH
C IWIDTH.
C NOTATN = -1, REPRESENT IN ARRAY IBUFFR THE VALUE IN
C SCIENTIFIC NOTATION. VALUE 1234 WOULD BE
C REPRESENTED IN IBUFFR AS 1.234E3
C = 0, DISPLAY IN IBUFFR THE VALUE IN FLOATING
C POINT FORM. THE VALUE 1234.56 WOULD BE
C DISPLAYED AS IT IS WRITTEN IF THE NUMBER OF
C DIGITS RIGHT OF THE DECIMAL POINT IS 2 AND
C IF AT LEAST 6 SIGNIFICANT DIGITS IN A FIELD
C OF AT LEAST 7 CHARACTERS ARE ALLOWED.
C = 1, MULTIPLY VALUE BY 100 AND INSERT PERCENT
C SIGN FOLLOWING DIGITS OF NUMBER. IWIDTH
C MUST INCLUDE ROOM FOR PERCENT SIGN. MINDEC
C AND MAXDEC REFER TO THE DISPLAYED DECIMAL
C POINT. TO PRINT TENTHS OF A PERCENT, MINDEC
C AND MAXDEC WOULD BOTH BE GIVEN THE VALUE 1
C = 2, IF NUMBER IS IN RANGE 1000 TO 1000000,
C DIVIDE VALUE BY 1000 AND INSERT K FOLLOWING
C DIGITS. IF NUMBER IS 1000000 OR GREATER,
C DIVIDE VALUE BY 1000000 AND INSERT M
C FOLLOWING DIGITS. IWIDTH MUST INCLUDE ROOM
C FOR CHARACTER K OR M. MINDEC AND MAXDEC
C REFER TO DISPLAYED DECIMAL POINT. MINDEC
C AND MAXDEC BOTH SET AT 2 WOULD REPRESENT
C VALUE 1234 AS 1.23K.
C = 3, SAME AS NOTATN=2 EXCEPT THAT MINDEC AND
C MAXDEC BOTH REFER TO THE DECIMAL POINT IN
C THE ORIGINAL VALUE, NOT TO THE DISPLAYED
C DECIMAL POINT. IF A K OR M IS DISPLAYED
C RIGHT OF THE NUMBER, THEN MINDEC AND MAXDEC
C VALUES OF -1 ARE EQUIVALENT TO VALUES OF 0.
C MINDEC=-2 INDICATES THAT THERE IS NO LOWER
C LIMIT TO THE NUMBER OF DIGITS DISPLAYED TO
C RIGHT OF THE DISPLAYED DECIMAL POINT AND IS
C PROBABLY THE APPROPRIATE VALUE UNLESS IT IS
C ABSOLUTELY NECESSARY TO DISPLAY THE DIGITS
C WHICH WOULD BE RIGHT OF THE DECIMAL POINT IN
C THE ORIGINAL VALUE, AS FOR EXAMPLE IF THE
C AMOUNTS ARE DOLLARS AND MUST BE DISPLAYED
C ALWAYS INCLUDING THE CENTS DIGITS.
C IPART = -1, IF THE VALUE IS REPRESENTED IN FLOATING
C POINT, COMPLETELY REPRESENT THIS VALUE. IF
C THE VALUE IS REPRESENTED IN SCIENTIFIC NOTA-
C TION, REPRESENT ONLY THE NORMALIZED PORTION
C OF THE VALUE WITHOUT THE EXPONENT, IT BEING
C THIS NORMALIZED VALUE (IN THE RANGE OF 1.0
C TO 9.9...) WHICH IS LEFT JUSTIFIED, CENTERED
C OR RIGHT JUSTIFIED ACCORDING TO THE VALUE OF
C JSTIFY. IWIDTH MUST, HOWEVER, CONTAIN
C SUFFICIENT ROOM FOR EITHER THE NORMALIZED
C VALUE OR THE EXPONENT, WHICHEVER REQUIRES
C THE MOST CHARACTERS TO REPRESENT.
C = 0, COMPLETELY REPRESENT THE VALUE REGARDLESS
C OF WHETHER IN FLOATING POINT OR SCIENTIFIC
C NOTATION.
C = 1, IF THE VALUE IS REPRESENTED IN FLOATING
C POINT, INSERT NOTHING (EXCEPT THE POSSIBLE
C TRAILING SPACES INDICATED BY IFILL) INTO
C IBUFFR. IF THE VALUE IS REPRESENTED IN
C SCIENTIFIC NOTATION, REPRESENT ONLY EXPONENT
C PORTION, IT BEING THIS EXPONENT PORTION
C WHICH IS LEFT JUSITIFED, CENTERED OR RIGHT
C JUSTIFIED ACCORDING TO THE VALUE OF JSTIFY.
C IWIDTH MUST, HOWEVER, CONTAIN SUFFICIENT
C ROOM FOR EITHER THE NORMALIZED VALUE OR THE
C EXPONENT, WHICHEVER REQUIRES THE MOST CHAR-
C ACTERS TO REPRESENT.
C ISIGN = -1, IF THE VALUE IS GREATER THAN ZERO, AND
C IF IPART.LE.0, THEN PLACE PLUS SIGN TO ITS
C LEFT. IF THE VALUE IS EQUAL TO ZERO, DO NOT
C ADD EXTRA SPACE WHERE THE PLUS OR MINUS SIGN
C WOULD OTHERWISE BE.
C = 0, IF THE VALUE IS GREATER THAN OR EQUAL TO
C ZERO, DO NOT ADD EXTRA SPACE WHERE THE MINUS
C SIGN WOULD OTHERWISE BE.
C = 1, IF THE VALUE IS GREATER THAN OR EQUAL TO
C ZERO, AND IF IPART.LE.0, THEN AT LEAST 1
C SPACE WILL BE PLACED AT THE LEFT END OF THE
C REPRESENTATION OF THE VALUE EVEN IF THE
C NUMBER OF DIGITS IN THE REPRESENTION MUST BE
C REDUCED TO MAKE ROOM FOR THIS SPACE.
C = 2, IF THE VALUE IS GREATER THAN ZERO, AND IF
C IPART.LE.0, THEN PLACE PLUS SIGN TO ITS
C LEFT. IF THE VALUE IS EQUAL TO ZERO, AND IF
C IPART.LE.0, THEN PLACE AT LEAST 1 SPACE AT
C THE LEFT END OF THE REPRESENTATION OF THE
C VALUE EVEN IF THE NUMBER OF DIGITS IN THE
C REPRESENTATION MUST BE REDUCED TO MAKE ROOM
C FOR THIS SPACE.
C KLIP = -3, SUPPRESS PRINTING OF ALL ZEROES TO THE
C RIGHT OF THE DECIMAL POINT AND WHICH DO NOT
C HAVE A NON-ZERO DIGIT TO THEIR RIGHT. IF
C NO NON-ZERO DIGITS APPEAR RIGHT OF DECIMAL
C POINT, THEN DO NOT REPRESENT DECIMAL POINT.
C IF CENTERING OR RIGHT JUSTIFYING, IT IS THE
C NUMBER AFTER REMOVAL OF ZEROES AND DECIMAL
C WHICH IS CENTERED OR RIGHT JUSTIFIED.
C = -2, SUPPRESS PRINTING OF ALL ZEROES TO THE
C RIGHT OF THE DECIMAL POINT AND WHICH DO NOT
C HAVE A NON-ZERO DIGIT TO THEIR RIGHT. IF
C CENTERING OR RIGHT JUSTIFYING NUMBER, IT IS
C NUMBER AFTER REMOVAL OF ZEROES WHICH IS
C CENTERED OR RIGHT JUSTIFIED.
C = -1, SUPPRESS PRINTING OF ALL ZEROES WHICH
C ARE BEYOND THE FIRST DIGIT AFTER THE DECIMAL
C POINT AND WHICH DO NOT HAVE A NON-ZERO DIGIT
C TO THEIR RIGHT. IF CENTERING OR RIGHT
C JUSTIFYING, IT IS THE NUMBER AFTER REMOVAL
C OF THE ZEROES THAT IS CENTERED OR RIGHT
C JUSTIFIED.
C = 0, REPRESENT AS ZEROES ALL ZEROES WHICH
C ARE BEYOND THE FIRST DIGIT AFTER THE DECIMAL
C POINT.
C = 1, CONVERT TO SPACES ALL ZEROES WHICH ARE
C BEYOND THE FIRST DIGIT AFTER THE DECIMAL
C POINT AND WHICH DO NOT HAVE A NON-ZERO DIGIT
C TO THEIR RIGHT. REMAINING CHARACTERS WILL
C BE IN THE SAME POSITIONS AS IF THE ZEROES
C WHERE NONZEROES. IF NOTATN.GT.0, SPACES CAN
C APPEAR BETWEEN THE NONSPACE CHARACTERS OF
C THE NUMBER AND THE FOLLOWING PERCENT SIGN OR
C K OR M SINCE THE LOCATION OF THESE PRINTING
C CHARACTERS IS NOT CHANGED BY THE CONVERSION
C OF THE TRAILING ZEROES TO SPACES.
C = 2, SAME AS KLIP=1, EXCEPT THAT ALL ZEROES TO
C THE RIGHT OF DECIMAL POINT WHICH DO NOT HAVE
C NON-ZERO DIGIT TO THEIR RIGHT ARE SUPPRESSED
C = 3, SAME AS KLIP=2, EXCEPT THAT IF THERE ARE
C NO NON-ZERO DIGITS DISPLAYED TO THE RIGHT OF
C DECIMAL POINT, THEN THE DECIMAL POINT IS NOT
C DISPLAYED.
C
C FOR EXAMPLE, THE REPRESENATIONS OF THE VALUE
C 12.34 IN FLOATING POINT WITH MAXDEC=4 AND IN
C SCIENTIFIC NOTATION WITH IDECML=5 WOULD BE
C
C FOR KLIP.LT.0 12.34 1.234E1
C KLIP=0 12.3400 1.23400E1
C KLIP.GT.0 12.34 1.234 E1
C
C IF NOTATN=2 VALUE 123E3 WOULD BE REPRESENTED
C
C FOR KLIP=-3 123K 1.23E5
C KLIP=-2 123.K 1.23E5
C KLIP=-1 123.0K 1.23E5
C KLIP=0 123.0000K 1.23000E5
C KLIP=1 123.0 K 1.23 E5
C KLIP=2 123. K 1.23 E5
C KLIP=3 123 K 1.23 E5
C
C IFILL = 0, DO NOT FILL PORTION OF FIELD RIGHT OF
C NONSPACE REPRESENTAION OF VALUE WITH SPACES.
C KOUNT WILL BE LEFT POINTING AT THE RIGHTMOST
C NONSPACE CHARACTER IN THE REPRESENATION OF
C THE VALUE. THE VALUE OF IFILL HAS NO EFFECT
C ON THE NONSPACE CHARACTERS IN THE REPRESEN-
C TATION OF THE VALUE. IF IFILL=0, AND IF
C IPART.LE.0, THEN THE CHARACTERS ORIGINALLY
C IN THE IBUFFR ARRAY TO THE RIGHT OF THE
C NONSPACE PORTION OF THE REPRESENTATION OF
C THE VALUE ARE LEFT INTACT. (THE REASON WHY
C IPART.GT.0 IS AN EXCEPTION IS THAT THE
C NORMALIZED PORTION OF THE NUMBER MUST BE
C TEMPORARILY STORED IN IBUFFR EVEN IF IT IS
C NOT GOING TO BE REPRESENTED SINCE EXPONENT
C CHANGE DUE TO ROUNDING MUST BE CHECKED FOR.)
C = 1, FILL THE FIELD RIGHT OF THE NONSPACE
C PORTION OF THE REPRESENTATION OF THE VALUE
C WITH SPACES. KOUNT WILL BE LEFT POINTING
C AT LFTCOL+IWIDTH.
C IWIDTH = THE NUMBER OF CHARACTERS TO BE IN THE FIELD
C INTO WHICH THE VALUE IS CODED. IWIDTH MUST
C INCLUDE ROOM FOR EXPONENT, SIGN AND DECIMAL
C POINT IF THESE ARE NECESSARY TO REPRESENT
C VALUE.
C LFTCOL = THE SUBSCRIPT OF THE IBUFFR ARRAY ENTRY TO
C THE IMMEDIATE LEFT OF FIELD INTO WHICH THE
C NUMBER IS TO BE CODED. USUALLY, LFTCOL WILL
C BE NUMBER OF CHARACTERS ALREADY IN IBUFFR.
C MAXBFR = DIMENSION OF IBUFFR ARRAY.
C
C THE FOLLOWING ARGUMENTS CONTROL FORMAT OF NUMBERS
C DISPLAYED IN FLOATING FORM (WITHOUT E EXPONENT), OR
C DISPLAYED WITH FOLLOWING K, M OR PERCENT SIGN. THESE
C ARGUMENTS DO NOT CONTROL THE FORMAT OF NUMBERS IN
C SCIENTIFIC NOTATION (EITHER WITH DISPLAYED EXPONENT
C OR WITH SUPPRESSED ZERO EXPONENT).
C
C MINDEC = MINIMUM NUMBER OF DIGITS RIGHT OF DISPLAYED
C DECIMAL POINT IN NUMBERS WHICH ARE DISPLAYED
C IN FLOATING FORM.
C = -1, IT IS NOT NECESSARY THAT THE DECIMAL
C POINT BE DISPLAYED. THERE IS NO MINIMUM
C LIMIT TO THE NUMBER OF DIGITS RIGHT OF THE
C DECIMAL POINT.
C = EQUAL TO OR GREATER THAN ZERO, MINDEC IS THE
C MINIMUM NUMBER OF DIGITS WHICH CAN BE
C DISPLAYED RIGHT OF THE DECIMAL POINT IN A
C FLOATING POINT NUMBER. IF LESS THAN MINDEC
C DIGITS WOULD BE DISPLAYED RIGHT OF DECIMAL
C POINT, THEN THE VALUE WILL BE REPRESENTED IN
C SCIENTIFIC NOTATION INSTEAD.
C MAXDEC = MAXIMUM NUMBER OF DIGITS RIGHT OF DISPLAYED
C DECIMAL POINT IN NUMBERS WHICH ARE DISPLAYED
C IN FLOATING FORM.
C = -2, REPRESENT AS MANY DIGITS RIGHT OF
C DECIMAL POINT AS FIELD WILL HOLD (UP THRU
C NUMBER OF DIGITS SPECIFIED BY MAXSIG).
C = -1, REPRESENT ONLY DIGITS LEFT OF DECIMAL
C POINT. THE DECIMAL POINT ITSELF WILL NOT BE
C REPRESENTED. IF MORE THAN IWIDTH OR MAXSIG
C DIGITS WOULD APPEAR LEFT OF DECIMAL POINT,
C NUMBER WILL BE REPRESENTED IN EXPONENT FORM.
C = .GE.0, REPRESENT NUMBER WITH MAXDEC DIGITS
C RIGHT OF DECIMAL POINT. IF THIS REPRESENT-
C ATION OF NUMBER WILL NOT FIT INTO FIELD SIZE
C INDICATED BY IWIDTH OR MAXSIG, THEN REDUCE
C NUMBER OF DIGITS REPRESENTED RIGHT OF
C DECIMAL POINT SO THAT NUMBER WILL FIT, OR
C REPRESENT NUMBER IN EXPONENT FORM IF THERE
C ARE MORE THAN IWIDTH OR MAXSIG DIGITS LEFT
C OF DECIMAL POINT.
C MINSIG = MINIMUM NUMBER OF SIGNIFICANT DIGITS TO BE
C REPRESENTED IN A VALUE DISPLAYED IN FLOATING
C POINT. IF LESS THAN MINSIG SIGNIFICANT
C DIGITS WOULD BE DISPLAYED, THE NUMBER WILL
C BE REPRESENTED IN SCIENTFIC NOTATION.
C MAXSIG = SELECTS MAXIMUM NUMBER OF SIGNIFICANT DIGITS
C DISPLAYED IN NUMBER REPRESENTED IN FLOATING
C POINT FORM.
C = .LE.0, ALLOW AS MANY DIGITS AS FIELD WILL
C HOLD
C = .GT.0, MAXSIG IS MAXIMUM NUMBER OF DIGITS
C WHICH CAN BE DISPLAYED STARTING WITH THE
C LEFTMOST NONZERO DIGIT, COUNTING IT AND ALL
C DIGITS TO ITS RIGHT. MAXSIG DOES NOT
C INCLUDE THE DECIMAL POINT, DOES NOT INCLUDE
C THE MINUS SIGN IF THE VALUE IS NEGATIVE, AND
C DOES NOT INCLUDE THE PERCENT SIGN, K OR M IF
C NOTATN.GT.0. THE NUMBER OF DIGITS DISPLAYED
C RIGHT OF THE DECIMAL POINT IS REDUCED IF
C NECESSARY SO THAT THE NUMBER OF DIGITS
C STARTING AT THE LEFTMOST NONZERO DISPLAYED
C DIGIT AND COUNTING IT AND ALL DIGITS
C DISPLAYED TO ITS RIGHT DOES NOT EXCEED
C MAXSIG. IF MAXSIG IS LESS THAN NUMBER OF
C DIGITS LEFT OF DECIMAL POINT IN DISPLAYED
C NUMBER, THEN NUMBER WILL BE DISPLAYED IN
C SCIENTIFIC NOTATION.
C INIZRO = 0, IF THE NUMBER IS REPRESENTED IN FLOATING
C POINT FORM AND HAS ABSOLUTE VALUE LESS THAN
C 1.0, THEN A ZERO IS DISPLAYED TO THE LEFT OF
C DECIMAL POINT.
C = 1, IF THE NUMBER IS REPRESENTED IN FLOATING
C POINT FORM AND HAS ABSOLUTE VALUE LESS THAN
C 1.0, THEN A ZERO IS NOT DISPLAYED TO LEFT OF
C DECIMAL POINT.
C = -1, SAME AS INIZRO=1 EXCEPT THAT A ZERO IS
C DISPLAYED LEFT OF THE DECIMAL POINT IF NO
C DIGITS WOULD OTHERWISE BE DISPLAYED.
C MARGIN = 0, IF THE NUMBER IS REPRESENTED IN FLOATING
C POINT FORM, AND IF A K, M OR PERCENT SIGN
C DOESN'T FOLLOW REPRESENTATION OF THE VALUE,
C THEN DO NOT ADD AN EXTRA SPACE WHERE THE K,
C M OR PERCENT SIGN WOULD OTHERWISE BE.
C = GREATER THAN ZERO, IS NUMBER OF CHARACTERS
C IN THE FIELD CONTAINING SPACES AND/OR THE K,
C M OR PERCENT SIGN TO RIGHT OF A FLOATING
C POINT NUMBER. MARGIN IS USED TO FORCE A
C FLOATING POINT NUMBER TO HAVE ITS RIGHTMOST
C DIGIT AT THE SAME POSITION AS THE RIGHTMOST
C DIGIT OF THE NORMALIZED PORTION OF A
C SCIENTIFIC NOTATION NUMBER. FOR THIS
C PURPOSE, IEXPNT WOULD BE 1 LESS THAN MARGIN.
C IF MARGIN IS GREATER THAN 1 AND A K, M OR
C PERCENT SIGN MUST BE PLACED TO RIGHT OF THE
C NUMBER, THEN THE K, M OR PERCENT SIGN IS
C PLACED AT THE LEFT OF THE FIELD OF SPACES
C WHERE THE E OF A SCIENTIFIC NOTATION NUMBER
C WOULD APPEAR AND THE FIELD THEN CONTAINS
C MARGIN-1 SPACES TO THE RIGHT OF THE K, M OR
C PERCENT SIGN. MARGIN WOULD HAVE THE VALUE 1
C IF IT IS MERELY DESIRED TO FORCE A SINGLE
C SPACE TO RIGHT OF THE NUMBER IF A K, M OR
C PERCENT SIGN DOES NOT APPEAR TO ITS RIGHT.
C
C THE FOLLOWING ARGUMENTS CONTROL FORMAT OF NUMBERS
C IN SCIENTIFIC NOTATION EITHER WITH DISPLAYED EXPONENT
C OR WITH SUPPRESSED ZERO EXPONENT (IZERO.LE.0).
C
C IDECML = SAME AS MAXDEC EXCEPT APPLIES ONLY TO
C NUMBERS DISPLAYED IN SCIENTIFIC NOTATION.
C NOTE THAT IF NUMBER IS BEING DISPLAYED IN
C SCIENTIFIC NOTATION, THEN A NONZERO DIGIT
C WILL BE USED LEFT OF THE DECIMAL POINT
C UNLESS THE VALUE IS ITSELF ZERO. THEREFORE,
C IF IDECML.GE.0, THEN THE MAXIMUM NUMBER OF
C SIGNIFICANT DIGITS WHICH CAN BE DISPLAYED IN
C SCIENTIFIC NOTATION IS IDECML+1.
C IEXPNT = MINIMUM NUMBER OF DIGITS IN THE EXPONENT IF
C VALUE IS REPRESENTED IN SCIENTIFIC NOTATION.
C IF FEWER THAN IEXPNT DIGITS ARE NEEDED IN
C EXPONENT, THESE ARE JUSTIFIED IN AN EXPONENT
C FIELD OF IEXPNT WIDTH WITH EITHER SPACES OR
C ZEROES AS FILL ACCORDING TO VALUE OF IFORMT.
C IEXPNT INCLUDES ROOM FOR SIGN (IF NEGATIVE
C EXPONENT) BUT DOES NOT INCLUDE ROOM FOR THE
C INITIAL LETTER E.
C IFORMT = 0, IF IEXPNT IS GREATER THAN THE NUMBER OF
C CHARACTERS NEEDED TO REPRESENT THE EXPONENT,
C LEFT JUSTIFY THE EXPONENT WITHIN EXPONENT
C FIELD.
C = 1, IF IEXPNT IS GREATER THAN THE NUMBER OF
C CHARACTERS NEEDED TO REPRESENT THE EXPONENT,
C RIGHT JUSTIFY THE DIGITS OF THE EXPONENT
C WITHIN THE EXPONENT FIELD. IF THE EXPONENT
C IS NEGATIVE, PLACE THE SIGN RIGHT OF THE E
C AT THE START OF THE EXPONENT. ZEROES, NOT
C SPACES, ARE USED TO FILL THE REST OF THE
C EXPONENT FIELD.
C = 2, SAME AS IFORMT=1 EXCEPT THAT SPACES, NOT
C ZEROES ARE USED TO FILL BETWEEN THE SIGN IF
C ANY AND THE DIGITS OF THE EXPONENT.
C = 3, SAME AS IFORMT=2 EXCEPT THAT THE SIGN IF
C ANY IS PLACED IMMEDIATELY TO THE LEFT OF
C THE DIGITS OF THE EXPONENT INSTEAD OF TO THE
C RIGHT OF THE E AT THE START OF THE EXPONENT.
C
C FOR EXAMPLE, IF IEXPNT IS 4, THEN THE VALUE
C 1.2E-3 WOULD BE REPRESENTED
C
C FOR IFORMT=0 1.2E-3
C IFORMT=1 1.2E-003
C IFORMT=2 1.2E- 3
C IFORMT=3 1.2E -3
C
C IZERO = -1, IF THE VALUE IS BEING REPRESENTED IN
C SCIENTIFIC NOTATION AND HAS A ZERO EXPONENT
C (VALUE OF THE NUMBER IS ZERO OR IS IN EITHER
C RANGE -9.99... TO -1.00... OR RANGE 1.00...
C TO 9.99...), THEN THE REPRESENTATION OF THE
C NUMBER WILL NOT INCLUDE AN EXPONENT FIELD.
C = 0, IF THE VALUE IS BEING REPRESENTED IN
C SCIENTIFIC NOTATION AND HAS A ZERO EXPONENT
C (VALUE OF THE NUMBER IS ZERO OR IS IN EITHER
C RANGE -9.99... TO -1.00... OR RANGE 1.00...
C TO 9.99...), THEN THE EXPONENT FIELD IS OF
C THE SAME SIZE AS IF THE EXPONENT WAS ONE BUT
C THE EXPONENT FIELD IS FILLED WITH SPACES.
C = 1, IF THE VALUE IS BEING REPRESENTED IN
C SCIENTIFIC NOTATION, THEN EXPONENT WILL BE
C DISPLAYED EVEN IF THIS EXPONENT IS ZERO.
C
C FOR EXAMPLE, IF IEXPNT IS 4, THEN THE VALUE
C 1.2 WOULD BE REPRESENTED
C
C FOR IZERO=-1 1.2
C IZERO=0 1.2
C IZERO=1 1.2E 0
C
C THE FOLLOWING ARE OUTPUT ARGUMENTS
C
C IBUFFR = ARRAY INTO WHICH THE NUMBER IS TO BE CODED
C AND WHICH CAN THEN BE PRINTED WITH MULTIPLE
C OF AN A1 FORMAT.
C KOUNT = RETURNED POINTING TO THE RIGHTMOST CHARACTER
C INSERTED INTO THE IBUFFR ARRAY. THIS WILL
C EQUAL LFTCOL+IWIDTH WHILE IFILL=1.
C IERR = -1 RETURNED IF THE FIELD WAS FILLED WITH
C ASTERISKS DUE TO FIELD OVERFLOW EVEN IN
C SCIENTIFIC NOTATION.
C = 0 RETURNED IF VALUE WAS REPRESENTED AS A
C FLOATING POINT NUMBER WITH OR WITHOUT
C FOLLOWING PERCENT SIGN, K OR M.
C = 1 OR GREATER RETURNED IF VALUE WAS
C REPRESENTED IN SCIENTIFIC NOTATION. IERR IS
C NUMBER OF DIGITS LEFT OF EXPONENT PRIOR TO
C SUPPRESSION OF RIGHTHAND ZEROES BY NONZERO
C VALUE OF KLIP.
C
DIMENSION IBUFFR(MAXBFR),IDIGIT(11),LETTER(3)
C
C 11TH NONDIGIT ITEM IN IDIGIT ACTS AS A FENCE IN CASE
C OF ROUNDING ERROR WHEN SHIFTING DIGITS OUT OF VALUE
DATA IDIGIT
1/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H*/
DATA LETTER/1H%,1HK,1HM/
DATA JEXPNT,ISTAR,IPLUS,IMINUS,IDOT,JZERO,IBLANK/
11HE,1H*,1H+,1H-,1H.,1H0,1H /
NOTE=NOTATN
IFZERO=INIZRO
JWIDTH=IWIDTH
IF(JWIDTH.GT.(MAXBFR-LFTCOL))JWIDTH=MAXBFR-LFTCOL
1 IOFSET=0
2 LTREND=LFTCOL+JWIDTH
C
C FIND ABSOLUTE VALUE OF NUMBER TO REPRESENT
ABSVLU=VALUE
MINUS=0
IF(ABSVLU.LT.0.0)GO TO 5
IF(ABSVLU.EQ.0.0)GO TO 3
IF(ISIGN.EQ.0)GO TO 7
IF(ISIGN.EQ.1)GO TO 4
MINUS=2
GO TO 6
3 MAXEXP=-1
IF(ISIGN.LE.0)GO TO 11
MINUS=1
LTREND=LTREND-1
GO TO 11
4 MINUS=1
GO TO 6
5 ABSVLU=-ABSVLU
MINUS=-1
6 LTREND=LTREND-1
C
C NORMALIZE THE ABSOLUTE VALUE
C MAXEXP = ABSULUTE VALUE OF MAXIMUM EXPONENT
C = LEFT =-1 IF UNDERFLOW OR OVERFLOW
7 MAXEXP=100
KEXPNT=IOFSET
8 IF(ABSVLU.LT.10.0)GO TO 9
ABSVLU=ABSVLU/10.0
KEXPNT=KEXPNT+1
IF(KEXPNT.LE.IOFSET)GO TO 12
GO TO 10
9 IF(ABSVLU.GE.1.0)GO TO 12
IF(KEXPNT.GT.IOFSET)GO TO 12
ABSVLU=ABSVLU*10.0
KEXPNT=KEXPNT-1
10 MAXEXP=MAXEXP-1
IF(MAXEXP.GE.0)GO TO 8
ABSVLU=0.0
11 KEXPNT=0
C
C ADJUST EXPONENT IF PERCENT, K OR M NOTATION
C INOTE = SUBSCRIPT IN LETTER ARRAY OF PERCENT SIGN,
C K OR M TO BE ADDED AT RIGHT OF NUMBER
C KDECML = NUMBER OF DIGITS TO SHIFT
12 IRIGHT=0
IF(NOTE.LT.0)GO TO 25
IMINDE=MINDEC
IMAXDE=MAXDEC
IF(NOTE.EQ.0)GO TO 16
IF(NOTE.NE.1)GO TO 13
INOTE=1
KDECML=-2
GO TO 15
13 IF(KEXPNT.LT.3)GO TO 16
IF(KEXPNT.GE.6)GO TO 14
INOTE=2
KDECML=3
GO TO 15
14 INOTE=3
KDECML=6
15 IF(MARGIN.GT.0)IRIGHT=MARGIN-1
LTREND=LTREND-1
GO TO 17
16 IF(MARGIN.LE.0)GO TO 19
INOTE=-1
IRIGHT=MARGIN
KDECML=0
17 LTREND=LTREND-IRIGHT
IF(MAXEXP.LT.0)GO TO 20
KEXPNT=KEXPNT-KDECML
IF(NOTATN.LT.3)GO TO 20
IF(KDECML.LE.0)GO TO 20
IF(IMINDE.LT.-1)GO TO 18
IMINDE=KDECML
IF(MINDEC.GE.0)IMINDE=MINDEC+IMINDE
18 IF(IMAXDE.LT.-1)GO TO 20
IMAXDE=KDECML
IF(MAXDEC.GE.0)IMAXDE=MAXDEC+IMAXDE
GO TO 20
19 INOTE=0
C
C DECIDE FORMAT IF NUMBER NOT IN SCIENTIFIC NOTATION
C JPOINT = LOCATION IN IBUFFR OF FINAL PRINTING DIGIT
C LWIDE = NUMBER OF DIGITS TO PRINT RIGHT OF DECIMAL
C POINT
C = -1, INCLUDE NEITHER DECIMAL POINT NOR DIGITS
C WHICH WOULD BE RIGHT OF DECIMAL POINT
C MWIDE = NUMBER OF CHARACTERS NEEDED FOR EXPONENT
C = 0, DON'T INCLUDE EXPONENT
20 JPOINT=LFTCOL
LEXPNT=KEXPNT+1
IF(IFZERO.EQ.0)GO TO 22
IF(MAXEXP.LT.0)GO TO 21
IF(KEXPNT.GE.0)GO TO 22
KEXPNT=KEXPNT+1
21 JPOINT=JPOINT-1
22 IF(KEXPNT.GT.0)JPOINT=JPOINT+KEXPNT
LWIDE=LTREND-JPOINT-2
IF(LWIDE.LT.-1)GO TO 44
MWIDE=0
IF(IMAXDE.LT.-1)GO TO 23
IF(LWIDE.GT.IMAXDE)LWIDE=IMAXDE
23 IF(MAXEXP.LT.0)GO TO 24
IF(MAXSIG.LE.0)GO TO 24
I=MAXSIG-LEXPNT
IF(I.LT.0)GO TO 44
IF(LWIDE.GT.I)LWIDE=I
24 IF(LWIDE.LT.IMINDE)GO TO 44
GO TO 32
C
C DECIDE FORMAT IF NUMBER IN SCIENTIFIC NOTATION
25 MWIDE=2
LWIDE=LTREND-LFTCOL-2
IF(KEXPNT.NE.0)GO TO 26
IF(IZERO.LT.0)GO TO 30
26 I=KEXPNT
IF(I.GE.0)GO TO 27
MWIDE=MWIDE+1
I=-I
27 IF(I.LT.10)GO TO 28
MWIDE=MWIDE+1
I=I/10
GO TO 27
28 NWIDE=MWIDE
IF(MWIDE.LE.IEXPNT)MWIDE=IEXPNT+1
IF(IPART.EQ.0)GO TO 29
IF(MWIDE.LE.JWIDTH)GO TO 30
29 LWIDE=LWIDE-MWIDE
30 IF(LWIDE.LT.-1)GO TO 85
JPOINT=LFTCOL
IF(IDECML.LT.-1)GO TO 31
IF(LWIDE.GT.IDECML)LWIDE=IDECML
31 IERR=LWIDE+1
IF(IERR.LE.0)IERR=1
32 IF(LWIDE.GT.0)JPOINT=JPOINT+LWIDE
JPOINT=JPOINT+1
C
C SHIFT OUT THE DIGITS
I=LFTCOL
J=IOFSET
IF(MWIDE.NE.0)GO TO 33
IF(KEXPNT.LT.0)J=J-KEXPNT
33 LAST=ABSVLU
IF(J.GT.0)LAST=0
IF(I.GE.JPOINT)GO TO 34
I=I+1
IBUFFR(I)=IDIGIT(LAST+1)
J=J-1
IF(J.GE.0)GO TO 33
ABSVLU=ABSVLU-FLOAT(LAST)
IF(ABSVLU.LT.0.0)ABSVLU=0.0
ABSVLU=10.0*ABSVLU
GO TO 33
C
C ROUND
34 I=LFTCOL
35 I=I+1
IF(I.GT.JPOINT)GO TO 36
IF(IBUFFR(I).NE.IDIGIT(11))GO TO 35
GO TO 39
36 IF(LAST.LE.4)GO TO 42
LAST=0
37 I=I-1
IF(I.LE.LFTCOL)GO TO 41
J=1
38 IF(IBUFFR(I).EQ.IDIGIT(J))GO TO 40
J=J+1
IF(J.LT.10)GO TO 38
39 IBUFFR(I)=JZERO
GO TO 37
40 IBUFFR(I)=IDIGIT(J+1)
IF((LFTCOL-KEXPNT).GE.I)LEXPNT=LEXPNT+1
GO TO 35
41 IOFSET=IOFSET+1
GO TO 2
C
C TEST IF HAVE ENOUGH SIGNIFICANT DIGITS
C (ROUNDING CAN INCREASE NUMBER SO MUST DO NOW)
42 IF(MWIDE.NE.0)GO TO 45
IF(MAXEXP.LT.0)GO TO 45
I=LEXPNT
IF(LWIDE.GT.0)I=I+LWIDE
IF(I.LT.0)I=0
IF(MAXSIG.LE.0)GO TO 43
IF(I.GT.MAXSIG)GO TO 41
43 IF(I.GE.MINSIG)GO TO 45
C
C FLOATING POINT WILL NOT FIT SO FORCE SCIENTIFIC
44 NOTE=-1
GO TO 1
C
C INSERT PERIOD AND/OR TRIM OFF RIGHTMOST ZEROES
45 JRIGHT=IRIGHT
J=JPOINT
IF(LWIDE.GE.0)JPOINT=JPOINT+1
I=JPOINT
L=KLIP
46 IF(LWIDE.GE.0)GO TO 47
IF(J.LE.LFTCOL)GO TO 57
GO TO 49
47 LWIDE=LWIDE-1
IF(LWIDE.GE.0)GO TO 48
J=J+1
IF(L.LE.-3)GO TO 53
IF(L.GE.3)GO TO 50
IBUFFR(I)=IDOT
GO TO 56
48 IF(J.LE.LFTCOL)GO TO 56
49 IF(L.EQ.0)GO TO 55
IF(IBUFFR(J).NE.JZERO)GO TO 55
IF(LWIDE.LT.0)GO TO 55
IF(KLIP.LE.-2)GO TO 53
IF(KLIP.GE.2)GO TO 50
IF(LWIDE.LE.0)GO TO 55
IF(KLIP.LT.0)GO TO 53
50 IF(MWIDE.NE.0)GO TO 51
IF(INOTE.GT.0)GO TO 54
GO TO 52
51 IF(IPART.NE.0)GO TO 52
IF(IZERO.GT.0)GO TO 54
IF(KEXPNT.NE.0)GO TO 54
52 IRIGHT=IRIGHT+1
53 JPOINT=JPOINT-1
GO TO 56
54 IBUFFR(I)=IBLANK
GO TO 56
55 IBUFFR(I)=IBUFFR(J)
IFZERO=0
L=0
56 I=I-1
J=J-1
GO TO 46
C
C INSURE THAT SHOW AT LEAST 1 DIGIT IF INIZRO.LT.0
57 IF(IFZERO.EQ.0)GO TO 58
IF(IFZERO.GT.0)GO TO 82
IFZERO=0
GO TO 1
C
C INSERT EXPONENT
58 IF(IPART.LE.0)GO TO 59
IRIGHT=JRIGHT
JPOINT=LFTCOL
INOTE=0
MINUS=0
59 LTREND=LFTCOL+JWIDTH
IF(MWIDE.EQ.0)GO TO 69
IF(IPART.LT.0)GO TO 70
IF(KEXPNT.NE.0)GO TO 60
IF(IZERO.LT.0)GO TO 70
IF(IZERO.EQ.0)GO TO 68
60 K=JPOINT+1
IBUFFR(K)=JEXPNT
L=0
IF(KEXPNT.GE.0)GO TO 62
KEXPNT=-KEXPNT
IF(IFORMT.EQ.3)GO TO 61
K=K+1
IBUFFR(K)=IMINUS
GO TO 62
61 L=1
62 IF(IFORMT.NE.0)GO TO 63
JPOINT=JPOINT+NWIDE
IRIGHT=IRIGHT+MWIDE-NWIDE
GO TO 64
63 JPOINT=JPOINT+MWIDE
64 I=JPOINT
65 J=KEXPNT
KEXPNT=KEXPNT/10
J=J-(10*KEXPNT)+1
IBUFFR(I)=IDIGIT(J)
IF(J.NE.1)GO TO 67
IF(I.EQ.JPOINT)GO TO 67
IF(KEXPNT.NE.0)GO TO 67
IF(IFORMT.EQ.1)GO TO 67
IF(L.EQ.0)GO TO 66
L=0
IBUFFR(I)=IMINUS
GO TO 67
66 IBUFFR(I)=IBLANK
67 I=I-1
IF(I.GT.K)GO TO 65
GO TO 70
C
C BLANK OUT A ZERO EXPONENT
68 IRIGHT=IRIGHT+MWIDE
GO TO 70
C
C INSERT PERCENT SIGN, K OR M
69 IERR=0
IF(INOTE.LE.0)GO TO 70
JPOINT=JPOINT+1
IBUFFR(JPOINT)=LETTER(INOTE)
C
C JUSTIFY THE NUMBER
70 IF(JPOINT.EQ.LFTCOL)GO TO 83
J=LTREND-JPOINT-IRIGHT
IF(MINUS.EQ.0)GO TO 71
IF(J.LE.1)GO TO 76
IF(JSTIFY.GE.0)GO TO 72
J=1
GO TO 76
71 IF(JSTIFY.LT.0)GO TO 83
72 IF(JSTIFY.NE.0)GO TO 75
IF(MINUS.LT.0)GO TO 73
IF(MINUS.NE.2)GO TO 74
73 J=J+1
74 IF(JWIDTH.EQ.(2*(JWIDTH/2)))J=J+1
J=J/2
75 IF(J.LE.0)GO TO 83
76 I=JPOINT
J=J+JPOINT
JPOINT=J
77 IF(I.LE.LFTCOL)GO TO 78
IBUFFR(J)=IBUFFR(I)
J=J-1
I=I-1
GO TO 77
78 IF(MINUS.LT.0)GO TO 79
IF(MINUS.NE.2)GO TO 81
IBUFFR(J)=IPLUS
GO TO 80
79 IBUFFR(J)=IMINUS
80 J=J-1
81 IF(J.LE.LFTCOL)GO TO 83
IBUFFR(J)=IBLANK
GO TO 80
C
C FILL OUT REST OF FIELD WITH BLANKS
82 JPOINT=LFTCOL
LTREND=LFTCOL+JWIDTH
83 IF(IFILL.LE.0)GO TO 87
84 IF(JPOINT.GE.LTREND)GO TO 87
JPOINT=JPOINT+1
IBUFFR(JPOINT)=IBLANK
GO TO 84
C
C FILL FIELD WITH ASTERISKS IF NUMBER CANNOT FIT
85 JPOINT=LFTCOL
LTREND=LFTCOL+JWIDTH
IERR=-1
86 IF(JPOINT.GE.LTREND)GO TO 87
JPOINT=JPOINT+1
IBUFFR(JPOINT)=ISTAR
GO TO 86
C
C RETURN TO CALLING PROGRAM
87 KOUNT=JPOINT
RETURN
C762754596768%
END