22 lines
513 B
Text
22 lines
513 B
Text
CHARACTER Roman*20
|
|
|
|
CALL RomanNumeral(1990, Roman) ! MCMXC
|
|
CALL RomanNumeral(2008, Roman) ! MMVIII
|
|
CALL RomanNumeral(1666, Roman) ! MDCLXVI
|
|
|
|
END
|
|
|
|
SUBROUTINE RomanNumeral( arabic, roman)
|
|
CHARACTER roman
|
|
DIMENSION ddec(13)
|
|
DATA ddec/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/
|
|
|
|
roman = ' '
|
|
todo = arabic
|
|
DO d = 1, 13
|
|
DO rep = 1, todo / ddec(d)
|
|
roman = TRIM(roman) // TRIM(CHAR(d, 13, "M CM D CD C XC L XL X OX V IV I "))
|
|
todo = todo - ddec(d)
|
|
ENDDO
|
|
ENDDO
|
|
END
|