convert integers to roman

NTC0394 · Jul 19, 2013

I need a program to ask the user a number from 1 to 3999 and convert to roman.

I don't know how do this without using WHILE.
thank you in advance!

mikrom · Jul 20, 2013

What have you done so far?

xwb · Jul 20, 2013

Have a look at Decimal To Roman. It is written in VB, which is quite close to Fortran. All you need to do is translate it.

j0zn · Jul 20, 2013

At the most I used to see roman to decimal, but I never seen decimal to roman. It would be interesting.

NTC0394 · Jul 20, 2013

My friend write this one, but I want this program without the function WHILE.
OBS: This program works but after priting results it shows some characters strangers. I don't know why it happens.

!***********************************************************************************************************************************
! AR2ROM
!
! This function converts an Arabic numeral to a Roman numeral.
!
! Input:
! ARB - Arabic numeral (integer)
! Outputs:
! ROM - Roman numeral (character string)
! VALID - Returns .TRUE. if input was valid, .FALSE. if invalid
!
! This function will set the VALID flag to .FALSE. if the input Arabic numeral is negative or zero.
!***********************************************************************************************************************************

SUBROUTINE AR2ROM (ARB, ROM, VALID)

IMPLICIT NONE

INTEGER, INTENT(IN) :: ARB ! input Arabic numeral
CHARACTER(LEN=*), INTENT(OUT) :: ROM ! output Roman numeral string
LOGICAL, INTENT(OUT) :: VALID ! output valid flag

INTEGER :: I, J, LEFT

!
! Start of code.
! Check for invalid Arabic numeral (non-positive).
! If invalid, set VALID flag to .FALSE. and exit.
!

IF (ARB .LE. 0) THEN
VALID = .FALSE.
ROM = '0'
RETURN
END IF

!
! Initialize variables.
!

VALID = .TRUE.
LEFT = ARB
J = 1

!
! Begin successive subtractions from Arabic numeral to find corresponding Roman numerals.
! Note that multiple I, X, C, or M may occur, but only (at most) one each of: IV, V, IX, XL, L, XC, CD, D, CM.
!
! Account for 1000's (M).
!

DO WHILE (LEFT .GE. 1000)
LEFT = LEFT - 1000
ROM(J:J) = 'M'
J = J + 1
END DO

!
! Account for 900 (CM).
!

IF (LEFT .GE. 900) THEN
LEFT = LEFT - 900
ROM(J:J+1) = 'CM'
J = J + 2
END IF

!
! Account for 500 (D).
!

IF (LEFT .GE. 500) THEN
LEFT = LEFT - 500
ROM(J:J) = 'D'
J = J + 1
END IF

!
! Account for 400 (CD).
!

IF (LEFT .GE. 400) THEN
LEFT = LEFT - 400
ROM(J:J+1) = 'CD'
J = J + 2
END IF

!
! Account for 100's (C).
!

DO WHILE (LEFT .GE. 100)
LEFT = LEFT - 100
ROM(J:J) = 'C'
J = J + 1
END DO

!
! Account for 90 (XC).
!

IF (LEFT .GE. 90) THEN
LEFT = LEFT - 90
ROM(J:J+1) = 'XC'
J = J + 2
END IF

!
! Account for 50 (L).
!

IF (LEFT .GE. 50) THEN
LEFT = LEFT - 50
ROM(J:J) = 'L'
J = J + 1
END IF

!
! Account for 40 (XL).
!

IF (LEFT .GE. 40) THEN
LEFT = LEFT - 40
ROM(J:J+1) = 'XL'
J = J + 2
END IF

!
! Account for 10's (X).
!

DO WHILE (LEFT .GE. 10)
LEFT = LEFT - 10
ROM(J:J) = 'X'
J = J + 1
END DO

!
! Account for 9 (IX).
!

IF (LEFT .GE. 9) THEN
LEFT = LEFT - 9
ROM(J:J+1) = 'IX'
J = J + 2
END IF

