Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/darome.for
There are 2 other files named darome.for in the archive. Click here to see a list.
SUBROUTINE DAROME(KONTRL,NUMBER,LETTER,KOUNT,LFTCOL,
1MAX)
C RENBR(/ROMAN NUMERAL GENERATOR)
C
C DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERISTY
C
C KONTRL = 0, LEFT JUSTIFIES AT LFTCOL OR AT KOUNT+1
C IF KOUNT IS GREATER THAN LFTCOL.
C = 1, RIGHT JUSTIFIES AT LFTCOL.
C NUMBER = NUMBER TO BE REPRESENTED.
C LETTER = ARRAY TO RECIEVE ALPHAMERIC CODES.
C KOUNT = INPUT CONTAINING THE NUMBER OF LOCATIONS
C IN LETTER ARRAY ALREADY IN USE AND TO BE
C PRESERVED. OUTPUT CONTAINING NUMBER OF
C LOCATIONS IN USE INCLUDING THOSE USED
C FOR THE ROMAN NUMERAL. KOUNT IS RETURNED
C UNCHANGED IF AN ERROR TOOK PLACE
C (EITHER A NUMBER OUTSIDE RANGE WHICH CAN
C BE REPRESENTED, OR INSUFFICIENT ROOM).
C LFTCOL = LOCATION OF NEW NUMBER.
C = CHARACTERS LEFT OF NUMBER IF KONTRL = 0.
C = POSITION OF RIGHT DIGIT IF KONTRL = 1.
C MAX = DIMENSION OF LETTER ARRAY.
C
DIMENSION LETTER(MAX),IROME(7)
DATA IROME/1HI,1HV,1HX,1HL,1HC,1HD,1HM/
DATA IBLANK/1H /
C
C DISECT NUMBER
IF(NUMBER.GT.3999)GO TO 15
C REMOVE FOLLOWING STATEMENT TO SHOW ZERO AS SPACES
IF(NUMBER.LE.0)GO TO 15
N=KOUNT+1
I=NUMBER
K=-1
1 M=KOUNT
IF(I.LT.0)GO TO 15
IF(I.EQ.0)GO TO 5
J=I
I=I/10
J=J-10*I
K=K+2
L=0
IF(J.LE.3)GO TO 4
L=K+1
J=J-5
IF(J.NE.4)GO TO 2
L=L+1
J=-1
C
C INSERT INITIAL ONE'S CHARACTER
2 IF(J.NE.-1)GO TO 3
IF(KOUNT.GE.MAX)GO TO 14
KOUNT=KOUNT+1
LETTER(KOUNT)=IROME(K)
C
C INSERT FIVE'S OR TEN'S CHARACTER
3 IF(L.EQ.0)GO TO 4
IF(KOUNT.GE.MAX)GO TO 14
KOUNT=KOUNT+1
LETTER(KOUNT)=IROME(L)
C
C INSERT UP TO 3 ONE'S CHARACTERS
4 IF(J.LE.0)GO TO 9
IF(KOUNT.GE.MAX)GO TO 14
KOUNT=KOUNT+1
LETTER(KOUNT)=IROME(K)
J=J-1
GO TO 4
C
C ADJUST MARGINS AND INSERT FILLER BLANKS IF NEEDED
5 IF(KONTRL.EQ.0)GO TO 6
IF(KOUNT.GT.LFTCOL)GO TO 14
KOUNT=LFTCOL
GO TO 7
6 KOUNT=KOUNT+LFTCOL-N+1
IF(LFTCOL.LT.(N-1))KOUNT=M+1
7 IF(KOUNT.EQ.M)GO TO 15
IF(KOUNT.GT.MAX)GO TO 14
J=M+1
DO 8 I=J,KOUNT
8 LETTER(I)=IBLANK
I=-1
C
C SHIFT NEW NUMERALS INTO LEFT END OF ARRAY.
C THIS IS A GENERAL PROCEDURE TO SWAP ADJACENT
C SECTIONS WITHIN AN ARRAY. THE LOWER SECTION
C EXTENDS FROM N THROUGH M. THE UPPER SECION
C EXTENDS FROM M+1 THROUGH KOUNT.
9 IF(N.GT.M)GO TO 1
IF(M.EQ.KOUNT)GO TO 1
II=0
JJ=KOUNT
10 J=N+JJ-M-1
KK=LETTER(JJ)
11 II=II+1
L=LETTER(J)
LETTER(J)=KK
KK=L
IF(J.GT.M)GO TO 12
J=J+KOUNT-M
GO TO 11
12 IF(J.EQ.JJ)GO TO 13
J=N+J-M-1
GO TO 11
13 IF(II.EQ.(KOUNT-N+1))GO TO 1
JJ=JJ-1
GO TO 10
C
C RETURN TO CALLING PROGRAM
14 KOUNT=N-1
15 RETURN
C336670692127
END