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!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

convert integers to roman

Status
Not open for further replies.
NTC0394

NTC0394

Programmer
Jun 19, 2013
21
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!
 
Sort by date Sort by votes
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.
 
Upvote 0 Downvote
At the most I used to see roman to decimal, but I never seen decimal to roman. It would be interesting.
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
NTC0394 said:
... but I want this program without the function WHILE.
Click to expand...
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
 
Upvote 0 Downvote
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!!!
 
Upvote 0 Downvote
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 ?
 
Upvote 0 Downvote
I've been studied just a little bit C and Java. I'm studying things like arrays and character in fortran.
 
Upvote 0 Downvote
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!
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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!
 
Upvote 0 Downvote
NTC0394 said:
...but I can't do the LOOP using DO...
Click to expand...
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
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
The question is if the original code posted at 20 Jul 13 5:44 works like expected or not...
 
Upvote 0 Downvote
Hi mikrom

OK, I understand. I compiled the original code and run it, and it seems to work fine !
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
if the original code is working properly then the changes (i.e. probably the replacing of the while loops) have not been implemented properly.
 
Upvote 0 Downvote
@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
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

W
  • Locked
  • Question
Failure to open a file that exists
Replies
7
Views
610
WillBryce
W
virk24
  • Locked
  • Question
Reading character up to ";" from a csv-file
Replies
3
Views
318
virk24
virk24
Vahid9
  • Locked
  • Question
Broadcasting a REAL number to another file
Replies
2
Views
328
Vahid9
Vahid9
MBFerguson
  • Locked
  • Question
How to read from a string into 8-byte integer?
Replies
5
Views
168
mikrom
mikrom
svar
  • Locked
  • Question
weird storage behaviotr leading to segfault
Replies
0
Views
60
svar
svar

Part and Inventory Search

Sponsor

Back
Top