!
! Account for 5 (V).
!

IF (LEFT .GE. 5) THEN
LEFT = LEFT - 5
ROM(J:J) = 'V'
J = J + 1
END IF

!
! Account for 4 (IV).
!

IF (LEFT .GE. 4) THEN
LEFT = LEFT - 4
ROM(J:J+1) = 'IV'
J = J + 2
END IF

!
! Account for 1's (I).
!

DO WHILE (LEFT .GE. 1)
LEFT = LEFT - 1
ROM(J:J) = 'I'
J = J + 1
END DO

!
! End of code - return Roman numeral string and VALID flag.
!

RETURN

END SUBROUTINE AR2ROM

PROGRAM ROMAN

IMPLICIT NONE

INTEGER :: CHOICE
CHARACTER(LEN=80) :: ROMN
INTEGER :: ARABIC
LOGICAL :: VALID

WRITE (UNIT=*, FMT='(A)', ADVANCE='NO') ' Enter Arabic numeral: '
READ (UNIT=*, FMT=*) ARABIC
CALL AR2ROM (ARABIC, ROMN, VALID)
IF (VALID) THEN
WRITE (UNIT=*, FMT='(1X,A)') ROMN
ELSE
WRITE (UNIT=*, FMT='(A)') ' Invalid Arabic numeral'
END IF

!
! End of program.
!

STOP

END PROGRAM ROMAN

mikrom · Jul 20, 2013

NTC0394 said:
... but I want this program without the function WHILE.

It's simple. Replace all loops of the form

Code:

do while ([i]condition[/i])
  ...
end do

with loops like this

Code:

do
  ...
  if (.not. ([i]condition[/i])) then
    ! exit the loop
    exit
  end if
end do

NTC0394 · Jul 22, 2013

As a beginning at fortran I tryed a 100 times and I couldn't modify without compilation problem. :'(. It isn't my own program so I don't understand what some things like this below means.
Why J = J+1? for example

DO WHILE (LEFT .GE. 1000)
LEFT = LEFT - 1000
ROM(J:J) = 'M'
J = J + 1
END DO

How should I start modifying this program for not using while?

Thanks for help and patience!!!

mikrom · Jul 22, 2013

ROM(J:J) means substring of ROM ar position J to position J i.e. 1 character at position J
J = J + 1 means to increment the postion J

But say us please: Do you have anything already programmed in any language ?

NTC0394 · Jul 22, 2013

I've been studied just a little bit C and Java. I'm studying things like arrays and character in fortran.

NTC0394 · Jul 23, 2013

Using the tips of @mikrom
************************************************************************

It's simple. Replace all loops of the form
CODE

do while (condition)
...
end do

with loops like this
CODE

do
...
if (.not. (condition)) then
! exit the loop
exit
end if
end do
*************************************************************************

What is wrong when I write it below?
DO
if((.not. LEFT .GE. 1000)
LEFT = LEFT - 1000
ROM(J:J) = 'M'
J = J + 1)
then
exit
end if
END DO

Thank you for help!

mikrom · Jul 23, 2013

You have to do body of the loop i.e. these statements

Code:

LEFT = LEFT - 1000
ROM(J:J) = 'M'
J = J + 1

so long while condition

Code:

LEFT .GE. 1000

is fullfilled.

so you can write it

Code:

DO 
  if (LEFT .GE. 1000)
    LEFT = LEFT - 1
    ROM(J:J) = 'I'
    J = J + 1
  else
    exit
  end if
END DO

or other way

Code:

DO 
  if (.not.(LEFT .GE. 1000))
    exit
  end if
  LEFT = LEFT - 1
  ROM(J:J) = 'I'
  J = J + 1
END DO

or when you know that (.not.(LEFT .GE. 1000)) is (LEFT .LT. 1000) then

Code:

DO 
  if (LEFT .LT. 1000))
    exit
  end if
  LEFT = LEFT - 1
  ROM(J:J) = 'I'
  J = J + 1
END DO

NTC0394 · Jul 24, 2013

Thank you mikrom
Now I can just do this without WHILE (finally), but I can't do the LOOP using DO. I tried thousand of times using codes like the below and it doesn't work.
Now, the question is: how create a DO LOOP for thid program?

IF (LEFT .GE. 1)
DO ARB = 1, LEFT
LEFT = (LEFT - 1)
ROM(J:J) = 'I'
J = J + 1
END DO
END IF

Thank you so much for you help and for you patience!

mikrom · Jul 24, 2013

NTC0394 said:
...but I can't do the LOOP using DO...

I wonder what you ask, because you have the do loop here:

Code:

DO ARB = 1, LEFT
  LEFT = (LEFT - 1)
  ROM(J:J) = 'I'
  J = J + 1 
END DO

NTC0394 · Jul 24, 2013

The complete program is the following. I don't know what is wrong.
@mikrom thank you for your attention!

!***********************************************************************************************************************************
! AR2ROM
!
! This function converts an Arabic numeral to a Roman numeral.
!
! Input:
! ARB - Arabic numeral (integer)
! Outputs:
! ROM - Roman numeral (character string)
! VALID - Returns .TRUE. if input was valid, .FALSE. if invalid
!
! This function will set the VALID flag to .FALSE. if the input Arabic numeral is negative or zero.
!***********************************************************************************************************************************

SUBROUTINE AR2ROM (ARB, ROM, VALID)
IMPLICIT none
INTEGER, INTENT(IN) :: ARB ! input Arabic numeral
CHARACTER(LEN=10), INTENT(OUT) :: ROM ! output Roman numeral string
LOGICAL, INTENT(OUT) :: VALID ! output valid flag

INTEGER :: I, J, LEFT
! Start of code.
! Check for invalid Arabic numeral (non-positive).
! If invalid, set VALID flag to .FALSE. and exit.
IF (ARB .LE. 0) THEN
VALID = .FALSE.
ROM = '0'
RETURN
END IF
! Initialize variables.
VALID = .TRUE.
LEFT = ARB
J = 1
! Begin successive subtractions from Arabic numeral to find corresponding Roman numerals.
! Note that multiple I, X, C, or M may occur, but only (at most) one each of: IV, V, IX, XL, L, XC, CD, D, CM.
! Account for 1000's (M).

IF (LEFT .GE. 1000)THEN
DO ARB = 1, LEFT
LEFT = (LEFT - 1000)
ROM(J:J) = "M"
J = J + 1
END IF
! Account for 900 (CM).
IF (LEFT .GE. 900) THEN
LEFT = LEFT - 900
ROM(J:J+1) = 'CM'
J = J + 2
END IF
! Account for 500 (D).
IF (LEFT .GE. 500) THEN
LEFT = LEFT - 500
ROM(J:J) = 'D'
J = J + 1
END IF
! Account for 400 (CD).
IF (LEFT .GE. 400) THEN
LEFT = LEFT - 400
ROM(J:J+1) = 'CD'
J = J + 2
END IF
! Account for 100's (C).
IF (LEFT .GE. 100) THEN
LEFT = LEFT - 100
ROM(J:J) = 'C'
J = J + 1
END IF
! Account for 90 (XC).
IF (LEFT .GE. 90) THEN
LEFT = LEFT - 90
ROM(J:J+1) = 'XC'
J = J + 2
END IF
! Account for 50 (L).
IF (LEFT .GE. 50) THEN
LEFT = LEFT - 50
ROM(J:J) = 'L'
J = J + 1
END IF
! Account for 40 (XL).
IF (LEFT .GE. 40) THEN
LEFT = (LEFT - 40)
ROM(J:J+1) = 'XL'
J = J + 2
END IF
! Account for 10's (X).
IF (LEFT .GE. 10) THEN
DO ARB = 1, LEFT
LEFT = (LEFT - 10)
ROM(J:J) = "X"
J = J + 1
END DO
END IF
! Account for 9 (IX).
IF (LEFT .GE. 9) THEN
LEFT = LEFT - 9
ROM(J:J+1) = 'IX'
J = J + 2
END IF
! Account for 5 (V).
IF (LEFT .GE. 5) THEN
LEFT = LEFT - 5
ROM(J:J) = 'V'
J = J + 1
END IF
! Account for 4 (IV).
IF (LEFT .GE. 4) THEN
LEFT = LEFT - 4
ROM(J:J+1) = 'IV'
J = J + 2
END IF
! Account for 1's (I).
IF (LEFT .GE. 1)THEN
DO ARB = 1, LEFT
LEFT = (LEFT - 1)
ROM(J:J) = 'I'
J = J + 1
END DO
END IF
! End of code - return Roman numeral string and VALID flag.
RETURN

END SUBROUTINE AR2ROM
!starting program
PROGRAM ROMAN
IMPLICIT NONE
INTEGER :: CHOICE
CHARACTER(LEN=10) :: ROMN
INTEGER :: ARABIC
LOGICAL :: VALID

PRINT *, " Enter Arabic numeral: "
READ *, ARABIC
CALL AR2ROM (ARABIC, ROMN, VALID)
IF (VALID) THEN
PRINT *, ROMN
ELSE
PRINT *, " Invalid Arabic numeral"
END IF
! End of program.
STOP

END PROGRAM ROMAN

gullipe · Jul 25, 2013

Hi NTC0394
Made some modifications a now it works up to 9.
10 gives XXXXXXXXXX and it crashes for 11 and above..

Code:

	!
	PROGRAM ROMAN

	IMPLICIT NONE
	INTEGER :: CHOICE
	CHARACTER(LEN=10) :: ROMN
	INTEGER :: ARABIC
	LOGICAL :: VALID

	PRINT *, " Enter Arabic numeral: "
	READ *, ARABIC
	CALL AR2ROM (ARABIC, ROMN, VALID)
	IF (VALID) THEN
	   PRINT *, ROMN
	ELSE
	   PRINT *, " Invalid Arabic numeral"
	END IF

! End of program.
	STOP
	END PROGRAM ROMAN

!***********************************************************************************************************************************
! AR2ROM
!
! This function converts an Arabic numeral to a Roman numeral.
!
! Input:
! ARB - Arabic numeral (integer)
! Outputs:
! ROM - Roman numeral (character string)
! VALID - Returns .TRUE. if input was valid, .FALSE. if invalid
!
! This function will set the VALID flag to .FALSE. if the input Arabic numeral is negative or zero.
!***********************************************************************************************************************************

	SUBROUTINE AR2ROM (ARB, ROM, VALID)

	IMPLICIT none
	INTEGER, INTENT(IN) :: ARB ! input Arabic numeral
	INTEGER ARBx	! Added 2013-07-25
	CHARACTER(LEN=10), INTENT(OUT) :: ROM ! output Roman numeral string
	LOGICAL, INTENT(OUT) :: VALID ! output valid flag
	INTEGER :: I, J, LEFT

! Start of code.
! Check for invalid Arabic numeral (non-positive).
! If invalid, set VALID flag to .FALSE. and exit.
	IF (ARB .LE. 0) THEN
	   VALID = .FALSE.
	   ROM = '0'
	   RETURN
	END IF
! Initialize variables.
	VALID = .TRUE.
	LEFT = ARB
	J = 1
! Begin successive subtractions from Arabic numeral to find corresponding Roman numerals.
! Note that multiple I, X, C, or M may occur, but only (at most) one each of: IV, V, IX, XL, L, XC, CD, D, CM.
! Account for 1000's (M).

	IF (LEFT .GE. 1000) THEN
	   DO ARBx = 1, LEFT		! Modif.2013-07-25
	      LEFT = (LEFT - 1000)
	      ROM(J:J) = "M"
	     J = J + 1
	   END DO					! Added 2013-07-25
	END IF
! Account for 900 (CM).
	IF (LEFT .GE. 900) THEN
	   LEFT = LEFT - 900
	   ROM(J:J+1) = 'CM'
	   J = J + 2
	END IF
! Account for 500 (D).
	IF (LEFT .GE. 500) THEN
	   LEFT = LEFT - 500
	   ROM(J:J) = 'D'
	   J = J + 1
	END IF
! Account for 400 (CD).
	IF (LEFT .GE. 400) THEN
	   LEFT = LEFT - 400
	   ROM(J:J+1) = 'CD'
	   J = J + 2
	END IF
! Account for 100's (C).
	IF (LEFT .GE. 100) THEN
	   LEFT = LEFT - 100
	   ROM(J:J) = 'C'
	   J = J + 1
	END IF
! Account for 90 (XC).
	IF (LEFT .GE. 90) THEN
	   LEFT = LEFT - 90
	   ROM(J:J+1) = 'XC'
	   J = J + 2
	END IF
! Account for 50 (L).
	IF (LEFT .GE. 50) THEN
	   LEFT = LEFT - 50
	   ROM(J:J) = 'L'
	   J = J + 1
	END IF
! Account for 40 (XL).
	IF (LEFT .GE. 40) THEN
	   LEFT = (LEFT - 40)
	   ROM(J:J+1) = 'XL'
	   J = J + 2
	END IF
! Account for 10's (X).
	IF (LEFT .GE. 10) THEN
	   DO ARBx = 1, LEFT		! Modif.2013-07-25
	      LEFT = (LEFT - 10)
	      ROM(J:J) = "X" 
	      J = J + 1
	   END DO
	END IF
! Account for 9 (IX).
	IF (LEFT .GE. 9) THEN
	   LEFT = LEFT - 9
	   ROM(J:J+1) = 'IX'
	   J = J + 2
	END IF
! Account for 5 (V).
	IF (LEFT .GE. 5) THEN
	   LEFT = LEFT - 5
	   ROM(J:J) = 'V'
	   J = J + 1
	END IF
! Account for 4 (IV).
	IF (LEFT .GE. 4) THEN
	   LEFT = LEFT - 4
	   ROM(J:J+1) = 'IV'
	   J = J + 2
	END IF
! Account for 1's (I).
	IF (LEFT .GE. 1)THEN
	   DO ARBx = 1, LEFT		! Modif.2013-07-25
	      LEFT = (LEFT - 1)
	      ROM(J:J) = 'I'
	      J = J + 1 
	   END DO
	END IF
! End of code - return Roman numeral string and VALID flag.
	RETURN

	END SUBROUTINE AR2ROM

mikrom · Jul 25, 2013

The question is if the original code posted at 20 Jul 13 5:44 works like expected or not...

gullipe · Jul 25, 2013

Hi mikrom

OK, I understand. I compiled the original code and run it, and it seems to work fine !

NTC0394 · Jul 25, 2013

Hi mikrom and gullipe!
The original code is working fine. What I want is it working without WHILE LOOP and using DO LOOP, for example.

mikrom · Jul 25, 2013

if the original code is working properly then the changes (i.e. probably the replacing of the while loops) have not been implemented properly.

mikrom · Jul 25, 2013

@NTC0394:
For exammple you have tried to replace the first while loop in the original code, i.e.:

Code:

DO WHILE (LEFT .GE. 1000)
  LEFT = LEFT - 1000
  ROM(J:J) = 'M'
  J = J + 1
END DO

with

Code:

IF (LEFT .GE. 1000)THEN
 DO ARB = 1, LEFT 
   LEFT = (LEFT - 1000)
   ROM(J:J) = "M"
   J = J + 1
 end do
END IF

In my previous post I suggested you to replace it with:

Code:

DO 
  IF (LEFT .GE. 1000) THEN
    LEFT = LEFT - 1000
    ROM(J:J) = 'M'
    J = J + 1
  ELSE
    EXIT
  END IF
END DO

it applies to all while loops

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

convert integers to roman

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor